diff options
| author | Andrea Corallo | 2020-11-22 22:23:16 +0100 |
|---|---|---|
| committer | Andrea Corallo | 2020-11-22 22:23:16 +0100 |
| commit | 033e96055cc172d8d84adc128aee7f7d9889bb00 (patch) | |
| tree | 4e6e0a24c60f4c8776fb574bf31727dcaf4af4ba | |
| parent | 6781cd670d1487bbf0364d80de68ca9733342769 (diff) | |
| parent | 9b6ad3107f93d40f82c3c53dc0984c6d70aded83 (diff) | |
| download | emacs-033e96055cc172d8d84adc128aee7f7d9889bb00.tar.gz emacs-033e96055cc172d8d84adc128aee7f7d9889bb00.zip | |
Merge remote-tracking branch 'savannah/master' into HEAD
185 files changed, 3225 insertions, 2807 deletions
diff --git a/.gitignore b/.gitignore index b1522432b1c..e4379d0bef6 100644 --- a/.gitignore +++ b/.gitignore | |||
| @@ -199,7 +199,6 @@ src/bootstrap-emacs | |||
| 199 | src/emacs | 199 | src/emacs |
| 200 | src/emacs-[0-9]* | 200 | src/emacs-[0-9]* |
| 201 | src/temacs | 201 | src/temacs |
| 202 | src/fingerprint.c | ||
| 203 | src/dmpstruct.h | 202 | src/dmpstruct.h |
| 204 | src/*.pdmp | 203 | src/*.pdmp |
| 205 | 204 | ||
| @@ -117,19 +117,25 @@ ADDITIONAL DISTRIBUTION FILES | |||
| 117 | 117 | ||
| 118 | * Complex Text Layout support libraries | 118 | * Complex Text Layout support libraries |
| 119 | 119 | ||
| 120 | On GNU and Unix systems, Emacs needs the optional libraries "m17n-db", | 120 | On GNU and Unix systems, Emacs needs optional libraries to correctly |
| 121 | "libm17n-flt", "libotf" to correctly display such complex scripts as | 121 | display such complex scripts as Indic and Khmer, and also for scripts |
| 122 | Indic and Khmer, and also for scripts that require Arabic shaping | 122 | that require Arabic shaping support (Arabic and Farsi). If the |
| 123 | support (Arabic and Farsi). On some systems, particularly GNU/Linux, | 123 | HarfBuzz library is installed, Emacs will build with it and use it for |
| 124 | these libraries may be already present or available as additional | 124 | this purpose. HarfBuzz is the preferred shaping engine, both on Posix |
| 125 | packages. Note that if there is a separate 'dev' or 'devel' package, | 125 | hosts and on MS-Windows, so we recommend installing it before building |
| 126 | for use at compilation time rather than run time, you will need that | 126 | Emacs. The alternative for GNU/Linux and Posix systems is to use the |
| 127 | as well as the corresponding run time package; typically the dev | 127 | "m17n-db", "libm17n-flt", and "libotf" libraries. (On some systems, |
| 128 | package will contain header files and a library archive. Otherwise, | 128 | particularly GNU/Linux, these libraries may be already present or |
| 129 | you can download the libraries from <https://www.nongnu.org/m17n/>. | 129 | available as additional packages.) Note that if there is a separate |
| 130 | 'dev' or 'devel' package, for use at compilation time rather than run | ||
| 131 | time, you will need that as well as the corresponding run time | ||
| 132 | package; typically the dev package will contain header files and a | ||
| 133 | library archive. On MS-Windows, if HarfBuzz is not available, Emacs | ||
| 134 | will use the Uniscribe shaping engine that is part of the OS. | ||
| 130 | 135 | ||
| 131 | Note that Emacs cannot support complex scripts on a TTY, unless the | 136 | Note that Emacs cannot support complex scripts on a TTY, unless the |
| 132 | terminal includes such a support. | 137 | terminal includes such a support. However, most modern terminal |
| 138 | emulators, such as xterm, do support such scripts. | ||
| 133 | 139 | ||
| 134 | * intlfonts-VERSION.tar.gz | 140 | * intlfonts-VERSION.tar.gz |
| 135 | 141 | ||
diff --git a/doc/emacs/mule.texi b/doc/emacs/mule.texi index 72ae7697677..bf7088d8db1 100644 --- a/doc/emacs/mule.texi +++ b/doc/emacs/mule.texi | |||
| @@ -563,6 +563,12 @@ method's keys by defining key bindings in the keymap returned by the | |||
| 563 | function @code{quail-translation-keymap}, using @code{define-key}. | 563 | function @code{quail-translation-keymap}, using @code{define-key}. |
| 564 | @xref{Init Rebinding}. | 564 | @xref{Init Rebinding}. |
| 565 | 565 | ||
| 566 | Input methods are inhibited when the text in the buffer is read-only | ||
| 567 | for some reason. This is so single-character key bindings work in | ||
| 568 | modes that make buffer text or parts of it read-only, such as | ||
| 569 | @code{read-only-mode} and @code{image-mode}, even when an input method | ||
| 570 | is active. | ||
| 571 | |||
| 566 | Another facility for typing characters not on your keyboard is by | 572 | Another facility for typing characters not on your keyboard is by |
| 567 | using @kbd{C-x 8 @key{RET}} (@code{insert-char}) to insert a single | 573 | using @kbd{C-x 8 @key{RET}} (@code{insert-char}) to insert a single |
| 568 | character based on its Unicode name or code-point; see @ref{Inserting | 574 | character based on its Unicode name or code-point; see @ref{Inserting |
diff --git a/doc/emacs/package.texi b/doc/emacs/package.texi index 56e8ee1363a..4981dd50c75 100644 --- a/doc/emacs/package.texi +++ b/doc/emacs/package.texi | |||
| @@ -187,6 +187,14 @@ Filter package list by archive (@code{package-menu-filter-by-archive}). | |||
| 187 | This prompts for a package archive (e.g., @samp{gnu}), then shows only | 187 | This prompts for a package archive (e.g., @samp{gnu}), then shows only |
| 188 | packages from that archive. | 188 | packages from that archive. |
| 189 | 189 | ||
| 190 | @item / d | ||
| 191 | @kindex / d @r{(Package Menu)} | ||
| 192 | @findex package-menu-filter-by-description | ||
| 193 | Filter package list by description | ||
| 194 | (@code{package-menu-filter-by-description}). This prompts for a | ||
| 195 | regular expression, then shows only packages with descriptions | ||
| 196 | matching that regexp. | ||
| 197 | |||
| 190 | @item / k | 198 | @item / k |
| 191 | @kindex / k @r{(Package Menu)} | 199 | @kindex / k @r{(Package Menu)} |
| 192 | @findex package-menu-filter-by-keyword | 200 | @findex package-menu-filter-by-keyword |
| @@ -194,6 +202,14 @@ Filter package list by keyword (@code{package-menu-filter-by-keyword}). | |||
| 194 | This prompts for a keyword (e.g., @samp{games}), then shows only | 202 | This prompts for a keyword (e.g., @samp{games}), then shows only |
| 195 | packages with that keyword. | 203 | packages with that keyword. |
| 196 | 204 | ||
| 205 | @item / N | ||
| 206 | @kindex / N @r{(Package Menu)} | ||
| 207 | @findex package-menu-filter-by-name-or-description | ||
| 208 | Filter package list by name or description | ||
| 209 | (@code{package-menu-filter-by-name-or-description}). This prompts for | ||
| 210 | a regular expression, then shows only packages with a name or | ||
| 211 | description matching that regexp. | ||
| 212 | |||
| 197 | @item / n | 213 | @item / n |
| 198 | @kindex / n @r{(Package Menu)} | 214 | @kindex / n @r{(Package Menu)} |
| 199 | @findex package-menu-filter-by-name | 215 | @findex package-menu-filter-by-name |
diff --git a/doc/lispref/edebug.texi b/doc/lispref/edebug.texi index 6e9ec47f7b0..820fdb9bea0 100644 --- a/doc/lispref/edebug.texi +++ b/doc/lispref/edebug.texi | |||
| @@ -425,7 +425,8 @@ arrange to deinstrument it. | |||
| 425 | @item ? | 425 | @item ? |
| 426 | Display the help message for Edebug (@code{edebug-help}). | 426 | Display the help message for Edebug (@code{edebug-help}). |
| 427 | 427 | ||
| 428 | @item C-] | 428 | @item a |
| 429 | @itemx C-] | ||
| 429 | Abort one level back to the previous command level | 430 | Abort one level back to the previous command level |
| 430 | (@code{abort-recursive-edit}). | 431 | (@code{abort-recursive-edit}). |
| 431 | 432 | ||
| @@ -446,7 +447,7 @@ Redisplay the most recently known expression result in the echo area | |||
| 446 | 447 | ||
| 447 | @item d | 448 | @item d |
| 448 | Display a backtrace, excluding Edebug's own functions for clarity | 449 | Display a backtrace, excluding Edebug's own functions for clarity |
| 449 | (@code{edebug-backtrace}). | 450 | (@code{edebug-pop-to-backtrace}). |
| 450 | 451 | ||
| 451 | @xref{Backtraces}, for a description of backtraces | 452 | @xref{Backtraces}, for a description of backtraces |
| 452 | and the commands which work on them. | 453 | and the commands which work on them. |
| @@ -640,7 +641,8 @@ configuration is the collection of windows and contents that were in | |||
| 640 | effect outside of Edebug. | 641 | effect outside of Edebug. |
| 641 | 642 | ||
| 642 | @table @kbd | 643 | @table @kbd |
| 643 | @item v | 644 | @item P |
| 645 | @itemx v | ||
| 644 | Switch to viewing the outside window configuration | 646 | Switch to viewing the outside window configuration |
| 645 | (@code{edebug-view-outside}). Type @kbd{C-x X w} to return to Edebug. | 647 | (@code{edebug-view-outside}). Type @kbd{C-x X w} to return to Edebug. |
| 646 | 648 | ||
diff --git a/doc/lispref/help.texi b/doc/lispref/help.texi index 2fa54e3b66b..90406df9c19 100644 --- a/doc/lispref/help.texi +++ b/doc/lispref/help.texi | |||
| @@ -676,8 +676,9 @@ If this variable is non-@code{nil}, its value is a form to evaluate | |||
| 676 | whenever the character @code{help-char} is read. If evaluating the form | 676 | whenever the character @code{help-char} is read. If evaluating the form |
| 677 | produces a string, that string is displayed. | 677 | produces a string, that string is displayed. |
| 678 | 678 | ||
| 679 | A command that calls @code{read-event}, @code{read-char-choice}, or | 679 | A command that calls @code{read-event}, @code{read-char-choice}, |
| 680 | @code{read-char} probably should bind @code{help-form} to a | 680 | @code{read-char}, @code{read-char-from-minibuffer}, or |
| 681 | @code{y-or-n-p} probably should bind @code{help-form} to a | ||
| 681 | non-@code{nil} expression while it does input. (The time when you | 682 | non-@code{nil} expression while it does input. (The time when you |
| 682 | should not do this is when @kbd{C-h} has some other meaning.) | 683 | should not do this is when @kbd{C-h} has some other meaning.) |
| 683 | Evaluating this expression should result in a string that explains | 684 | Evaluating this expression should result in a string that explains |
diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi index b6a3434d15e..f1cfd29ef14 100644 --- a/doc/lispref/minibuf.texi +++ b/doc/lispref/minibuf.texi | |||
| @@ -2109,6 +2109,11 @@ special responses @code{recenter}, @code{scroll-up}, | |||
| 2109 | @kbd{C-v}, @kbd{M-v}, @kbd{C-M-v} and @kbd{C-M-S-v} in | 2109 | @kbd{C-v}, @kbd{M-v}, @kbd{C-M-v} and @kbd{C-M-S-v} in |
| 2110 | @code{query-replace-map}), this function performs the specified window | 2110 | @code{query-replace-map}), this function performs the specified window |
| 2111 | recentering or scrolling operation, and poses the question again. | 2111 | recentering or scrolling operation, and poses the question again. |
| 2112 | |||
| 2113 | If you bind @code{help-form} (@pxref{Help Functions}) to | ||
| 2114 | a non-@code{nil} value while calling @code{y-or-n-p}, then pressing | ||
| 2115 | @code{help-char} causes it to evaluate @code{help-form} and display | ||
| 2116 | the result. @code{help-char} is automatically added to @var{prompt}. | ||
| 2112 | @end defun | 2117 | @end defun |
| 2113 | 2118 | ||
| 2114 | @defun y-or-n-p-with-timeout prompt seconds default | 2119 | @defun y-or-n-p-with-timeout prompt seconds default |
| @@ -2317,6 +2322,11 @@ character. Optionally, it ignores any input that is not a member of | |||
| 2317 | @var{chars}, a list of accepted characters. The @var{history} | 2322 | @var{chars}, a list of accepted characters. The @var{history} |
| 2318 | argument specifies the history list symbol to use; if it is omitted or | 2323 | argument specifies the history list symbol to use; if it is omitted or |
| 2319 | @code{nil}, this function doesn't use the history. | 2324 | @code{nil}, this function doesn't use the history. |
| 2325 | |||
| 2326 | If you bind @code{help-form} (@pxref{Help Functions}) to | ||
| 2327 | a non-@code{nil} value while calling @code{read-char-from-minibuffer}, | ||
| 2328 | then pressing @code{help-char} causes it to evaluate @code{help-form} | ||
| 2329 | and display the result. | ||
| 2320 | @end defun | 2330 | @end defun |
| 2321 | 2331 | ||
| 2322 | @node Reading a Password | 2332 | @node Reading a Password |
diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index 2c30d8ad892..f897cfa4eab 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi | |||
| @@ -1077,12 +1077,19 @@ directories in a search path (as found in an environment variable). Its | |||
| 1077 | value is @code{":"} for Unix and GNU systems, and @code{";"} for MS systems. | 1077 | value is @code{":"} for Unix and GNU systems, and @code{";"} for MS systems. |
| 1078 | @end defvar | 1078 | @end defvar |
| 1079 | 1079 | ||
| 1080 | @defun path-separator | ||
| 1081 | This function returns the connection-local value of variable | ||
| 1082 | @code{path-separator}. That is @code{";"} for MS systems and a local | ||
| 1083 | @code{default-directory}, and @code{":"} for Unix and GNU systems, or | ||
| 1084 | a remote @code{default-directory}. | ||
| 1085 | @end defun | ||
| 1086 | |||
| 1080 | @defun parse-colon-path path | 1087 | @defun parse-colon-path path |
| 1081 | This function takes a search path string such as the value of | 1088 | This function takes a search path string such as the value of |
| 1082 | the @env{PATH} environment variable, and splits it at the separators, | 1089 | the @env{PATH} environment variable, and splits it at the separators, |
| 1083 | returning a list of directories. @code{nil} in this list means | 1090 | returning a list of directories. @code{nil} in this list means |
| 1084 | the current directory. Although the function's name says | 1091 | the current directory. Although the function's name says |
| 1085 | ``colon'', it actually uses the value of @code{path-separator}. | 1092 | ``colon'', it actually uses the value of variable @code{path-separator}. |
| 1086 | 1093 | ||
| 1087 | @example | 1094 | @example |
| 1088 | (parse-colon-path ":/foo:/bar") | 1095 | (parse-colon-path ":/foo:/bar") |
| @@ -1155,6 +1162,19 @@ in the system's terminal driver, before Emacs was started. | |||
| 1155 | @c The value is @code{nil} if Emacs is running under a window system. | 1162 | @c The value is @code{nil} if Emacs is running under a window system. |
| 1156 | @end defvar | 1163 | @end defvar |
| 1157 | 1164 | ||
| 1165 | @defvar null-device | ||
| 1166 | This variable holds the system null device. Its value is | ||
| 1167 | @code{"/dev/null"} for Unix and GNU systems, and @code{"NUL"} for MS | ||
| 1168 | systems. | ||
| 1169 | @end defvar | ||
| 1170 | |||
| 1171 | @defun null-device | ||
| 1172 | This function returns the connection-local value of variable | ||
| 1173 | @code{null-device}. That is @code{"NUL"} for MS systems and a local | ||
| 1174 | @code{default-directory}, and @code{"/dev/null"} for Unix and GNU | ||
| 1175 | systems, or a remote @code{default-directory}. | ||
| 1176 | @end defun | ||
| 1177 | |||
| 1158 | @node User Identification | 1178 | @node User Identification |
| 1159 | @section User Identification | 1179 | @section User Identification |
| 1160 | @cindex user identification | 1180 | @cindex user identification |
diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index 5ec23a9c876..2d092e1842a 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi | |||
| @@ -5869,13 +5869,16 @@ which window parameters (if any) are saved by this function. | |||
| 5869 | @xref{Window Parameters}. | 5869 | @xref{Window Parameters}. |
| 5870 | @end defun | 5870 | @end defun |
| 5871 | 5871 | ||
| 5872 | @defun set-window-configuration configuration | 5872 | @defun set-window-configuration configuration &optional dont-set-frame |
| 5873 | This function restores the configuration of windows and buffers as | 5873 | This function restores the configuration of windows and buffers as |
| 5874 | specified by @var{configuration}, for the frame that | 5874 | specified by @var{configuration}, for the frame that |
| 5875 | @var{configuration} was created for, regardless of whether that frame | 5875 | @var{configuration} was created for, regardless of whether that frame |
| 5876 | is selected or not. The argument @var{configuration} must be a value | 5876 | is selected or not. The argument @var{configuration} must be a value |
| 5877 | that was previously returned by @code{current-window-configuration} | 5877 | that was previously returned by @code{current-window-configuration} |
| 5878 | for that frame. | 5878 | for that frame. Normally the function also selects the frame which is |
| 5879 | recorded in the configuration, but if @var{dont-set-frame} is | ||
| 5880 | non-@code{nil}, it leaves selected the frame which was current at the | ||
| 5881 | start of the function. | ||
| 5879 | 5882 | ||
| 5880 | If the frame from which @var{configuration} was saved is dead, all | 5883 | If the frame from which @var{configuration} was saved is dead, all |
| 5881 | this function does is to restore the value of the variable | 5884 | this function does is to restore the value of the variable |
| @@ -103,7 +103,7 @@ unsystematic behavior, which mixed these two is no longer available. | |||
| 103 | +++ | 103 | +++ |
| 104 | ** New system for displaying documentation for groups of functions. | 104 | ** New system for displaying documentation for groups of functions. |
| 105 | This can either be used by saying 'M-x shortdoc-display-group' and | 105 | This can either be used by saying 'M-x shortdoc-display-group' and |
| 106 | choosing a group, or clicking a button in the *Help* buffers when | 106 | choosing a group, or clicking a button in the "*Help*" buffers when |
| 107 | looking at the doc string of a function that belongs to one of these | 107 | looking at the doc string of a function that belongs to one of these |
| 108 | groups. | 108 | groups. |
| 109 | 109 | ||
| @@ -187,6 +187,11 @@ space characters. | |||
| 187 | freenode IRC network for years now. Occurrences of "irc.freenode.net" | 187 | freenode IRC network for years now. Occurrences of "irc.freenode.net" |
| 188 | have been replaced with "chat.freenode.net" throughout Emacs. | 188 | have been replaced with "chat.freenode.net" throughout Emacs. |
| 189 | 189 | ||
| 190 | +++ | ||
| 191 | ** New functions 'null-device' and 'path-separator'. | ||
| 192 | These functions return the connection local value of the respective | ||
| 193 | variables. This can be used for remote hosts. | ||
| 194 | |||
| 190 | 195 | ||
| 191 | * Editing Changes in Emacs 28.1 | 196 | * Editing Changes in Emacs 28.1 |
| 192 | 197 | ||
| @@ -203,6 +208,12 @@ This command would previously not redefine values defined by these | |||
| 203 | forms, but this command has now been changed to work more like | 208 | forms, but this command has now been changed to work more like |
| 204 | 'eval-defun', and reset the values as specified. | 209 | 'eval-defun', and reset the values as specified. |
| 205 | 210 | ||
| 211 | --- | ||
| 212 | ** New user options 'copy-region-blink-delay' and 'delete-pair-blink-delay'. | ||
| 213 | 'copy-region-blink-delay' specifies a delay to indicate the region | ||
| 214 | copied by 'kill-ring-save'. 'delete-pair-blink-delay' specifies | ||
| 215 | a delay to show a paired character to delete. | ||
| 216 | |||
| 206 | +++ | 217 | +++ |
| 207 | ** New command 'undo-redo'. | 218 | ** New command 'undo-redo'. |
| 208 | It undoes previous undo commands, but doesn't record itself as an | 219 | It undoes previous undo commands, but doesn't record itself as an |
| @@ -282,7 +293,7 @@ indentation is done using SMIE or with the old ad-hoc code. | |||
| 282 | When a warning is displayed to the user, the resulting buffer now has | 293 | When a warning is displayed to the user, the resulting buffer now has |
| 283 | buttons which allow making permanent changes to the treatment of that | 294 | buttons which allow making permanent changes to the treatment of that |
| 284 | warning. Automatic showing of the warning can be disabled (although | 295 | warning. Automatic showing of the warning can be disabled (although |
| 285 | it is still logged to the *Messages* buffer), or the warning can be | 296 | it is still logged to the "*Messages*" buffer), or the warning can be |
| 286 | disabled entirely. | 297 | disabled entirely. |
| 287 | 298 | ||
| 288 | ** mspool.el | 299 | ** mspool.el |
| @@ -471,13 +482,13 @@ tags to be considered as well. | |||
| 471 | ** Gnus | 482 | ** Gnus |
| 472 | 483 | ||
| 473 | +++ | 484 | +++ |
| 474 | *** New gnus-search library | 485 | *** New gnus-search library. |
| 475 | A new unified search syntax which can be used across multiple | 486 | A new unified search syntax which can be used across multiple |
| 476 | supported search engines. Set 'gnus-search-use-parsed-queries' to | 487 | supported search engines. Set 'gnus-search-use-parsed-queries' to |
| 477 | non-nil to enable. | 488 | non-nil to enable. |
| 478 | 489 | ||
| 479 | +++ | 490 | +++ |
| 480 | *** New value for user option 'smiley-style' | 491 | *** New value for user option 'smiley-style'. |
| 481 | Smileys can now be rendered with emojis instead of small images when | 492 | Smileys can now be rendered with emojis instead of small images when |
| 482 | using the new 'emoji' value in 'smiley-style'. | 493 | using the new 'emoji' value in 'smiley-style'. |
| 483 | 494 | ||
| @@ -706,6 +717,16 @@ This file was a compatibility kludge which is no longer needed. | |||
| 706 | To revert to the previous behavior, | 717 | To revert to the previous behavior, |
| 707 | '(setq lisp-indent-function 'lisp-indent-function)' from 'lisp-mode-hook'. | 718 | '(setq lisp-indent-function 'lisp-indent-function)' from 'lisp-mode-hook'. |
| 708 | 719 | ||
| 720 | ** Customize | ||
| 721 | |||
| 722 | *** Most customize commands now hide obsolete user options. | ||
| 723 | Obsolete user options are no longer shown in the listings produced by | ||
| 724 | the commands 'customize', 'customize-group', 'customize-apropos' and | ||
| 725 | 'customize-changed-options'. | ||
| 726 | |||
| 727 | To customize obsolete user options, use 'customize-option' or | ||
| 728 | 'customize-saved'. | ||
| 729 | |||
| 709 | ** Edebug | 730 | ** Edebug |
| 710 | 731 | ||
| 711 | +++ | 732 | +++ |
| @@ -825,12 +846,14 @@ equivalent to '(map (:sym sym))'. | |||
| 825 | 846 | ||
| 826 | +++ | 847 | +++ |
| 827 | *** New commands to filter the package list. | 848 | *** New commands to filter the package list. |
| 828 | The filter command key bindings are as follows: | 849 | The filter commands are bound to the following keys: |
| 829 | 850 | ||
| 830 | key binding | 851 | key binding |
| 831 | --- ------- | 852 | --- ------- |
| 832 | / a package-menu-filter-by-archive | 853 | / a package-menu-filter-by-archive |
| 854 | / d package-menu-filter-by-description | ||
| 833 | / k package-menu-filter-by-keyword | 855 | / k package-menu-filter-by-keyword |
| 856 | / N package-menu-filter-by-name-or-description | ||
| 834 | / n package-menu-filter-by-name | 857 | / n package-menu-filter-by-name |
| 835 | / s package-menu-filter-by-status | 858 | / s package-menu-filter-by-status |
| 836 | / v package-menu-filter-by-version | 859 | / v package-menu-filter-by-version |
| @@ -872,7 +895,7 @@ Customize 'gdb-max-source-window-count' to use more than one window. | |||
| 872 | Control source file display by 'gdb-display-source-buffer-action'. | 895 | Control source file display by 'gdb-display-source-buffer-action'. |
| 873 | 896 | ||
| 874 | +++ | 897 | +++ |
| 875 | *** The default value of gdb-mi-decode-strings is now t. | 898 | *** The default value of 'gdb-mi-decode-strings' is now t. |
| 876 | This means that the default coding-system is now used to decode strings | 899 | This means that the default coding-system is now used to decode strings |
| 877 | and source file names from GDB. | 900 | and source file names from GDB. |
| 878 | 901 | ||
| @@ -1141,8 +1164,8 @@ project's root directory, respectively. | |||
| 1141 | ** xref | 1164 | ** xref |
| 1142 | 1165 | ||
| 1143 | --- | 1166 | --- |
| 1144 | *** Prefix arg of 'xref-goto-xref' quits the *xref* buffer. | 1167 | *** Prefix arg of 'xref-goto-xref' quits the "*xref*" buffer. |
| 1145 | So typing 'C-u RET' in the *xref* buffer quits its window | 1168 | So typing 'C-u RET' in the "*xref*" buffer quits its window |
| 1146 | before navigating to the selected location. | 1169 | before navigating to the selected location. |
| 1147 | 1170 | ||
| 1148 | ** json.el | 1171 | ** json.el |
| @@ -1305,6 +1328,11 @@ This new command (bound to 'C-c C-l') regenerates the current hunk. | |||
| 1305 | 1328 | ||
| 1306 | ** Miscellaneous | 1329 | ** Miscellaneous |
| 1307 | 1330 | ||
| 1331 | --- | ||
| 1332 | *** New user option 'bibtex-unify-case-convert'. | ||
| 1333 | This new option allows the user to customize how case is converted | ||
| 1334 | when unifying entries. | ||
| 1335 | |||
| 1308 | +++ | 1336 | +++ |
| 1309 | *** 'format-seconds' can now be used for sub-second times. | 1337 | *** 'format-seconds' can now be used for sub-second times. |
| 1310 | The new optional "," parameter has been added, and | 1338 | The new optional "," parameter has been added, and |
| @@ -1320,7 +1348,7 @@ buffers. This can be controlled by customizing the variable | |||
| 1320 | --- | 1348 | --- |
| 1321 | *** New user option 'compilation-search-all-directories'. | 1349 | *** New user option 'compilation-search-all-directories'. |
| 1322 | When doing parallel builds, directories and compilation errors may | 1350 | When doing parallel builds, directories and compilation errors may |
| 1323 | arrive in the *compilation* buffer out-of-order. If this variable is | 1351 | arrive in the "*compilation*" buffer out-of-order. If this variable is |
| 1324 | non-nil (the default), Emacs will now search backwards in the buffer | 1352 | non-nil (the default), Emacs will now search backwards in the buffer |
| 1325 | for any directory the file with errors may be in. If nil, this won't | 1353 | for any directory the file with errors may be in. If nil, this won't |
| 1326 | be done (and this restores how this previously worked). | 1354 | be done (and this restores how this previously worked). |
| @@ -1750,6 +1778,17 @@ ledit.el, lmenu.el, lucid.el and old-whitespace.el. | |||
| 1750 | * Lisp Changes in Emacs 28.1 | 1778 | * Lisp Changes in Emacs 28.1 |
| 1751 | 1779 | ||
| 1752 | +++ | 1780 | +++ |
| 1781 | ** 'read-char-from-minibuffer' and 'y-or-n-p' support 'help-form'. | ||
| 1782 | If you bind 'help-form' to a non-nil value while calling these functions, | ||
| 1783 | then pressing 'C-h' (help-char) causes the function to evaluate 'help-form' | ||
| 1784 | and display the result. | ||
| 1785 | |||
| 1786 | +++ | ||
| 1787 | ** 'set-window-configuration' now takes an optional 'dont-set-frame' | ||
| 1788 | parameter which, when non-nil, instructs the function not to select | ||
| 1789 | the frame recorded in the configuration. | ||
| 1790 | |||
| 1791 | +++ | ||
| 1753 | ** 'define-globalized-minor-mode' now takes a ':predicate' parameter. | 1792 | ** 'define-globalized-minor-mode' now takes a ':predicate' parameter. |
| 1754 | This can be used to control which major modes the minor mode should be | 1793 | This can be used to control which major modes the minor mode should be |
| 1755 | used in. | 1794 | used in. |
| @@ -1992,7 +2031,7 @@ image API via 'M-x report-emacs-bug'. | |||
| 1992 | 2031 | ||
| 1993 | -- | 2032 | -- |
| 1994 | ** On macOS, 's-<left>' and 's-<right>' are now bound to | 2033 | ** On macOS, 's-<left>' and 's-<right>' are now bound to |
| 1995 | 'move-beginning-of-line' and 'move-end-of-line' respectively. The commands | 2034 | 'move-beginning-of-line' and 'move-end-of-line' respectively. The commands |
| 1996 | to select previous/next frame are still bound to 's-~' and 's-`'. | 2035 | to select previous/next frame are still bound to 's-~' and 's-`'. |
| 1997 | 2036 | ||
| 1998 | 2037 | ||
diff --git a/etc/PROBLEMS b/etc/PROBLEMS index 8ed92ab75e0..f24c6f03c8e 100644 --- a/etc/PROBLEMS +++ b/etc/PROBLEMS | |||
| @@ -352,11 +352,11 @@ is the current directory. | |||
| 352 | *** Set find-function-C-source-directory accordingly. | 352 | *** Set find-function-C-source-directory accordingly. |
| 353 | 353 | ||
| 354 | Once you have installed the source package, for example at | 354 | Once you have installed the source package, for example at |
| 355 | /home/myself/deb-src/emacs-26.3, add the following line to your | 355 | /home/myself/deb-src/emacs-27.1, add the following line to your |
| 356 | startup file: | 356 | startup file: |
| 357 | 357 | ||
| 358 | (setq find-function-C-source-directory | 358 | (setq find-function-C-source-directory |
| 359 | "/home/myself/deb-src/emacs-26.3/src/") | 359 | "/home/myself/deb-src/emacs-27.1/src/") |
| 360 | 360 | ||
| 361 | The installation directory of the Emacs source package will contain | 361 | The installation directory of the Emacs source package will contain |
| 362 | the exact package name and version number of Emacs that is installed | 362 | the exact package name and version number of Emacs that is installed |
| @@ -386,7 +386,7 @@ To get describe-function and similar commands to work, you can then | |||
| 386 | add something like the following to your startup file: | 386 | add something like the following to your startup file: |
| 387 | 387 | ||
| 388 | (setq find-function-C-source-directory | 388 | (setq find-function-C-source-directory |
| 389 | "/usr/src/debug/emacs-26.3-1.fc31.x86_64/src/") | 389 | "/usr/src/debug/emacs-27.1-1.fc31.x86_64/src/") |
| 390 | 390 | ||
| 391 | However, the exact directory name will depend on the system, and you | 391 | However, the exact directory name will depend on the system, and you |
| 392 | will need to both upgrade source and debug info when your system | 392 | will need to both upgrade source and debug info when your system |
diff --git a/lib-src/etags.c b/lib-src/etags.c index 146cf612505..4315771a496 100644 --- a/lib-src/etags.c +++ b/lib-src/etags.c | |||
| @@ -1974,14 +1974,13 @@ make_tag (const char *name, /* tag name, or NULL if unnamed */ | |||
| 1974 | 1974 | ||
| 1975 | /* Record a tag. */ | 1975 | /* Record a tag. */ |
| 1976 | static void | 1976 | static void |
| 1977 | pfnote (char *name, bool is_func, char *linestart, ptrdiff_t linelen, | 1977 | pfnote (char *name, /* tag name, or NULL if unnamed */ |
| 1978 | intmax_t lno, intmax_t cno) | 1978 | bool is_func, /* tag is a function */ |
| 1979 | /* tag name, or NULL if unnamed */ | 1979 | char *linestart, /* start of the line where tag is */ |
| 1980 | /* tag is a function */ | 1980 | ptrdiff_t linelen, /* length of the line where tag is */ |
| 1981 | /* start of the line where tag is */ | 1981 | intmax_t lno, /* line number */ |
| 1982 | /* length of the line where tag is */ | 1982 | intmax_t cno) /* character number */ |
| 1983 | /* line number */ | 1983 | |
| 1984 | /* character number */ | ||
| 1985 | { | 1984 | { |
| 1986 | register node *np; | 1985 | register node *np; |
| 1987 | 1986 | ||
| @@ -2905,15 +2904,13 @@ static void make_C_tag (bool); | |||
| 2905 | */ | 2904 | */ |
| 2906 | 2905 | ||
| 2907 | static bool | 2906 | static bool |
| 2908 | consider_token (char *str, ptrdiff_t len, int c, int *c_extp, | 2907 | consider_token (char *str, /* IN: token pointer */ |
| 2909 | ptrdiff_t bracelev, ptrdiff_t parlev, bool *is_func_or_var) | 2908 | ptrdiff_t len, /* IN: token length */ |
| 2910 | /* IN: token pointer */ | 2909 | int c, /* IN: first char after the token */ |
| 2911 | /* IN: token length */ | 2910 | int *c_extp, /* IN, OUT: C extensions mask */ |
| 2912 | /* IN: first char after the token */ | 2911 | ptrdiff_t bracelev, /* IN: brace level */ |
| 2913 | /* IN, OUT: C extensions mask */ | 2912 | ptrdiff_t parlev, /* IN: parenthesis level */ |
| 2914 | /* IN: brace level */ | 2913 | bool *is_func_or_var) /* OUT: function or variable found */ |
| 2915 | /* IN: parenthesis level */ | ||
| 2916 | /* OUT: function or variable found */ | ||
| 2917 | { | 2914 | { |
| 2918 | /* When structdef is stagseen, scolonseen, or snone with bracelev > 0, | 2915 | /* When structdef is stagseen, scolonseen, or snone with bracelev > 0, |
| 2919 | structtype is the type of the preceding struct-like keyword, and | 2916 | structtype is the type of the preceding struct-like keyword, and |
| @@ -3312,9 +3309,8 @@ perhaps_more_input (FILE *inf) | |||
| 3312 | * C syntax and adds them to the list. | 3309 | * C syntax and adds them to the list. |
| 3313 | */ | 3310 | */ |
| 3314 | static void | 3311 | static void |
| 3315 | C_entries (int c_ext, FILE *inf) | 3312 | C_entries (int c_ext, /* extension of C */ |
| 3316 | /* extension of C */ | 3313 | FILE *inf) /* input file */ |
| 3317 | /* input file */ | ||
| 3318 | { | 3314 | { |
| 3319 | char c; /* latest char read; '\0' for end of line */ | 3315 | char c; /* latest char read; '\0' for end of line */ |
| 3320 | char *lp; /* pointer one beyond the character `c' */ | 3316 | char *lp; /* pointer one beyond the character `c' */ |
diff --git a/lib-src/make-fingerprint.c b/lib-src/make-fingerprint.c index c013d0aca3b..b72ee90bbca 100644 --- a/lib-src/make-fingerprint.c +++ b/lib-src/make-fingerprint.c | |||
| @@ -19,9 +19,12 @@ You should have received a copy of the GNU General Public License | |||
| 19 | along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ | 19 | along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ |
| 20 | 20 | ||
| 21 | 21 | ||
| 22 | /* The arguments given to this program are all the object files that | 22 | /* The argument given to this program is the initial version of the |
| 23 | go into building GNU Emacs. There is no special search logic to find | 23 | temacs executable file used when building GNU Emacs. This program computes |
| 24 | the files. */ | 24 | a digest fingerprint for the executable, and modifies the binary in |
| 25 | place, replacing all instances of the existing fingerprint (normally | ||
| 26 | the default fingerprint from libgnu's lib/fingerprint.c) with the | ||
| 27 | new value. With option -r, it just prints the digest. */ | ||
| 25 | 28 | ||
| 26 | #include <config.h> | 29 | #include <config.h> |
| 27 | 30 | ||
diff --git a/lisp/allout.el b/lisp/allout.el index b56071de59e..a4802a1c2a6 100644 --- a/lisp/allout.el +++ b/lisp/allout.el | |||
| @@ -5583,12 +5583,11 @@ used verbatim." | |||
| 5583 | "Return copy of STRING for literal reproduction across LaTeX processing. | 5583 | "Return copy of STRING for literal reproduction across LaTeX processing. |
| 5584 | Expresses the original characters (including carriage returns) of the | 5584 | Expresses the original characters (including carriage returns) of the |
| 5585 | string across LaTeX processing." | 5585 | string across LaTeX processing." |
| 5586 | (mapconcat (function | 5586 | (mapconcat (lambda (char) |
| 5587 | (lambda (char) | 5587 | (cond ((memq char '(?\\ ?$ ?% ?# ?& ?{ ?} ?_ ?^ ?- ?*)) |
| 5588 | (cond ((memq char '(?\\ ?$ ?% ?# ?& ?{ ?} ?_ ?^ ?- ?*)) | 5588 | (concat "\\char" (number-to-string char) "{}")) |
| 5589 | (concat "\\char" (number-to-string char) "{}")) | 5589 | ((= char ?\n) "\\\\") |
| 5590 | ((= char ?\n) "\\\\") | 5590 | (t (char-to-string char)))) |
| 5591 | (t (char-to-string char))))) | ||
| 5592 | string | 5591 | string |
| 5593 | "")) | 5592 | "")) |
| 5594 | ;;;_ > allout-latex-verbatim-quote-curr-line () | 5593 | ;;;_ > allout-latex-verbatim-quote-curr-line () |
diff --git a/lisp/calc/calc-aent.el b/lisp/calc/calc-aent.el index 6c162b55f7b..338f0ea43e0 100644 --- a/lisp/calc/calc-aent.el +++ b/lisp/calc/calc-aent.el | |||
| @@ -76,8 +76,8 @@ | |||
| 76 | (calc-refresh-evaltos (nth 2 (nth 1 (car alg-exp)))) | 76 | (calc-refresh-evaltos (nth 2 (nth 1 (car alg-exp)))) |
| 77 | (setq alg-exp (list (nth 2 (car alg-exp))))) | 77 | (setq alg-exp (list (nth 2 (car alg-exp))))) |
| 78 | (setq calc-quick-prev-results alg-exp | 78 | (setq calc-quick-prev-results alg-exp |
| 79 | buf (mapconcat (function (lambda (x) | 79 | buf (mapconcat (lambda (x) |
| 80 | (math-format-value x 1000))) | 80 | (math-format-value x 1000)) |
| 81 | alg-exp | 81 | alg-exp |
| 82 | " ") | 82 | " ") |
| 83 | shortbuf buf) | 83 | shortbuf buf) |
| @@ -197,18 +197,17 @@ | |||
| 197 | (calc-language (if (memq calc-language '(nil big)) | 197 | (calc-language (if (memq calc-language '(nil big)) |
| 198 | 'flat calc-language)) | 198 | 'flat calc-language)) |
| 199 | (calc-dollar-values (mapcar | 199 | (calc-dollar-values (mapcar |
| 200 | (function | 200 | (lambda (x) |
| 201 | (lambda (x) | 201 | (if (stringp x) |
| 202 | (if (stringp x) | 202 | (progn |
| 203 | (progn | 203 | (setq x (math-read-exprs x)) |
| 204 | (setq x (math-read-exprs x)) | 204 | (if (eq (car-safe x) |
| 205 | (if (eq (car-safe x) | 205 | 'error) |
| 206 | 'error) | 206 | (throw 'calc-error |
| 207 | (throw 'calc-error | 207 | (calc-eval-error |
| 208 | (calc-eval-error | 208 | (cdr x))) |
| 209 | (cdr x))) | 209 | (car x))) |
| 210 | (car x))) | 210 | x)) |
| 211 | x))) | ||
| 212 | args)) | 211 | args)) |
| 213 | (calc-dollar-used 0) | 212 | (calc-dollar-used 0) |
| 214 | (res (if (stringp str) | 213 | (res (if (stringp str) |
| @@ -640,10 +639,10 @@ in Calc algebraic input.") | |||
| 640 | (math-find-user-tokens (car (car p))) | 639 | (math-find-user-tokens (car (car p))) |
| 641 | (setq p (cdr p))) | 640 | (setq p (cdr p))) |
| 642 | (setq calc-user-tokens (mapconcat 'identity | 641 | (setq calc-user-tokens (mapconcat 'identity |
| 643 | (sort (mapcar 'car math-toks) | 642 | (sort (mapcar #'car math-toks) |
| 644 | (function (lambda (x y) | 643 | (lambda (x y) |
| 645 | (> (length x) | 644 | (> (length x) |
| 646 | (length y))))) | 645 | (length y)))) |
| 647 | "\\|") | 646 | "\\|") |
| 648 | calc-last-main-parse-table mtab | 647 | calc-last-main-parse-table mtab |
| 649 | calc-last-user-lang-parse-table ltab | 648 | calc-last-user-lang-parse-table ltab |
diff --git a/lisp/calc/calc-alg.el b/lisp/calc/calc-alg.el index efb68395f7e..53ca01d9516 100644 --- a/lisp/calc/calc-alg.el +++ b/lisp/calc/calc-alg.el | |||
| @@ -1785,7 +1785,7 @@ and should return the simplified expression to use (or nil)." | |||
| 1785 | (cons (nth 2 expr) math-poly-neg-powers)))) | 1785 | (cons (nth 2 expr) math-poly-neg-powers)))) |
| 1786 | (not (Math-zerop (nth 2 expr))) | 1786 | (not (Math-zerop (nth 2 expr))) |
| 1787 | (let ((p1 (math-is-poly-rec (nth 1 expr) negpow))) | 1787 | (let ((p1 (math-is-poly-rec (nth 1 expr) negpow))) |
| 1788 | (mapcar (function (lambda (x) (math-div x (nth 2 expr)))) | 1788 | (mapcar (lambda (x) (math-div x (nth 2 expr))) |
| 1789 | p1)))) | 1789 | p1)))) |
| 1790 | ((and (eq (car expr) 'calcFunc-exp) | 1790 | ((and (eq (car expr) 'calcFunc-exp) |
| 1791 | (equal math-var '(var e var-e))) | 1791 | (equal math-var '(var e var-e))) |
| @@ -1838,8 +1838,9 @@ and should return the simplified expression to use (or nil)." | |||
| 1838 | (defun math-polynomial-base (top-expr &optional pred) | 1838 | (defun math-polynomial-base (top-expr &optional pred) |
| 1839 | "Find the variable (or sub-expression) which is the base of polynomial expr." | 1839 | "Find the variable (or sub-expression) which is the base of polynomial expr." |
| 1840 | (let ((math-poly-base-pred | 1840 | (let ((math-poly-base-pred |
| 1841 | (or pred (function (lambda (base) (math-polynomial-p | 1841 | (or pred (lambda (base) |
| 1842 | top-expr base)))))) | 1842 | (math-polynomial-p |
| 1843 | top-expr base))))) | ||
| 1843 | (or (let ((math-poly-base-const-ok nil)) | 1844 | (or (let ((math-poly-base-const-ok nil)) |
| 1844 | (math-polynomial-base-rec top-expr)) | 1845 | (math-polynomial-base-rec top-expr)) |
| 1845 | (let ((math-poly-base-const-ok t)) | 1846 | (let ((math-poly-base-const-ok t)) |
diff --git a/lisp/calc/calc-arith.el b/lisp/calc/calc-arith.el index ae397c4f2c4..c11cecfd545 100644 --- a/lisp/calc/calc-arith.el +++ b/lisp/calc/calc-arith.el | |||
| @@ -2390,7 +2390,7 @@ | |||
| 2390 | (math-trunc (nth 3 a))))) | 2390 | (math-trunc (nth 3 a))))) |
| 2391 | ((math-provably-integerp a) a) | 2391 | ((math-provably-integerp a) a) |
| 2392 | ((Math-vectorp a) | 2392 | ((Math-vectorp a) |
| 2393 | (math-map-vec (function (lambda (x) (math-trunc x math-trunc-prec))) a)) | 2393 | (math-map-vec (lambda (x) (math-trunc x math-trunc-prec)) a)) |
| 2394 | ((math-infinitep a) | 2394 | ((math-infinitep a) |
| 2395 | (if (or (math-posp a) (math-negp a)) | 2395 | (if (or (math-posp a) (math-negp a)) |
| 2396 | a | 2396 | a |
| @@ -2453,7 +2453,7 @@ | |||
| 2453 | (math-add (math-floor (nth 3 a)) -1) | 2453 | (math-add (math-floor (nth 3 a)) -1) |
| 2454 | (math-floor (nth 3 a))))) | 2454 | (math-floor (nth 3 a))))) |
| 2455 | ((Math-vectorp a) | 2455 | ((Math-vectorp a) |
| 2456 | (math-map-vec (function (lambda (x) (math-floor x math-floor-prec))) a)) | 2456 | (math-map-vec (lambda (x) (math-floor x math-floor-prec)) a)) |
| 2457 | ((math-infinitep a) | 2457 | ((math-infinitep a) |
| 2458 | (if (or (math-posp a) (math-negp a)) | 2458 | (if (or (math-posp a) (math-negp a)) |
| 2459 | a | 2459 | a |
| @@ -2520,7 +2520,7 @@ | |||
| 2520 | (math-ceiling (nth 2 a))) | 2520 | (math-ceiling (nth 2 a))) |
| 2521 | (math-ceiling (nth 3 a)))) | 2521 | (math-ceiling (nth 3 a)))) |
| 2522 | ((Math-vectorp a) | 2522 | ((Math-vectorp a) |
| 2523 | (math-map-vec (function (lambda (x) (math-ceiling x prec))) a)) | 2523 | (math-map-vec (lambda (x) (math-ceiling x prec)) a)) |
| 2524 | ((math-infinitep a) | 2524 | ((math-infinitep a) |
| 2525 | (if (or (math-posp a) (math-negp a)) | 2525 | (if (or (math-posp a) (math-negp a)) |
| 2526 | a | 2526 | a |
| @@ -2573,7 +2573,7 @@ | |||
| 2573 | ((eq (car a) 'intv) | 2573 | ((eq (car a) 'intv) |
| 2574 | (math-floor (math-add a '(frac 1 2)))) | 2574 | (math-floor (math-add a '(frac 1 2)))) |
| 2575 | ((Math-vectorp a) | 2575 | ((Math-vectorp a) |
| 2576 | (math-map-vec (function (lambda (x) (math-round x prec))) a)) | 2576 | (math-map-vec (lambda (x) (math-round x prec)) a)) |
| 2577 | ((math-infinitep a) | 2577 | ((math-infinitep a) |
| 2578 | (if (or (math-posp a) (math-negp a)) | 2578 | (if (or (math-posp a) (math-negp a)) |
| 2579 | a | 2579 | a |
| @@ -2656,7 +2656,7 @@ | |||
| 2656 | (calcFunc-scf (nth 2 x) n) | 2656 | (calcFunc-scf (nth 2 x) n) |
| 2657 | (calcFunc-scf (nth 3 x) n)))) | 2657 | (calcFunc-scf (nth 3 x) n)))) |
| 2658 | ((eq (car x) 'vec) | 2658 | ((eq (car x) 'vec) |
| 2659 | (math-map-vec (function (lambda (x) (calcFunc-scf x n))) x)) | 2659 | (math-map-vec (lambda (x) (calcFunc-scf x n)) x)) |
| 2660 | ((math-infinitep x) | 2660 | ((math-infinitep x) |
| 2661 | x) | 2661 | x) |
| 2662 | (t | 2662 | (t |
diff --git a/lisp/calc/calc-ext.el b/lisp/calc/calc-ext.el index 23248ce1bd5..4877fa6e08c 100644 --- a/lisp/calc/calc-ext.el +++ b/lisp/calc/calc-ext.el | |||
| @@ -678,14 +678,13 @@ | |||
| 678 | 678 | ||
| 679 | (calc-init-prefixes) | 679 | (calc-init-prefixes) |
| 680 | 680 | ||
| 681 | (mapc (function | 681 | (mapc (lambda (x) |
| 682 | (lambda (x) | ||
| 683 | (define-key calc-mode-map (format "c%c" x) 'calc-clean-num) | 682 | (define-key calc-mode-map (format "c%c" x) 'calc-clean-num) |
| 684 | (define-key calc-mode-map (format "j%c" x) 'calc-select-part) | 683 | (define-key calc-mode-map (format "j%c" x) 'calc-select-part) |
| 685 | (define-key calc-mode-map (format "r%c" x) 'calc-recall-quick) | 684 | (define-key calc-mode-map (format "r%c" x) 'calc-recall-quick) |
| 686 | (define-key calc-mode-map (format "s%c" x) 'calc-store-quick) | 685 | (define-key calc-mode-map (format "s%c" x) 'calc-store-quick) |
| 687 | (define-key calc-mode-map (format "t%c" x) 'calc-store-into-quick) | 686 | (define-key calc-mode-map (format "t%c" x) 'calc-store-into-quick) |
| 688 | (define-key calc-mode-map (format "u%c" x) 'calc-quick-units))) | 687 | (define-key calc-mode-map (format "u%c" x) 'calc-quick-units)) |
| 689 | "0123456789") | 688 | "0123456789") |
| 690 | 689 | ||
| 691 | (let ((i ?A)) | 690 | (let ((i ?A)) |
| @@ -711,9 +710,9 @@ | |||
| 711 | (define-key calc-alg-map "\e\177" 'calc-pop-above) | 710 | (define-key calc-alg-map "\e\177" 'calc-pop-above) |
| 712 | 711 | ||
| 713 | ;;;; (Autoloads here) | 712 | ;;;; (Autoloads here) |
| 714 | (mapc (function (lambda (x) | 713 | (mapc (lambda (x) |
| 715 | (mapcar (function (lambda (func) (autoload func (car x)))) | 714 | (mapcar (lambda (func) (autoload func (car x))) |
| 716 | (cdr x)))) | 715 | (cdr x))) |
| 717 | '( | 716 | '( |
| 718 | 717 | ||
| 719 | ("calc-alg" calc-has-rules math-defsimplify | 718 | ("calc-alg" calc-has-rules math-defsimplify |
| @@ -980,9 +979,9 @@ calc-force-refresh calc-locate-cursor-element calc-show-edit-buffer) | |||
| 980 | 979 | ||
| 981 | )) | 980 | )) |
| 982 | 981 | ||
| 983 | (mapcar (function (lambda (x) | 982 | (mapcar (lambda (x) |
| 984 | (mapcar (function (lambda (cmd) (autoload cmd (car x) nil t))) | 983 | (mapcar (lambda (cmd) (autoload cmd (car x) nil t)) |
| 985 | (cdr x)))) | 984 | (cdr x))) |
| 986 | '( | 985 | '( |
| 987 | 986 | ||
| 988 | ("calc-alg" calc-alg-evaluate calc-apart calc-collect calc-expand | 987 | ("calc-alg" calc-alg-evaluate calc-apart calc-collect calc-expand |
| @@ -1358,7 +1357,7 @@ calc-kill calc-kill-region calc-yank)))) | |||
| 1358 | calc-redo-list nil) | 1357 | calc-redo-list nil) |
| 1359 | (let (calc-stack calc-user-parse-tables calc-standard-date-formats | 1358 | (let (calc-stack calc-user-parse-tables calc-standard-date-formats |
| 1360 | calc-invocation-macro) | 1359 | calc-invocation-macro) |
| 1361 | (mapc (function (lambda (v) (set v nil))) calc-local-var-list) | 1360 | (mapc (lambda (v) (set v nil)) calc-local-var-list) |
| 1362 | (if (and arg (<= arg 0)) | 1361 | (if (and arg (<= arg 0)) |
| 1363 | (calc-mode-var-list-restore-default-values) | 1362 | (calc-mode-var-list-restore-default-values) |
| 1364 | (calc-mode-var-list-restore-saved-values))) | 1363 | (calc-mode-var-list-restore-saved-values))) |
| @@ -1658,7 +1657,7 @@ calc-kill calc-kill-region calc-yank)))) | |||
| 1658 | (calc-pop-stack n 1 t) | 1657 | (calc-pop-stack n 1 t) |
| 1659 | (calc-push-list (mapcar #'car entries) | 1658 | (calc-push-list (mapcar #'car entries) |
| 1660 | 1 | 1659 | 1 |
| 1661 | (mapcar (function (lambda (x) (nth 2 x))) | 1660 | (mapcar (lambda (x) (nth 2 x)) |
| 1662 | entries))))))) | 1661 | entries))))))) |
| 1663 | 1662 | ||
| 1664 | (defvar calc-refreshing-evaltos nil) | 1663 | (defvar calc-refreshing-evaltos nil) |
| @@ -1924,11 +1923,10 @@ calc-kill calc-kill-region calc-yank)))) | |||
| 1924 | (let* ((calc-z-prefix-msgs nil) | 1923 | (let* ((calc-z-prefix-msgs nil) |
| 1925 | (calc-z-prefix-buf "") | 1924 | (calc-z-prefix-buf "") |
| 1926 | (kmap (sort (copy-sequence (calc-user-key-map)) | 1925 | (kmap (sort (copy-sequence (calc-user-key-map)) |
| 1927 | (function (lambda (x y) (< (car x) (car y)))))) | 1926 | (lambda (x y) (< (car x) (car y))))) |
| 1928 | (flags (apply #'logior | 1927 | (flags (apply #'logior |
| 1929 | (mapcar (function | 1928 | (mapcar (lambda (k) |
| 1930 | (lambda (k) | 1929 | (calc-user-function-classify (car k))) |
| 1931 | (calc-user-function-classify (car k)))) | ||
| 1932 | kmap)))) | 1930 | kmap)))) |
| 1933 | (if (= (logand flags 8) 0) | 1931 | (if (= (logand flags 8) 0) |
| 1934 | (calc-user-function-list kmap 7) | 1932 | (calc-user-function-list kmap 7) |
| @@ -2633,9 +2631,8 @@ If X is not an error form, return 1." | |||
| 2633 | (let ((rhs (calc-top-n 1))) | 2631 | (let ((rhs (calc-top-n 1))) |
| 2634 | (calc-enter-result (- 1 n) | 2632 | (calc-enter-result (- 1 n) |
| 2635 | name | 2633 | name |
| 2636 | (mapcar (function | 2634 | (mapcar (lambda (x) |
| 2637 | (lambda (x) | 2635 | (list func x rhs)) |
| 2638 | (list func x rhs))) | ||
| 2639 | (calc-top-list-n (- n) 2)))))))) | 2636 | (calc-top-list-n (- n) 2)))))))) |
| 2640 | 2637 | ||
| 2641 | (defun calc-unary-op-fancy (name func arg) | 2638 | (defun calc-unary-op-fancy (name func arg) |
| @@ -2644,9 +2641,8 @@ If X is not an error form, return 1." | |||
| 2644 | (cond ((> n 0) | 2641 | (cond ((> n 0) |
| 2645 | (calc-enter-result n | 2642 | (calc-enter-result n |
| 2646 | name | 2643 | name |
| 2647 | (mapcar (function | 2644 | (mapcar (lambda (x) |
| 2648 | (lambda (x) | 2645 | (list func x)) |
| 2649 | (list func x))) | ||
| 2650 | (calc-top-list-n n)))) | 2646 | (calc-top-list-n n)))) |
| 2651 | ((< n 0) | 2647 | ((< n 0) |
| 2652 | (calc-enter-result 1 | 2648 | (calc-enter-result 1 |
diff --git a/lisp/calc/calc-forms.el b/lisp/calc/calc-forms.el index 465d4520b05..39116bfde99 100644 --- a/lisp/calc/calc-forms.el +++ b/lisp/calc/calc-forms.el | |||
| @@ -2129,7 +2129,7 @@ and ends on the last Sunday of October at 2 a.m." | |||
| 2129 | ((memq (car n) '(+ - / vec neg)) | 2129 | ((memq (car n) '(+ - / vec neg)) |
| 2130 | (math-normalize | 2130 | (math-normalize |
| 2131 | (cons (car n) | 2131 | (cons (car n) |
| 2132 | (mapcar (function (lambda (x) (math-make-mod x m))) | 2132 | (mapcar (lambda (x) (math-make-mod x m)) |
| 2133 | (cdr n))))) | 2133 | (cdr n))))) |
| 2134 | ((and (eq (car n) '*) (Math-anglep (nth 1 n))) | 2134 | ((and (eq (car n) '*) (Math-anglep (nth 1 n))) |
| 2135 | (math-mul (math-make-mod (nth 1 n) m) (nth 2 n))) | 2135 | (math-mul (math-make-mod (nth 1 n) m) (nth 2 n))) |
diff --git a/lisp/calc/calc-frac.el b/lisp/calc/calc-frac.el index 86a4808c5ad..1d6895caa3a 100644 --- a/lisp/calc/calc-frac.el +++ b/lisp/calc/calc-frac.el | |||
| @@ -132,9 +132,8 @@ | |||
| 132 | (cond ((Math-ratp a) | 132 | (cond ((Math-ratp a) |
| 133 | a) | 133 | a) |
| 134 | ((memq (car a) '(cplx polar vec hms date sdev intv mod)) | 134 | ((memq (car a) '(cplx polar vec hms date sdev intv mod)) |
| 135 | (cons (car a) (mapcar (function | 135 | (cons (car a) (mapcar (lambda (x) |
| 136 | (lambda (x) | 136 | (calcFunc-frac x tol)) |
| 137 | (calcFunc-frac x tol))) | ||
| 138 | (cdr a)))) | 137 | (cdr a)))) |
| 139 | ((Math-messy-integerp a) | 138 | ((Math-messy-integerp a) |
| 140 | (math-trunc a)) | 139 | (math-trunc a)) |
diff --git a/lisp/calc/calc-funcs.el b/lisp/calc/calc-funcs.el index 5c179ff05d4..9ee86e755ea 100644 --- a/lisp/calc/calc-funcs.el +++ b/lisp/calc/calc-funcs.el | |||
| @@ -797,12 +797,11 @@ | |||
| 797 | (math-reduce-vec | 797 | (math-reduce-vec |
| 798 | 'math-add | 798 | 'math-add |
| 799 | (cons 'vec | 799 | (cons 'vec |
| 800 | (mapcar (function | 800 | (mapcar (lambda (c) |
| 801 | (lambda (c) | 801 | (setq k (1+ k)) |
| 802 | (setq k (1+ k)) | 802 | (math-mul (math-mul fac c) |
| 803 | (math-mul (math-mul fac c) | 803 | (math-sub (math-pow x1 k) |
| 804 | (math-sub (math-pow x1 k) | 804 | (math-pow x2 k)))) |
| 805 | (math-pow x2 k))))) | ||
| 806 | coefs))) | 805 | coefs))) |
| 807 | x))) | 806 | x))) |
| 808 | (math-mul (math-pow 2 n) | 807 | (math-mul (math-pow 2 n) |
diff --git a/lisp/calc/calc-help.el b/lisp/calc/calc-help.el index 0b327e8d0f6..06b4b9684e3 100644 --- a/lisp/calc/calc-help.el +++ b/lisp/calc/calc-help.el | |||
| @@ -402,32 +402,32 @@ C-w Describe how there is no warranty for Calc." | |||
| 402 | "Or type `h i' to read the full Calc manual on-line.\n\n")) | 402 | "Or type `h i' to read the full Calc manual on-line.\n\n")) |
| 403 | (princ "Basic keys:\n") | 403 | (princ "Basic keys:\n") |
| 404 | (let* ((calc-full-help-flag t)) | 404 | (let* ((calc-full-help-flag t)) |
| 405 | (mapc (function (lambda (x) (princ (format | 405 | (mapc (lambda (x) |
| 406 | " %s\n" | 406 | (princ (format |
| 407 | (substitute-command-keys x))))) | 407 | " %s\n" |
| 408 | (substitute-command-keys x)))) | ||
| 408 | (nreverse (cdr (reverse (cdr (calc-help)))))) | 409 | (nreverse (cdr (reverse (cdr (calc-help)))))) |
| 409 | (mapc (function (lambda (prefix) | 410 | (mapc (lambda (prefix) |
| 410 | (let ((msgs (ignore-errors (funcall prefix)))) | 411 | (let ((msgs (ignore-errors (funcall prefix)))) |
| 411 | (if (car msgs) | 412 | (if (car msgs) |
| 412 | (princ | 413 | (princ |
| 413 | (if (eq (nth 2 msgs) ?v) | 414 | (if (eq (nth 2 msgs) ?v) |
| 414 | (format-message | 415 | (format-message |
| 415 | "\n`v' or `V' prefix (vector/matrix) keys: \n") | 416 | "\n`v' or `V' prefix (vector/matrix) keys: \n") |
| 416 | (if (nth 2 msgs) | 417 | (if (nth 2 msgs) |
| 417 | (format-message | 418 | (format-message |
| 418 | "\n`%c' prefix (%s) keys:\n" | 419 | "\n`%c' prefix (%s) keys:\n" |
| 419 | (nth 2 msgs) | 420 | (nth 2 msgs) |
| 420 | (or (cdr (assq (nth 2 msgs) | 421 | (or (cdr (assq (nth 2 msgs) |
| 421 | calc-help-long-names)) | 422 | calc-help-long-names)) |
| 422 | (nth 1 msgs))) | 423 | (nth 1 msgs))) |
| 423 | (format "\n%s-modified keys:\n" | 424 | (format "\n%s-modified keys:\n" |
| 424 | (capitalize (nth 1 msgs))))))) | 425 | (capitalize (nth 1 msgs))))))) |
| 425 | (mapcar (function | 426 | (mapcar (lambda (x) |
| 426 | (lambda (x) | 427 | (princ (format |
| 427 | (princ (format | 428 | " %s\n" |
| 428 | " %s\n" | 429 | (substitute-command-keys x)))) |
| 429 | (substitute-command-keys x))))) | 430 | (car msgs)))) |
| 430 | (car msgs))))) | ||
| 431 | '(calc-inverse-prefix-help | 431 | '(calc-inverse-prefix-help |
| 432 | calc-hyperbolic-prefix-help | 432 | calc-hyperbolic-prefix-help |
| 433 | calc-inv-hyp-prefix-help | 433 | calc-inv-hyp-prefix-help |
diff --git a/lisp/calc/calc-lang.el b/lisp/calc/calc-lang.el index bde5abe649f..283069446e0 100644 --- a/lisp/calc/calc-lang.el +++ b/lisp/calc/calc-lang.el | |||
| @@ -175,20 +175,19 @@ | |||
| 175 | (put 'c 'math-vector-brackets "{}") | 175 | (put 'c 'math-vector-brackets "{}") |
| 176 | 176 | ||
| 177 | (put 'c 'math-radix-formatter | 177 | (put 'c 'math-radix-formatter |
| 178 | (function (lambda (r s) | 178 | (lambda (r s) |
| 179 | (if (= r 16) (format "0x%s" s) | 179 | (if (= r 16) (format "0x%s" s) |
| 180 | (if (= r 8) (format "0%s" s) | 180 | (if (= r 8) (format "0%s" s) |
| 181 | (format "%d#%s" r s)))))) | 181 | (format "%d#%s" r s))))) |
| 182 | 182 | ||
| 183 | (put 'c 'math-compose-subscr | 183 | (put 'c 'math-compose-subscr |
| 184 | (function | 184 | (lambda (a) |
| 185 | (lambda (a) | 185 | (let ((args (cdr (cdr a)))) |
| 186 | (let ((args (cdr (cdr a)))) | 186 | (list 'horiz |
| 187 | (list 'horiz | 187 | (math-compose-expr (nth 1 a) 1000) |
| 188 | (math-compose-expr (nth 1 a) 1000) | 188 | "[" |
| 189 | "[" | 189 | (math-compose-vector args ", " 0) |
| 190 | (math-compose-vector args ", " 0) | 190 | "]")))) |
| 191 | "]"))))) | ||
| 192 | 191 | ||
| 193 | (add-to-list 'calc-lang-slash-idiv 'c) | 192 | (add-to-list 'calc-lang-slash-idiv 'c) |
| 194 | (add-to-list 'calc-lang-allow-underscores 'c) | 193 | (add-to-list 'calc-lang-allow-underscores 'c) |
| @@ -238,9 +237,9 @@ | |||
| 238 | (put 'pascal 'math-output-filter 'calc-output-case-filter) | 237 | (put 'pascal 'math-output-filter 'calc-output-case-filter) |
| 239 | 238 | ||
| 240 | (put 'pascal 'math-radix-formatter | 239 | (put 'pascal 'math-radix-formatter |
| 241 | (function (lambda (r s) | 240 | (lambda (r s) |
| 242 | (if (= r 16) (format "$%s" s) | 241 | (if (= r 16) (format "$%s" s) |
| 243 | (format "%d#%s" r s))))) | 242 | (format "%d#%s" r s)))) |
| 244 | 243 | ||
| 245 | (put 'pascal 'math-lang-read-symbol | 244 | (put 'pascal 'math-lang-read-symbol |
| 246 | '((?\$ | 245 | '((?\$ |
| @@ -253,17 +252,16 @@ | |||
| 253 | math-exp-pos (match-end 1))))) | 252 | math-exp-pos (match-end 1))))) |
| 254 | 253 | ||
| 255 | (put 'pascal 'math-compose-subscr | 254 | (put 'pascal 'math-compose-subscr |
| 256 | (function | 255 | (lambda (a) |
| 257 | (lambda (a) | 256 | (let ((args (cdr (cdr a)))) |
| 258 | (let ((args (cdr (cdr a)))) | 257 | (while (eq (car-safe (nth 1 a)) 'calcFunc-subscr) |
| 259 | (while (eq (car-safe (nth 1 a)) 'calcFunc-subscr) | 258 | (setq args (append (cdr (cdr (nth 1 a))) args) |
| 260 | (setq args (append (cdr (cdr (nth 1 a))) args) | 259 | a (nth 1 a))) |
| 261 | a (nth 1 a))) | 260 | (list 'horiz |
| 262 | (list 'horiz | 261 | (math-compose-expr (nth 1 a) 1000) |
| 263 | (math-compose-expr (nth 1 a) 1000) | 262 | "[" |
| 264 | "[" | 263 | (math-compose-vector args ", " 0) |
| 265 | (math-compose-vector args ", " 0) | 264 | "]")))) |
| 266 | "]"))))) | ||
| 267 | 265 | ||
| 268 | (add-to-list 'calc-lang-allow-underscores 'pascal) | 266 | (add-to-list 'calc-lang-allow-underscores 'pascal) |
| 269 | (add-to-list 'calc-lang-brackets-are-subscripts 'pascal) | 267 | (add-to-list 'calc-lang-brackets-are-subscripts 'pascal) |
| @@ -350,17 +348,16 @@ | |||
| 350 | math-exp-pos (match-end 0))))) | 348 | math-exp-pos (match-end 0))))) |
| 351 | 349 | ||
| 352 | (put 'fortran 'math-compose-subscr | 350 | (put 'fortran 'math-compose-subscr |
| 353 | (function | 351 | (lambda (a) |
| 354 | (lambda (a) | 352 | (let ((args (cdr (cdr a)))) |
| 355 | (let ((args (cdr (cdr a)))) | 353 | (while (eq (car-safe (nth 1 a)) 'calcFunc-subscr) |
| 356 | (while (eq (car-safe (nth 1 a)) 'calcFunc-subscr) | 354 | (setq args (append (cdr (cdr (nth 1 a))) args) |
| 357 | (setq args (append (cdr (cdr (nth 1 a))) args) | 355 | a (nth 1 a))) |
| 358 | a (nth 1 a))) | 356 | (list 'horiz |
| 359 | (list 'horiz | 357 | (math-compose-expr (nth 1 a) 1000) |
| 360 | (math-compose-expr (nth 1 a) 1000) | 358 | "(" |
| 361 | "(" | 359 | (math-compose-vector args ", " 0) |
| 362 | (math-compose-vector args ", " 0) | 360 | ")")))) |
| 363 | ")"))))) | ||
| 364 | 361 | ||
| 365 | (add-to-list 'calc-lang-slash-idiv 'fortran) | 362 | (add-to-list 'calc-lang-slash-idiv 'fortran) |
| 366 | (add-to-list 'calc-lang-allow-underscores 'fortran) | 363 | (add-to-list 'calc-lang-allow-underscores 'fortran) |
| @@ -598,18 +595,17 @@ | |||
| 598 | (put 'tex 'math-input-filter 'math-tex-input-filter) | 595 | (put 'tex 'math-input-filter 'math-tex-input-filter) |
| 599 | 596 | ||
| 600 | (put 'tex 'math-matrix-formatter | 597 | (put 'tex 'math-matrix-formatter |
| 601 | (function | 598 | (lambda (a) |
| 602 | (lambda (a) | 599 | (if (and (integerp calc-language-option) |
| 603 | (if (and (integerp calc-language-option) | 600 | (or (= calc-language-option 0) |
| 604 | (or (= calc-language-option 0) | 601 | (> calc-language-option 1) |
| 605 | (> calc-language-option 1) | 602 | (< calc-language-option -1))) |
| 606 | (< calc-language-option -1))) | 603 | (append '(vleft 0 "\\matrix{") |
| 607 | (append '(vleft 0 "\\matrix{") | 604 | (math-compose-tex-matrix (cdr a)) |
| 608 | (math-compose-tex-matrix (cdr a)) | 605 | '("}")) |
| 609 | '("}")) | 606 | (append '(horiz "\\matrix{ ") |
| 610 | (append '(horiz "\\matrix{ ") | 607 | (math-compose-tex-matrix (cdr a)) |
| 611 | (math-compose-tex-matrix (cdr a)) | 608 | '(" }"))))) |
| 612 | '(" }")))))) | ||
| 613 | 609 | ||
| 614 | (put 'tex 'math-var-formatter 'math-compose-tex-var) | 610 | (put 'tex 'math-var-formatter 'math-compose-tex-var) |
| 615 | 611 | ||
| @@ -839,18 +835,17 @@ | |||
| 839 | (put 'latex 'math-complex-format 'i) | 835 | (put 'latex 'math-complex-format 'i) |
| 840 | 836 | ||
| 841 | (put 'latex 'math-matrix-formatter | 837 | (put 'latex 'math-matrix-formatter |
| 842 | (function | 838 | (lambda (a) |
| 843 | (lambda (a) | 839 | (if (and (integerp calc-language-option) |
| 844 | (if (and (integerp calc-language-option) | 840 | (or (= calc-language-option 0) |
| 845 | (or (= calc-language-option 0) | 841 | (> calc-language-option 1) |
| 846 | (> calc-language-option 1) | 842 | (< calc-language-option -1))) |
| 847 | (< calc-language-option -1))) | 843 | (append '(vleft 0 "\\begin{pmatrix}") |
| 848 | (append '(vleft 0 "\\begin{pmatrix}") | 844 | (math-compose-tex-matrix (cdr a) t) |
| 849 | (math-compose-tex-matrix (cdr a) t) | 845 | '("\\end{pmatrix}")) |
| 850 | '("\\end{pmatrix}")) | 846 | (append '(horiz "\\begin{pmatrix} ") |
| 851 | (append '(horiz "\\begin{pmatrix} ") | 847 | (math-compose-tex-matrix (cdr a) t) |
| 852 | (math-compose-tex-matrix (cdr a) t) | 848 | '(" \\end{pmatrix}"))))) |
| 853 | '(" \\end{pmatrix}")))))) | ||
| 854 | 849 | ||
| 855 | (put 'latex 'math-var-formatter 'math-compose-tex-var) | 850 | (put 'latex 'math-var-formatter 'math-compose-tex-var) |
| 856 | 851 | ||
| @@ -1023,36 +1018,34 @@ | |||
| 1023 | (put 'eqn 'math-evalto '("evalto " . " -> ")) | 1018 | (put 'eqn 'math-evalto '("evalto " . " -> ")) |
| 1024 | 1019 | ||
| 1025 | (put 'eqn 'math-matrix-formatter | 1020 | (put 'eqn 'math-matrix-formatter |
| 1026 | (function | 1021 | (lambda (a) |
| 1027 | (lambda (a) | 1022 | (append '(horiz "matrix { ") |
| 1028 | (append '(horiz "matrix { ") | 1023 | (math-compose-eqn-matrix |
| 1029 | (math-compose-eqn-matrix | 1024 | (cdr (math-transpose a))) |
| 1030 | (cdr (math-transpose a))) | 1025 | '("}")))) |
| 1031 | '("}"))))) | ||
| 1032 | 1026 | ||
| 1033 | (put 'eqn 'math-var-formatter | 1027 | (put 'eqn 'math-var-formatter |
| 1034 | (function | 1028 | (lambda (a prec) |
| 1035 | (lambda (a prec) | 1029 | (let (v) |
| 1036 | (let (v) | 1030 | (if (and math-compose-hash-args |
| 1037 | (if (and math-compose-hash-args | 1031 | (let ((p calc-arg-values)) |
| 1038 | (let ((p calc-arg-values)) | 1032 | (setq v 1) |
| 1039 | (setq v 1) | 1033 | (while (and p (not (equal (car p) a))) |
| 1040 | (while (and p (not (equal (car p) a))) | 1034 | (setq p (and (eq math-compose-hash-args t) (cdr p)) |
| 1041 | (setq p (and (eq math-compose-hash-args t) (cdr p)) | 1035 | v (1+ v))) |
| 1042 | v (1+ v))) | 1036 | p)) |
| 1043 | p)) | 1037 | (if (eq math-compose-hash-args 1) |
| 1044 | (if (eq math-compose-hash-args 1) | 1038 | "#" |
| 1045 | "#" | 1039 | (format "#%d" v)) |
| 1046 | (format "#%d" v)) | 1040 | (if (string-match ".'\\'" (symbol-name (nth 2 a))) |
| 1047 | (if (string-match ".'\\'" (symbol-name (nth 2 a))) | 1041 | (math-compose-expr |
| 1048 | (math-compose-expr | 1042 | (list 'calcFunc-Prime |
| 1049 | (list 'calcFunc-Prime | 1043 | (list |
| 1050 | (list | 1044 | 'var |
| 1051 | 'var | 1045 | (intern (substring (symbol-name (nth 1 a)) 0 -1)) |
| 1052 | (intern (substring (symbol-name (nth 1 a)) 0 -1)) | 1046 | (intern (substring (symbol-name (nth 2 a)) 0 -1)))) |
| 1053 | (intern (substring (symbol-name (nth 2 a)) 0 -1)))) | 1047 | prec) |
| 1054 | prec) | 1048 | (symbol-name (nth 1 a))))))) |
| 1055 | (symbol-name (nth 1 a)))))))) | ||
| 1056 | 1049 | ||
| 1057 | (defconst math-eqn-special-funcs | 1050 | (defconst math-eqn-special-funcs |
| 1058 | '( calcFunc-log | 1051 | '( calcFunc-log |
| @@ -1065,31 +1058,30 @@ | |||
| 1065 | calcFunc-arcsinh calcFunc-arccosh calcFunc-arctanh)) | 1058 | calcFunc-arcsinh calcFunc-arccosh calcFunc-arctanh)) |
| 1066 | 1059 | ||
| 1067 | (put 'eqn 'math-func-formatter | 1060 | (put 'eqn 'math-func-formatter |
| 1068 | (function | 1061 | (lambda (func a) |
| 1069 | (lambda (func a) | 1062 | (let (left right) |
| 1070 | (let (left right) | 1063 | (if (string-match "[^']'+\\'" func) |
| 1071 | (if (string-match "[^']'+\\'" func) | 1064 | (let ((n (- (length func) (match-beginning 0) 1))) |
| 1072 | (let ((n (- (length func) (match-beginning 0) 1))) | 1065 | (setq func (substring func 0 (- n))) |
| 1073 | (setq func (substring func 0 (- n))) | 1066 | (while (>= (setq n (1- n)) 0) |
| 1074 | (while (>= (setq n (1- n)) 0) | 1067 | (setq func (concat func " prime"))))) |
| 1075 | (setq func (concat func " prime"))))) | 1068 | (cond ((or (> (length a) 2) |
| 1076 | (cond ((or (> (length a) 2) | 1069 | (not (math-tex-expr-is-flat (nth 1 a)))) |
| 1077 | (not (math-tex-expr-is-flat (nth 1 a)))) | 1070 | (setq left "{left ( " |
| 1078 | (setq left "{left ( " | 1071 | right " right )}")) |
| 1079 | right " right )}")) | 1072 | |
| 1080 | 1073 | ((and | |
| 1081 | ((and | 1074 | (memq (car a) math-eqn-special-funcs) |
| 1082 | (memq (car a) math-eqn-special-funcs) | 1075 | (= (length a) 2) |
| 1083 | (= (length a) 2) | 1076 | (or (Math-realp (nth 1 a)) |
| 1084 | (or (Math-realp (nth 1 a)) | 1077 | (memq (car (nth 1 a)) '(var *)))) |
| 1085 | (memq (car (nth 1 a)) '(var *)))) | 1078 | (setq left "~{" right "}")) |
| 1086 | (setq left "~{" right "}")) | 1079 | (t |
| 1087 | (t | 1080 | (setq left " ( " |
| 1088 | (setq left " ( " | 1081 | right " )"))) |
| 1089 | right " )"))) | 1082 | (list 'horiz func left |
| 1090 | (list 'horiz func left | 1083 | (math-compose-vector (cdr a) " , " 0) |
| 1091 | (math-compose-vector (cdr a) " , " 0) | 1084 | right)))) |
| 1092 | right))))) | ||
| 1093 | 1085 | ||
| 1094 | (put 'eqn 'math-lang-read-symbol | 1086 | (put 'eqn 'math-lang-read-symbol |
| 1095 | '((?\" | 1087 | '((?\" |
| @@ -1111,23 +1103,22 @@ | |||
| 1111 | ("above" punc ","))) | 1103 | ("above" punc ","))) |
| 1112 | 1104 | ||
| 1113 | (put 'eqn 'math-lang-adjust-words | 1105 | (put 'eqn 'math-lang-adjust-words |
| 1114 | (function | 1106 | (lambda () |
| 1115 | (lambda () | 1107 | (let ((code (assoc math-expr-data math-eqn-ignore-words))) |
| 1116 | (let ((code (assoc math-expr-data math-eqn-ignore-words))) | 1108 | (cond ((null code)) |
| 1117 | (cond ((null code)) | 1109 | ((null (cdr code)) |
| 1118 | ((null (cdr code)) | 1110 | (math-read-token)) |
| 1119 | (math-read-token)) | 1111 | ((consp (nth 1 code)) |
| 1120 | ((consp (nth 1 code)) | 1112 | (math-read-token) |
| 1121 | (math-read-token) | 1113 | (if (assoc math-expr-data (cdr code)) |
| 1122 | (if (assoc math-expr-data (cdr code)) | 1114 | (setq math-expr-data (format "%s %s" |
| 1123 | (setq math-expr-data (format "%s %s" | 1115 | (car code) math-expr-data)))) |
| 1124 | (car code) math-expr-data)))) | 1116 | ((eq (nth 1 code) 'punc) |
| 1125 | ((eq (nth 1 code) 'punc) | 1117 | (setq math-exp-token 'punc |
| 1126 | (setq math-exp-token 'punc | 1118 | math-expr-data (nth 2 code))) |
| 1127 | math-expr-data (nth 2 code))) | 1119 | (t |
| 1128 | (t | 1120 | (math-read-token) |
| 1129 | (math-read-token) | 1121 | (math-read-token)))))) |
| 1130 | (math-read-token))))))) | ||
| 1131 | 1122 | ||
| 1132 | (put 'eqn 'math-lang-read | 1123 | (put 'eqn 'math-lang-read |
| 1133 | '((eq (string-match "->\\|<-\\|\\+-\\|\\\\dots\\|~\\|\\^" | 1124 | '((eq (string-match "->\\|<-\\|\\+-\\|\\\\dots\\|~\\|\\^" |
| @@ -1357,14 +1348,13 @@ | |||
| 1357 | ( calcFunc-in . (math-lang-compose-switch-args "Contains")))) | 1348 | ( calcFunc-in . (math-lang-compose-switch-args "Contains")))) |
| 1358 | 1349 | ||
| 1359 | (put 'yacas 'math-compose-subscr | 1350 | (put 'yacas 'math-compose-subscr |
| 1360 | (function | 1351 | (lambda (a) |
| 1361 | (lambda (a) | 1352 | (let ((args (cdr (cdr a)))) |
| 1362 | (let ((args (cdr (cdr a)))) | 1353 | (list 'horiz |
| 1363 | (list 'horiz | 1354 | (math-compose-expr (nth 1 a) 1000) |
| 1364 | (math-compose-expr (nth 1 a) 1000) | 1355 | "[" |
| 1365 | "[" | 1356 | (math-compose-vector args ", " 0) |
| 1366 | (math-compose-vector args ", " 0) | 1357 | "]")))) |
| 1367 | "]"))))) | ||
| 1368 | 1358 | ||
| 1369 | (defun math-yacas-parse-Sum (f _val) | 1359 | (defun math-yacas-parse-Sum (f _val) |
| 1370 | "Read in the arguments to \"Sum\" in Calc's Yacas mode." | 1360 | "Read in the arguments to \"Sum\" in Calc's Yacas mode." |
| @@ -1600,24 +1590,22 @@ | |||
| 1600 | (add-to-list 'calc-lang-brackets-are-subscripts 'maxima) | 1590 | (add-to-list 'calc-lang-brackets-are-subscripts 'maxima) |
| 1601 | 1591 | ||
| 1602 | (put 'maxima 'math-compose-subscr | 1592 | (put 'maxima 'math-compose-subscr |
| 1603 | (function | 1593 | (lambda (a) |
| 1604 | (lambda (a) | 1594 | (let ((args (cdr (cdr a)))) |
| 1605 | (let ((args (cdr (cdr a)))) | 1595 | (list 'horiz |
| 1606 | (list 'horiz | 1596 | (math-compose-expr (nth 1 a) 1000) |
| 1607 | (math-compose-expr (nth 1 a) 1000) | 1597 | "[" |
| 1608 | "[" | 1598 | (math-compose-vector args ", " 0) |
| 1609 | (math-compose-vector args ", " 0) | 1599 | "]")))) |
| 1610 | "]"))))) | ||
| 1611 | 1600 | ||
| 1612 | (put 'maxima 'math-matrix-formatter | 1601 | (put 'maxima 'math-matrix-formatter |
| 1613 | (function | 1602 | (lambda (a) |
| 1614 | (lambda (a) | 1603 | (list 'horiz |
| 1615 | (list 'horiz | 1604 | "matrix(" |
| 1616 | "matrix(" | 1605 | (math-compose-vector (cdr a) |
| 1617 | (math-compose-vector (cdr a) | 1606 | (concat math-comp-comma " ") |
| 1618 | (concat math-comp-comma " ") | 1607 | math-comp-vector-prec) |
| 1619 | math-comp-vector-prec) | 1608 | ")"))) |
| 1620 | ")")))) | ||
| 1621 | 1609 | ||
| 1622 | 1610 | ||
| 1623 | ;;; Giac | 1611 | ;;; Giac |
| @@ -1806,15 +1794,14 @@ order to Calc's." | |||
| 1806 | (add-to-list 'calc-lang-allow-underscores 'giac) | 1794 | (add-to-list 'calc-lang-allow-underscores 'giac) |
| 1807 | 1795 | ||
| 1808 | (put 'giac 'math-compose-subscr | 1796 | (put 'giac 'math-compose-subscr |
| 1809 | (function | 1797 | (lambda (a) |
| 1810 | (lambda (a) | 1798 | ;; (let ((args (cdr (cdr a)))) |
| 1811 | ;; (let ((args (cdr (cdr a)))) | 1799 | (list 'horiz |
| 1812 | (list 'horiz | 1800 | (math-compose-expr (nth 1 a) 1000) |
| 1813 | (math-compose-expr (nth 1 a) 1000) | 1801 | "[" |
| 1814 | "[" | 1802 | (math-compose-expr |
| 1815 | (math-compose-expr | 1803 | (calc-normalize (list '- (nth 2 a) 1)) 0) |
| 1816 | (calc-normalize (list '- (nth 2 a) 1)) 0) | 1804 | "]"))) ;;) |
| 1817 | "]")))) ;;) | ||
| 1818 | 1805 | ||
| 1819 | (defun math-read-giac-subscr (x _op) | 1806 | (defun math-read-giac-subscr (x _op) |
| 1820 | (let ((idx (math-read-expr-level 0))) | 1807 | (let ((idx (math-read-expr-level 0))) |
| @@ -1932,7 +1919,7 @@ order to Calc's." | |||
| 1932 | (put 'math 'math-function-close "]") | 1919 | (put 'math 'math-function-close "]") |
| 1933 | 1920 | ||
| 1934 | (put 'math 'math-radix-formatter | 1921 | (put 'math 'math-radix-formatter |
| 1935 | (function (lambda (r s) (format "%d^^%s" r s)))) | 1922 | (lambda (r s) (format "%d^^%s" r s))) |
| 1936 | 1923 | ||
| 1937 | (put 'math 'math-lang-read | 1924 | (put 'math 'math-lang-read |
| 1938 | '((eq (string-match "\\[\\[\\|->\\|:>" math-exp-str math-exp-pos) | 1925 | '((eq (string-match "\\[\\[\\|->\\|:>" math-exp-str math-exp-pos) |
| @@ -1942,13 +1929,12 @@ order to Calc's." | |||
| 1942 | math-exp-pos (match-end 0)))) | 1929 | math-exp-pos (match-end 0)))) |
| 1943 | 1930 | ||
| 1944 | (put 'math 'math-compose-subscr | 1931 | (put 'math 'math-compose-subscr |
| 1945 | (function | 1932 | (lambda (a) |
| 1946 | (lambda (a) | 1933 | (list 'horiz |
| 1947 | (list 'horiz | 1934 | (math-compose-expr (nth 1 a) 1000) |
| 1948 | (math-compose-expr (nth 1 a) 1000) | 1935 | "[[" |
| 1949 | "[[" | 1936 | (math-compose-expr (nth 2 a) 0) |
| 1950 | (math-compose-expr (nth 2 a) 0) | 1937 | "]]"))) |
| 1951 | "]]")))) | ||
| 1952 | 1938 | ||
| 1953 | (defun math-read-math-subscr (x _op) | 1939 | (defun math-read-math-subscr (x _op) |
| 1954 | (let ((idx (math-read-expr-level 0))) | 1940 | (let ((idx (math-read-expr-level 0))) |
| @@ -2038,26 +2024,24 @@ order to Calc's." | |||
| 2038 | (put 'maple 'math-complex-format 'I) | 2024 | (put 'maple 'math-complex-format 'I) |
| 2039 | 2025 | ||
| 2040 | (put 'maple 'math-matrix-formatter | 2026 | (put 'maple 'math-matrix-formatter |
| 2041 | (function | 2027 | (lambda (a) |
| 2042 | (lambda (a) | 2028 | (list 'horiz |
| 2043 | (list 'horiz | 2029 | "matrix(" |
| 2044 | "matrix(" | 2030 | math-comp-left-bracket |
| 2045 | math-comp-left-bracket | 2031 | (math-compose-vector (cdr a) |
| 2046 | (math-compose-vector (cdr a) | 2032 | (concat math-comp-comma " ") |
| 2047 | (concat math-comp-comma " ") | 2033 | math-comp-vector-prec) |
| 2048 | math-comp-vector-prec) | 2034 | math-comp-right-bracket |
| 2049 | math-comp-right-bracket | 2035 | ")"))) |
| 2050 | ")")))) | ||
| 2051 | 2036 | ||
| 2052 | (put 'maple 'math-compose-subscr | 2037 | (put 'maple 'math-compose-subscr |
| 2053 | (function | 2038 | (lambda (a) |
| 2054 | (lambda (a) | 2039 | (let ((args (cdr (cdr a)))) |
| 2055 | (let ((args (cdr (cdr a)))) | 2040 | (list 'horiz |
| 2056 | (list 'horiz | 2041 | (math-compose-expr (nth 1 a) 1000) |
| 2057 | (math-compose-expr (nth 1 a) 1000) | 2042 | "[" |
| 2058 | "[" | 2043 | (math-compose-vector args ", " 0) |
| 2059 | (math-compose-vector args ", " 0) | 2044 | "]")))) |
| 2060 | "]"))))) | ||
| 2061 | 2045 | ||
| 2062 | (add-to-list 'calc-lang-allow-underscores 'maple) | 2046 | (add-to-list 'calc-lang-allow-underscores 'maple) |
| 2063 | (add-to-list 'calc-lang-brackets-are-subscripts 'maple) | 2047 | (add-to-list 'calc-lang-brackets-are-subscripts 'maple) |
diff --git a/lisp/calc/calc-macs.el b/lisp/calc/calc-macs.el index 5aaa5f48d6c..06ef3ef0556 100644 --- a/lisp/calc/calc-macs.el +++ b/lisp/calc/calc-macs.el | |||
| @@ -33,12 +33,12 @@ | |||
| 33 | 33 | ||
| 34 | 34 | ||
| 35 | (defmacro calc-wrapper (&rest body) | 35 | (defmacro calc-wrapper (&rest body) |
| 36 | `(calc-do (function (lambda () | 36 | `(calc-do (lambda () |
| 37 | ,@body)))) | 37 | ,@body))) |
| 38 | 38 | ||
| 39 | (defmacro calc-slow-wrapper (&rest body) | 39 | (defmacro calc-slow-wrapper (&rest body) |
| 40 | `(calc-do | 40 | `(calc-do |
| 41 | (function (lambda () ,@body)) (point))) | 41 | (lambda () ,@body) (point))) |
| 42 | 42 | ||
| 43 | (defmacro math-showing-full-precision (form) | 43 | (defmacro math-showing-full-precision (form) |
| 44 | `(let ((calc-float-format calc-full-float-format)) | 44 | `(let ((calc-float-format calc-full-float-format)) |
diff --git a/lisp/calc/calc-map.el b/lisp/calc/calc-map.el index 0ee82826927..3e2869d146a 100644 --- a/lisp/calc/calc-map.el +++ b/lisp/calc/calc-map.el | |||
| @@ -612,14 +612,13 @@ | |||
| 612 | "()") | 612 | "()") |
| 613 | minibuffer-local-map | 613 | minibuffer-local-map |
| 614 | t))) | 614 | t))) |
| 615 | (setq math-arglist (mapcar (function | 615 | (setq math-arglist (mapcar (lambda (x) |
| 616 | (lambda (x) | 616 | (list 'var |
| 617 | (list 'var | 617 | x |
| 618 | x | 618 | (intern |
| 619 | (intern | 619 | (concat |
| 620 | (concat | 620 | "var-" |
| 621 | "var-" | 621 | (symbol-name x))))) |
| 622 | (symbol-name x)))))) | ||
| 623 | math-arglist)))) | 622 | math-arglist)))) |
| 624 | (setq oper (list "$" | 623 | (setq oper (list "$" |
| 625 | (length math-arglist) | 624 | (length math-arglist) |
| @@ -962,12 +961,12 @@ | |||
| 962 | (apply 'calcFunc-mapeqp func args))) | 961 | (apply 'calcFunc-mapeqp func args))) |
| 963 | 962 | ||
| 964 | (defun calcFunc-mapeqr (func &rest args) | 963 | (defun calcFunc-mapeqr (func &rest args) |
| 965 | (setq args (mapcar (function (lambda (x) | 964 | (setq args (mapcar (lambda (x) |
| 966 | (let ((func (assq (car-safe x) | 965 | (let ((func (assq (car-safe x) |
| 967 | calc-tweak-eqn-table))) | 966 | calc-tweak-eqn-table))) |
| 968 | (if func | 967 | (if func |
| 969 | (cons (nth 1 func) (cdr x)) | 968 | (cons (nth 1 func) (cdr x)) |
| 970 | x)))) | 969 | x))) |
| 971 | args)) | 970 | args)) |
| 972 | (apply 'calcFunc-mapeqp func args)) | 971 | (apply 'calcFunc-mapeqp func args)) |
| 973 | 972 | ||
| @@ -1092,28 +1091,28 @@ | |||
| 1092 | (defun calcFunc-reducea (func vec) | 1091 | (defun calcFunc-reducea (func vec) |
| 1093 | (if (math-matrixp vec) | 1092 | (if (math-matrixp vec) |
| 1094 | (cons 'vec | 1093 | (cons 'vec |
| 1095 | (mapcar (function (lambda (x) (calcFunc-reducer func x))) | 1094 | (mapcar (lambda (x) (calcFunc-reducer func x)) |
| 1096 | (cdr vec))) | 1095 | (cdr vec))) |
| 1097 | (calcFunc-reducer func vec))) | 1096 | (calcFunc-reducer func vec))) |
| 1098 | 1097 | ||
| 1099 | (defun calcFunc-rreducea (func vec) | 1098 | (defun calcFunc-rreducea (func vec) |
| 1100 | (if (math-matrixp vec) | 1099 | (if (math-matrixp vec) |
| 1101 | (cons 'vec | 1100 | (cons 'vec |
| 1102 | (mapcar (function (lambda (x) (calcFunc-rreducer func x))) | 1101 | (mapcar (lambda (x) (calcFunc-rreducer func x)) |
| 1103 | (cdr vec))) | 1102 | (cdr vec))) |
| 1104 | (calcFunc-rreducer func vec))) | 1103 | (calcFunc-rreducer func vec))) |
| 1105 | 1104 | ||
| 1106 | (defun calcFunc-reduced (func vec) | 1105 | (defun calcFunc-reduced (func vec) |
| 1107 | (if (math-matrixp vec) | 1106 | (if (math-matrixp vec) |
| 1108 | (cons 'vec | 1107 | (cons 'vec |
| 1109 | (mapcar (function (lambda (x) (calcFunc-reducer func x))) | 1108 | (mapcar (lambda (x) (calcFunc-reducer func x)) |
| 1110 | (cdr (math-transpose vec)))) | 1109 | (cdr (math-transpose vec)))) |
| 1111 | (calcFunc-reducer func vec))) | 1110 | (calcFunc-reducer func vec))) |
| 1112 | 1111 | ||
| 1113 | (defun calcFunc-rreduced (func vec) | 1112 | (defun calcFunc-rreduced (func vec) |
| 1114 | (if (math-matrixp vec) | 1113 | (if (math-matrixp vec) |
| 1115 | (cons 'vec | 1114 | (cons 'vec |
| 1116 | (mapcar (function (lambda (x) (calcFunc-rreducer func x))) | 1115 | (mapcar (lambda (x) (calcFunc-rreducer func x)) |
| 1117 | (cdr (math-transpose vec)))) | 1116 | (cdr (math-transpose vec)))) |
| 1118 | (calcFunc-rreducer func vec))) | 1117 | (calcFunc-rreducer func vec))) |
| 1119 | 1118 | ||
| @@ -1216,10 +1215,10 @@ | |||
| 1216 | (let ((mat nil)) | 1215 | (let ((mat nil)) |
| 1217 | (while (setq a (cdr a)) | 1216 | (while (setq a (cdr a)) |
| 1218 | (setq mat (cons (cons 'vec | 1217 | (setq mat (cons (cons 'vec |
| 1219 | (mapcar (function (lambda (x) | 1218 | (mapcar (lambda (x) |
| 1220 | (math-build-call func | 1219 | (math-build-call func |
| 1221 | (list (car a) | 1220 | (list (car a) |
| 1222 | x)))) | 1221 | x))) |
| 1223 | (cdr b))) | 1222 | (cdr b))) |
| 1224 | mat))) | 1223 | mat))) |
| 1225 | (math-normalize (cons 'vec (nreverse mat))))) | 1224 | (math-normalize (cons 'vec (nreverse mat))))) |
diff --git a/lisp/calc/calc-misc.el b/lisp/calc/calc-misc.el index 2db09e2b677..ada754a3979 100644 --- a/lisp/calc/calc-misc.el +++ b/lisp/calc/calc-misc.el | |||
| @@ -176,9 +176,9 @@ Calc user interface as before (either C-x * C or C-x * K; initially C-x * C). | |||
| 176 | "Create another, independent Calculator buffer." | 176 | "Create another, independent Calculator buffer." |
| 177 | (interactive) | 177 | (interactive) |
| 178 | (if (eq major-mode 'calc-mode) | 178 | (if (eq major-mode 'calc-mode) |
| 179 | (mapc (function | 179 | (mapc (lambda (v) |
| 180 | (lambda (v) | 180 | (set-default v (symbol-value v))) |
| 181 | (set-default v (symbol-value v)))) calc-local-var-list)) | 181 | calc-local-var-list)) |
| 182 | (set-buffer (generate-new-buffer "*Calculator*")) | 182 | (set-buffer (generate-new-buffer "*Calculator*")) |
| 183 | (pop-to-buffer (current-buffer)) | 183 | (pop-to-buffer (current-buffer)) |
| 184 | (calc-mode)) | 184 | (calc-mode)) |
| @@ -274,9 +274,8 @@ Calc user interface as before (either C-x * C or C-x * K; initially C-x * C). | |||
| 274 | ;;;###autoload | 274 | ;;;###autoload |
| 275 | (defun calc-do-handle-whys () | 275 | (defun calc-do-handle-whys () |
| 276 | (setq calc-why (sort calc-next-why | 276 | (setq calc-why (sort calc-next-why |
| 277 | (function | 277 | (lambda (x y) |
| 278 | (lambda (x y) | 278 | (and (eq (car x) '*) (not (eq (car y) '*))))) |
| 279 | (and (eq (car x) '*) (not (eq (car y) '*)))))) | ||
| 280 | calc-next-why nil) | 279 | calc-next-why nil) |
| 281 | (if (and calc-why (or (eq calc-auto-why t) | 280 | (if (and calc-why (or (eq calc-auto-why t) |
| 282 | (and (eq (car (car calc-why)) '*) | 281 | (and (eq (car (car calc-why)) '*) |
diff --git a/lisp/calc/calc-mode.el b/lisp/calc/calc-mode.el index e109233a825..358854bc93c 100644 --- a/lisp/calc/calc-mode.el +++ b/lisp/calc/calc-mode.el | |||
| @@ -268,7 +268,7 @@ | |||
| 268 | (interactive) | 268 | (interactive) |
| 269 | (calc-wrapper | 269 | (calc-wrapper |
| 270 | (let (pos | 270 | (let (pos |
| 271 | (vals (mapcar (function (lambda (v) (symbol-value (car v)))) | 271 | (vals (mapcar (lambda (v) (symbol-value (car v))) |
| 272 | calc-mode-var-list))) | 272 | calc-mode-var-list))) |
| 273 | (unless calc-settings-file | 273 | (unless calc-settings-file |
| 274 | (error "No `calc-settings-file' specified")) | 274 | (error "No `calc-settings-file' specified")) |
diff --git a/lisp/calc/calc-mtx.el b/lisp/calc/calc-mtx.el index 8deef7dc4fd..bfcd61ddcd4 100644 --- a/lisp/calc/calc-mtx.el +++ b/lisp/calc/calc-mtx.el | |||
| @@ -55,7 +55,7 @@ | |||
| 55 | (defun math-col-matrix (a) | 55 | (defun math-col-matrix (a) |
| 56 | (if (and (Math-vectorp a) | 56 | (if (and (Math-vectorp a) |
| 57 | (not (math-matrixp a))) | 57 | (not (math-matrixp a))) |
| 58 | (cons 'vec (mapcar (function (lambda (x) (list 'vec x))) (cdr a))) | 58 | (cons 'vec (mapcar (lambda (x) (list 'vec x)) (cdr a))) |
| 59 | a)) | 59 | a)) |
| 60 | 60 | ||
| 61 | 61 | ||
| @@ -79,8 +79,8 @@ | |||
| 79 | (cons 'vec (nreverse mat)))) | 79 | (cons 'vec (nreverse mat)))) |
| 80 | 80 | ||
| 81 | (defun math-mul-mat-vec (a b) | 81 | (defun math-mul-mat-vec (a b) |
| 82 | (cons 'vec (mapcar (function (lambda (row) | 82 | (cons 'vec (mapcar (lambda (row) |
| 83 | (math-dot-product row b))) | 83 | (math-dot-product row b)) |
| 84 | (cdr a)))) | 84 | (cdr a)))) |
| 85 | 85 | ||
| 86 | 86 | ||
diff --git a/lisp/calc/calc-poly.el b/lisp/calc/calc-poly.el index b3f2c96b0ca..5928a8ee47c 100644 --- a/lisp/calc/calc-poly.el +++ b/lisp/calc/calc-poly.el | |||
| @@ -202,7 +202,7 @@ | |||
| 202 | (if (memq (car-safe expr) '(+ -)) | 202 | (if (memq (car-safe expr) '(+ -)) |
| 203 | (math-list-to-sum | 203 | (math-list-to-sum |
| 204 | (sort (math-sum-to-list expr) | 204 | (sort (math-sum-to-list expr) |
| 205 | (function (lambda (a b) (math-beforep (car a) (car b)))))) | 205 | (lambda (a b) (math-beforep (car a) (car b))))) |
| 206 | expr)) | 206 | expr)) |
| 207 | 207 | ||
| 208 | (defun math-list-to-sum (lst) | 208 | (defun math-list-to-sum (lst) |
| @@ -387,7 +387,7 @@ This returns only the remainder from the pseudo-division." | |||
| 387 | lst | 387 | lst |
| 388 | (if (eq a -1) | 388 | (if (eq a -1) |
| 389 | (math-mul-list lst a) | 389 | (math-mul-list lst a) |
| 390 | (mapcar (function (lambda (x) (math-poly-div-exact x a))) lst)))) | 390 | (mapcar (lambda (x) (math-poly-div-exact x a)) lst)))) |
| 391 | 391 | ||
| 392 | (defun math-mul-list (lst a) | 392 | (defun math-mul-list (lst a) |
| 393 | (if (eq a 1) | 393 | (if (eq a 1) |
| @@ -395,7 +395,7 @@ This returns only the remainder from the pseudo-division." | |||
| 395 | (if (eq a -1) | 395 | (if (eq a -1) |
| 396 | (mapcar 'math-neg lst) | 396 | (mapcar 'math-neg lst) |
| 397 | (and (not (eq a 0)) | 397 | (and (not (eq a 0)) |
| 398 | (mapcar (function (lambda (x) (math-mul x a))) lst))))) | 398 | (mapcar (lambda (x) (math-mul x a)) lst))))) |
| 399 | 399 | ||
| 400 | ;;; Run GCD on all elements in a list. | 400 | ;;; Run GCD on all elements in a list. |
| 401 | (defun math-poly-gcd-list (lst) | 401 | (defun math-poly-gcd-list (lst) |
| @@ -502,10 +502,10 @@ Take the base that has the highest degree considering both a and b. | |||
| 502 | 502 | ||
| 503 | (defun math-sort-poly-base-list (lst) | 503 | (defun math-sort-poly-base-list (lst) |
| 504 | "Sort a list of polynomial bases." | 504 | "Sort a list of polynomial bases." |
| 505 | (sort lst (function (lambda (a b) | 505 | (sort lst (lambda (a b) |
| 506 | (or (> (nth 1 a) (nth 1 b)) | 506 | (or (> (nth 1 a) (nth 1 b)) |
| 507 | (and (= (nth 1 a) (nth 1 b)) | 507 | (and (= (nth 1 a) (nth 1 b)) |
| 508 | (math-beforep (car a) (car b)))))))) | 508 | (math-beforep (car a) (car b))))))) |
| 509 | 509 | ||
| 510 | ;;; Given an expression find all variables that are polynomial bases. | 510 | ;;; Given an expression find all variables that are polynomial bases. |
| 511 | ;;; Return list in the form '( (var1 degree1) (var2 degree2) ... ). | 511 | ;;; Return list in the form '( (var1 degree1) (var2 degree2) ... ). |
| @@ -1033,10 +1033,9 @@ If no partial fraction representation can be found, return nil." | |||
| 1033 | (math-transpose | 1033 | (math-transpose |
| 1034 | (cons 'vec | 1034 | (cons 'vec |
| 1035 | (mapcar | 1035 | (mapcar |
| 1036 | (function | 1036 | (lambda (x) |
| 1037 | (lambda (x) | 1037 | (cons 'vec (math-padded-polynomial |
| 1038 | (cons 'vec (math-padded-polynomial | 1038 | x var tdeg))) |
| 1039 | x var tdeg)))) | ||
| 1040 | (cdr eqns)))))) | 1039 | (cdr eqns)))))) |
| 1041 | (and (math-vectorp eqns) | 1040 | (and (math-vectorp eqns) |
| 1042 | (let ((res 0) | 1041 | (let ((res 0) |
diff --git a/lisp/calc/calc-prog.el b/lisp/calc/calc-prog.el index ea9c49748e2..781ba5c8b66 100644 --- a/lisp/calc/calc-prog.el +++ b/lisp/calc/calc-prog.el | |||
| @@ -182,7 +182,7 @@ | |||
| 182 | odef key keyname cmd cmd-base cmd-base-default | 182 | odef key keyname cmd cmd-base cmd-base-default |
| 183 | func calc-user-formula-alist is-symb) | 183 | func calc-user-formula-alist is-symb) |
| 184 | (if is-lambda | 184 | (if is-lambda |
| 185 | (setq math-arglist (mapcar (function (lambda (x) (nth 1 x))) | 185 | (setq math-arglist (mapcar (lambda (x) (nth 1 x)) |
| 186 | (nreverse (cdr (reverse (cdr form))))) | 186 | (nreverse (cdr (reverse (cdr form))))) |
| 187 | form (nth (1- (length form)) form)) | 187 | form (nth (1- (length form)) form)) |
| 188 | (calc-default-formula-arglist form) | 188 | (calc-default-formula-arglist form) |
| @@ -290,10 +290,10 @@ | |||
| 290 | (y-or-n-p | 290 | (y-or-n-p |
| 291 | "Leave it symbolic for non-constant arguments? "))) | 291 | "Leave it symbolic for non-constant arguments? "))) |
| 292 | (setq calc-user-formula-alist | 292 | (setq calc-user-formula-alist |
| 293 | (mapcar (function (lambda (x) | 293 | (mapcar (lambda (x) |
| 294 | (or (cdr (assq x '((nil . arg-nil) | 294 | (or (cdr (assq x '((nil . arg-nil) |
| 295 | (t . arg-t)))) | 295 | (t . arg-t)))) |
| 296 | x))) calc-user-formula-alist)) | 296 | x)) calc-user-formula-alist)) |
| 297 | (if cmd | 297 | (if cmd |
| 298 | (progn | 298 | (progn |
| 299 | (require 'calc-macs) | 299 | (require 'calc-macs) |
| @@ -319,8 +319,8 @@ | |||
| 319 | (append | 319 | (append |
| 320 | (list 'lambda calc-user-formula-alist) | 320 | (list 'lambda calc-user-formula-alist) |
| 321 | (and is-symb | 321 | (and is-symb |
| 322 | (mapcar (function (lambda (v) | 322 | (mapcar (lambda (v) |
| 323 | (list 'math-check-const v t))) | 323 | (list 'math-check-const v t)) |
| 324 | calc-user-formula-alist)) | 324 | calc-user-formula-alist)) |
| 325 | (list body)))) | 325 | (list body)))) |
| 326 | (put func 'calc-user-defn form) | 326 | (put func 'calc-user-defn form) |
diff --git a/lisp/calc/calc-rewr.el b/lisp/calc/calc-rewr.el index 2cc7b6beef0..1528e12ae0e 100644 --- a/lisp/calc/calc-rewr.el +++ b/lisp/calc/calc-rewr.el | |||
| @@ -181,19 +181,18 @@ | |||
| 181 | (calc-line-numbering nil) | 181 | (calc-line-numbering nil) |
| 182 | (calc-show-selections t) | 182 | (calc-show-selections t) |
| 183 | (calc-why nil) | 183 | (calc-why nil) |
| 184 | (math-mt-func (function | 184 | (math-mt-func (lambda (x) |
| 185 | (lambda (x) | 185 | (let ((result (math-apply-rewrites x (cdr crules) |
| 186 | (let ((result (math-apply-rewrites x (cdr crules) | 186 | heads crules))) |
| 187 | heads crules))) | 187 | (if result |
| 188 | (if result | 188 | (progn |
| 189 | (progn | 189 | (if trace-buffer |
| 190 | (if trace-buffer | 190 | (let ((fmt (math-format-stack-value |
| 191 | (let ((fmt (math-format-stack-value | 191 | (list result nil nil)))) |
| 192 | (list result nil nil)))) | 192 | (with-current-buffer trace-buffer |
| 193 | (with-current-buffer trace-buffer | 193 | (insert "\nrewrite to\n" fmt "\n")))) |
| 194 | (insert "\nrewrite to\n" fmt "\n")))) | 194 | (setq heads (math-rewrite-heads result heads t)))) |
| 195 | (setq heads (math-rewrite-heads result heads t)))) | 195 | result)))) |
| 196 | result))))) | ||
| 197 | (if trace-buffer | 196 | (if trace-buffer |
| 198 | (let ((fmt (math-format-stack-value (list math-rewrite-whole-expr nil nil)))) | 197 | (let ((fmt (math-format-stack-value (list math-rewrite-whole-expr nil nil)))) |
| 199 | (with-current-buffer trace-buffer | 198 | (with-current-buffer trace-buffer |
| @@ -485,8 +484,8 @@ | |||
| 485 | (let ((math-rewrite-whole t)) | 484 | (let ((math-rewrite-whole t)) |
| 486 | (cdr (math-compile-rewrites (cons | 485 | (cdr (math-compile-rewrites (cons |
| 487 | 'vec | 486 | 'vec |
| 488 | (mapcar (function (lambda (x) | 487 | (mapcar (lambda (x) |
| 489 | (list 'vec x t))) | 488 | (list 'vec x t)) |
| 490 | (if (eq (car-safe pats) 'vec) | 489 | (if (eq (car-safe pats) 'vec) |
| 491 | (cdr pats) | 490 | (cdr pats) |
| 492 | (list pats))))))))) | 491 | (list pats))))))))) |
| @@ -656,15 +655,14 @@ | |||
| 656 | nil | 655 | nil |
| 657 | (nreverse | 656 | (nreverse |
| 658 | (mapcar | 657 | (mapcar |
| 659 | (function | 658 | (lambda (v) |
| 660 | (lambda (v) | 659 | (and (car v) |
| 661 | (and (car v) | 660 | (list |
| 662 | (list | 661 | 'calcFunc-assign |
| 663 | 'calcFunc-assign | 662 | (math-build-var-name |
| 664 | (math-build-var-name | 663 | (car v)) |
| 665 | (car v)) | 664 | (math-rwcomp-register-expr |
| 666 | (math-rwcomp-register-expr | 665 | (nth 1 v))))) |
| 667 | (nth 1 v)))))) | ||
| 668 | math-regs)))) | 666 | math-regs)))) |
| 669 | (math-rwcomp-match-vars math-rhs)) | 667 | (math-rwcomp-match-vars math-rhs)) |
| 670 | math-remembering) | 668 | math-remembering) |
| @@ -672,7 +670,7 @@ | |||
| 672 | (let* ((heads (math-rewrite-heads math-pattern)) | 670 | (let* ((heads (math-rewrite-heads math-pattern)) |
| 673 | (rule (list (vconcat | 671 | (rule (list (vconcat |
| 674 | (nreverse | 672 | (nreverse |
| 675 | (mapcar (function (lambda (x) (nth 3 x))) | 673 | (mapcar (lambda (x) (nth 3 x)) |
| 676 | math-regs))) | 674 | math-regs))) |
| 677 | math-prog | 675 | math-prog |
| 678 | heads | 676 | heads |
| @@ -724,10 +722,9 @@ | |||
| 724 | (setq rules (cdr rules))) | 722 | (setq rules (cdr rules))) |
| 725 | (if nil-rules | 723 | (if nil-rules |
| 726 | (setq rule-set (cons (cons nil nil-rules) rule-set))) | 724 | (setq rule-set (cons (cons nil nil-rules) rule-set))) |
| 727 | (setq all-heads (mapcar 'car | 725 | (setq all-heads (mapcar #'car |
| 728 | (sort all-heads (function | 726 | (sort all-heads (lambda (x y) |
| 729 | (lambda (x y) | 727 | (< (cdr x) (cdr y)))))) |
| 730 | (< (cdr x) (cdr y))))))) | ||
| 731 | (let ((set rule-set) | 728 | (let ((set rule-set) |
| 732 | rule heads ptr) | 729 | rule heads ptr) |
| 733 | (while set | 730 | (while set |
| @@ -790,15 +787,14 @@ | |||
| 790 | (math-rewrite-heads-rec (car expr))))))) | 787 | (math-rewrite-heads-rec (car expr))))))) |
| 791 | 788 | ||
| 792 | (defun math-parse-schedule (sched) | 789 | (defun math-parse-schedule (sched) |
| 793 | (mapcar (function | 790 | (mapcar (lambda (s) |
| 794 | (lambda (s) | 791 | (if (integerp s) |
| 795 | (if (integerp s) | 792 | s |
| 796 | s | 793 | (if (math-vectorp s) |
| 797 | (if (math-vectorp s) | 794 | (math-parse-schedule (cdr s)) |
| 798 | (math-parse-schedule (cdr s)) | 795 | (if (eq (car-safe s) 'var) |
| 799 | (if (eq (car-safe s) 'var) | 796 | (math-var-to-calcFunc s) |
| 800 | (math-var-to-calcFunc s) | 797 | (error "Improper component in rewrite schedule"))))) |
| 801 | (error "Improper component in rewrite schedule")))))) | ||
| 802 | sched)) | 798 | sched)) |
| 803 | 799 | ||
| 804 | (defun math-rwcomp-match-vars (expr) | 800 | (defun math-rwcomp-match-vars (expr) |
| @@ -1180,9 +1176,8 @@ | |||
| 1180 | (list 'calcFunc-register | 1176 | (list 'calcFunc-register |
| 1181 | reg2)))) | 1177 | reg2)))) |
| 1182 | (math-rwcomp-pattern (car arg2) (cdr arg2)))) | 1178 | (math-rwcomp-pattern (car arg2) (cdr arg2)))) |
| 1183 | (let* ((args (mapcar (function | 1179 | (let* ((args (mapcar (lambda (x) |
| 1184 | (lambda (x) | 1180 | (cons x (math-rwcomp-best-reg x))) |
| 1185 | (cons x (math-rwcomp-best-reg x)))) | ||
| 1186 | (cdr expr))) | 1181 | (cdr expr))) |
| 1187 | (args2 (copy-sequence args)) | 1182 | (args2 (copy-sequence args)) |
| 1188 | (argp (reverse args2)) | 1183 | (argp (reverse args2)) |
diff --git a/lisp/calc/calc-store.el b/lisp/calc/calc-store.el index a1e385cb406..8f83f34d748 100644 --- a/lisp/calc/calc-store.el +++ b/lisp/calc/calc-store.el | |||
| @@ -168,15 +168,13 @@ | |||
| 168 | () | 168 | () |
| 169 | (setq calc-var-name-map (copy-keymap minibuffer-local-completion-map)) | 169 | (setq calc-var-name-map (copy-keymap minibuffer-local-completion-map)) |
| 170 | (define-key calc-var-name-map " " 'self-insert-command) | 170 | (define-key calc-var-name-map " " 'self-insert-command) |
| 171 | (mapc (function | 171 | (mapc (lambda (x) |
| 172 | (lambda (x) | ||
| 173 | (define-key calc-var-name-map (char-to-string x) | 172 | (define-key calc-var-name-map (char-to-string x) |
| 174 | 'calcVar-digit))) | 173 | 'calcVar-digit)) |
| 175 | "0123456789") | 174 | "0123456789") |
| 176 | (mapc (function | 175 | (mapc (lambda (x) |
| 177 | (lambda (x) | ||
| 178 | (define-key calc-var-name-map (char-to-string x) | 176 | (define-key calc-var-name-map (char-to-string x) |
| 179 | 'calcVar-oper))) | 177 | 'calcVar-oper)) |
| 180 | "+-*/^|")) | 178 | "+-*/^|")) |
| 181 | 179 | ||
| 182 | (defvar calc-store-opers) | 180 | (defvar calc-store-opers) |
| @@ -324,10 +322,9 @@ | |||
| 324 | (calc-pop-push-record | 322 | (calc-pop-push-record |
| 325 | (1+ calc-given-value-flag) | 323 | (1+ calc-given-value-flag) |
| 326 | (concat "=" (calc-var-name (car (car var)))) | 324 | (concat "=" (calc-var-name (car (car var)))) |
| 327 | (let ((saved-val (mapcar (function | 325 | (let ((saved-val (mapcar (lambda (v) |
| 328 | (lambda (v) | 326 | (and (boundp (car v)) |
| 329 | (and (boundp (car v)) | 327 | (symbol-value (car v)))) |
| 330 | (symbol-value (car v))))) | ||
| 331 | var))) | 328 | var))) |
| 332 | (unwind-protect | 329 | (unwind-protect |
| 333 | (let ((vv var)) | 330 | (let ((vv var)) |
| @@ -597,13 +594,12 @@ | |||
| 597 | calc-settings-file))) | 594 | calc-settings-file))) |
| 598 | (if var | 595 | (if var |
| 599 | (calc-insert-permanent-variable var) | 596 | (calc-insert-permanent-variable var) |
| 600 | (mapatoms (function | 597 | (mapatoms (lambda (x) |
| 601 | (lambda (x) | 598 | (and (string-match "\\`var-" (symbol-name x)) |
| 602 | (and (string-match "\\`var-" (symbol-name x)) | 599 | (not (memq x calc-dont-insert-variables)) |
| 603 | (not (memq x calc-dont-insert-variables)) | 600 | (calc-var-value x) |
| 604 | (calc-var-value x) | 601 | (not (eq (car-safe (symbol-value x)) 'special-const)) |
| 605 | (not (eq (car-safe (symbol-value x)) 'special-const)) | 602 | (calc-insert-permanent-variable x))))) |
| 606 | (calc-insert-permanent-variable x)))))) | ||
| 607 | (save-buffer)))) | 603 | (save-buffer)))) |
| 608 | 604 | ||
| 609 | 605 | ||
| @@ -638,27 +634,26 @@ | |||
| 638 | (defun calc-insert-variables (buf) | 634 | (defun calc-insert-variables (buf) |
| 639 | (interactive "bBuffer in which to save variable values: ") | 635 | (interactive "bBuffer in which to save variable values: ") |
| 640 | (with-current-buffer buf | 636 | (with-current-buffer buf |
| 641 | (mapatoms (function | 637 | (mapatoms (lambda (x) |
| 642 | (lambda (x) | 638 | (and (string-match "\\`var-" (symbol-name x)) |
| 643 | (and (string-match "\\`var-" (symbol-name x)) | 639 | (not (memq x calc-dont-insert-variables)) |
| 644 | (not (memq x calc-dont-insert-variables)) | 640 | (calc-var-value x) |
| 645 | (calc-var-value x) | 641 | (not (eq (car-safe (symbol-value x)) 'special-const)) |
| 646 | (not (eq (car-safe (symbol-value x)) 'special-const)) | 642 | (or (not (eq x 'var-Decls)) |
| 647 | (or (not (eq x 'var-Decls)) | 643 | (not (equal var-Decls '(vec)))) |
| 648 | (not (equal var-Decls '(vec)))) | 644 | (or (not (eq x 'var-Holidays)) |
| 649 | (or (not (eq x 'var-Holidays)) | 645 | (not (equal var-Holidays '(vec (var sat var-sat) |
| 650 | (not (equal var-Holidays '(vec (var sat var-sat) | 646 | (var sun var-sun))))) |
| 651 | (var sun var-sun))))) | 647 | (insert "(setq " |
| 652 | (insert "(setq " | 648 | (symbol-name x) |
| 653 | (symbol-name x) | 649 | " " |
| 654 | " " | 650 | (prin1-to-string |
| 655 | (prin1-to-string | 651 | (let ((calc-language |
| 656 | (let ((calc-language | 652 | (if (memq calc-language '(nil big)) |
| 657 | (if (memq calc-language '(nil big)) | 653 | 'flat |
| 658 | 'flat | 654 | calc-language))) |
| 659 | calc-language))) | 655 | (math-format-value (symbol-value x) 100000))) |
| 660 | (math-format-value (symbol-value x) 100000))) | 656 | ")\n")))))) |
| 661 | ")\n"))))))) | ||
| 662 | 657 | ||
| 663 | (defun calc-assign (arg) | 658 | (defun calc-assign (arg) |
| 664 | (interactive "P") | 659 | (interactive "P") |
diff --git a/lisp/calc/calc-stuff.el b/lisp/calc/calc-stuff.el index 58b81faee50..8df2ed905aa 100644 --- a/lisp/calc/calc-stuff.el +++ b/lisp/calc/calc-stuff.el | |||
| @@ -182,7 +182,7 @@ With a prefix, push that prefix as a number onto the stack." | |||
| 182 | math-eval-rules-cache-tag t | 182 | math-eval-rules-cache-tag t |
| 183 | math-format-date-cache nil | 183 | math-format-date-cache nil |
| 184 | math-holidays-cache-tag t) | 184 | math-holidays-cache-tag t) |
| 185 | (mapc (function (lambda (x) (set x -100))) math-cache-list) | 185 | (mapc (lambda (x) (set x -100)) math-cache-list) |
| 186 | (unless inhibit-msg | 186 | (unless inhibit-msg |
| 187 | (message "All internal calculator caches have been reset")))) | 187 | (message "All internal calculator caches have been reset")))) |
| 188 | 188 | ||
| @@ -258,14 +258,14 @@ With a prefix, push that prefix as a number onto the stack." | |||
| 258 | (t (list 'calcFunc-clean a))))) | 258 | (t (list 'calcFunc-clean a))))) |
| 259 | 259 | ||
| 260 | (defun calcFunc-pclean (a &optional prec) | 260 | (defun calcFunc-pclean (a &optional prec) |
| 261 | (math-map-over-constants (function (lambda (x) (calcFunc-clean x prec))) | 261 | (math-map-over-constants (lambda (x) (calcFunc-clean x prec)) |
| 262 | a)) | 262 | a)) |
| 263 | 263 | ||
| 264 | (defun calcFunc-pfloat (a) | 264 | (defun calcFunc-pfloat (a) |
| 265 | (math-map-over-constants 'math-float a)) | 265 | (math-map-over-constants 'math-float a)) |
| 266 | 266 | ||
| 267 | (defun calcFunc-pfrac (a &optional tol) | 267 | (defun calcFunc-pfrac (a &optional tol) |
| 268 | (math-map-over-constants (function (lambda (x) (calcFunc-frac x tol))) | 268 | (math-map-over-constants (lambda (x) (calcFunc-frac x tol)) |
| 269 | a)) | 269 | a)) |
| 270 | 270 | ||
| 271 | ;; The variable math-moc-func is local to math-map-over-constants, | 271 | ;; The variable math-moc-func is local to math-map-over-constants, |
diff --git a/lisp/calc/calc-units.el b/lisp/calc/calc-units.el index 709c09ea099..742b2bb8728 100644 --- a/lisp/calc/calc-units.el +++ b/lisp/calc/calc-units.el | |||
| @@ -860,23 +860,22 @@ If COMP or STD is non-nil, put that in the units table instead." | |||
| 860 | tab) | 860 | tab) |
| 861 | (message "Building units table...") | 861 | (message "Building units table...") |
| 862 | (setq math-units-table-buffer-valid nil) | 862 | (setq math-units-table-buffer-valid nil) |
| 863 | (setq tab (mapcar (function | 863 | (setq tab (mapcar (lambda (x) |
| 864 | (lambda (x) | 864 | (list (car x) |
| 865 | (list (car x) | 865 | (and (nth 1 x) |
| 866 | (and (nth 1 x) | 866 | (if (stringp (nth 1 x)) |
| 867 | (if (stringp (nth 1 x)) | 867 | (let ((exp (math-read-plain-expr |
| 868 | (let ((exp (math-read-plain-expr | 868 | (nth 1 x)))) |
| 869 | (nth 1 x)))) | 869 | (if (eq (car-safe exp) 'error) |
| 870 | (if (eq (car-safe exp) 'error) | 870 | (error "Format error in definition of %s in units table: %s" |
| 871 | (error "Format error in definition of %s in units table: %s" | 871 | (car x) (nth 2 exp)) |
| 872 | (car x) (nth 2 exp)) | 872 | exp)) |
| 873 | exp)) | 873 | (nth 1 x))) |
| 874 | (nth 1 x))) | 874 | (nth 2 x) |
| 875 | (nth 2 x) | 875 | (nth 3 x) |
| 876 | (nth 3 x) | 876 | (and (not (nth 1 x)) |
| 877 | (and (not (nth 1 x)) | 877 | (list (cons (car x) 1))) |
| 878 | (list (cons (car x) 1))) | 878 | (nth 4 x))) |
| 879 | (nth 4 x)))) | ||
| 880 | combined-units)) | 879 | combined-units)) |
| 881 | (let ((math-units-table tab)) | 880 | (let ((math-units-table tab)) |
| 882 | (mapc #'math-find-base-units tab)) | 881 | (mapc #'math-find-base-units tab)) |
| @@ -1100,10 +1099,9 @@ If COMP or STD is non-nil, put that in the units table instead." | |||
| 1100 | (setq math-decompose-units-cache | 1099 | (setq math-decompose-units-cache |
| 1101 | (cons entry | 1100 | (cons entry |
| 1102 | (sort ulist | 1101 | (sort ulist |
| 1103 | (function | 1102 | (lambda (x y) |
| 1104 | (lambda (x y) | 1103 | (not (Math-lessp (nth 1 x) |
| 1105 | (not (Math-lessp (nth 1 x) | 1104 | (nth 1 y))))))))) |
| 1106 | (nth 1 y)))))))))) | ||
| 1107 | (cdr math-decompose-units-cache)))) | 1105 | (cdr math-decompose-units-cache)))) |
| 1108 | 1106 | ||
| 1109 | (defun math-decompose-unit-part (unit) | 1107 | (defun math-decompose-unit-part (unit) |
diff --git a/lisp/calc/calc-vec.el b/lisp/calc/calc-vec.el index 875414595cf..036f08e276d 100644 --- a/lisp/calc/calc-vec.el +++ b/lisp/calc/calc-vec.el | |||
| @@ -744,7 +744,7 @@ | |||
| 744 | ;;; Get the Nth row of a matrix. | 744 | ;;; Get the Nth row of a matrix. |
| 745 | (defun calcFunc-mrow (mat n) ; [Public] | 745 | (defun calcFunc-mrow (mat n) ; [Public] |
| 746 | (if (Math-vectorp n) | 746 | (if (Math-vectorp n) |
| 747 | (math-map-vec (function (lambda (x) (calcFunc-mrow mat x))) n) | 747 | (math-map-vec (lambda (x) (calcFunc-mrow mat x)) n) |
| 748 | (if (and (eq (car-safe n) 'intv) (math-constp n)) | 748 | (if (and (eq (car-safe n) 'intv) (math-constp n)) |
| 749 | (calcFunc-subvec mat | 749 | (calcFunc-subvec mat |
| 750 | (math-add (nth 2 n) (if (memq (nth 1 n) '(2 3)) 0 1)) | 750 | (math-add (nth 2 n) (if (memq (nth 1 n) '(2 3)) 0 1)) |
| @@ -768,15 +768,15 @@ | |||
| 768 | 768 | ||
| 769 | ;;; Get the Nth column of a matrix. | 769 | ;;; Get the Nth column of a matrix. |
| 770 | (defun math-mat-col (mat n) | 770 | (defun math-mat-col (mat n) |
| 771 | (cons 'vec (mapcar (function (lambda (x) (elt x n))) (cdr mat)))) | 771 | (cons 'vec (mapcar (lambda (x) (elt x n)) (cdr mat)))) |
| 772 | 772 | ||
| 773 | (defun calcFunc-mcol (mat n) ; [Public] | 773 | (defun calcFunc-mcol (mat n) ; [Public] |
| 774 | (if (Math-vectorp n) | 774 | (if (Math-vectorp n) |
| 775 | (calcFunc-trn | 775 | (calcFunc-trn |
| 776 | (math-map-vec (function (lambda (x) (calcFunc-mcol mat x))) n)) | 776 | (math-map-vec (lambda (x) (calcFunc-mcol mat x)) n)) |
| 777 | (if (and (eq (car-safe n) 'intv) (math-constp n)) | 777 | (if (and (eq (car-safe n) 'intv) (math-constp n)) |
| 778 | (if (math-matrixp mat) | 778 | (if (math-matrixp mat) |
| 779 | (math-map-vec (function (lambda (x) (calcFunc-mrow x n))) mat) | 779 | (math-map-vec (lambda (x) (calcFunc-mrow x n)) mat) |
| 780 | (calcFunc-mrow mat n)) | 780 | (calcFunc-mrow mat n)) |
| 781 | (or (and (integerp (setq n (math-check-integer n))) | 781 | (or (and (integerp (setq n (math-check-integer n))) |
| 782 | (> n 0)) | 782 | (> n 0)) |
| @@ -804,7 +804,7 @@ | |||
| 804 | 804 | ||
| 805 | ;;; Remove the Nth column from a matrix. | 805 | ;;; Remove the Nth column from a matrix. |
| 806 | (defun math-mat-less-col (mat n) | 806 | (defun math-mat-less-col (mat n) |
| 807 | (cons 'vec (mapcar (function (lambda (x) (math-mat-less-row x n))) | 807 | (cons 'vec (mapcar (lambda (x) (math-mat-less-row x n)) |
| 808 | (cdr mat)))) | 808 | (cdr mat)))) |
| 809 | 809 | ||
| 810 | (defun calcFunc-mrcol (mat n) ; [Public] | 810 | (defun calcFunc-mrcol (mat n) ; [Public] |
| @@ -939,10 +939,10 @@ | |||
| 939 | (calcFunc-idn a (1- (length m))) | 939 | (calcFunc-idn a (1- (length m))) |
| 940 | (if (math-vectorp m) | 940 | (if (math-vectorp m) |
| 941 | (if (math-zerop a) | 941 | (if (math-zerop a) |
| 942 | (cons 'vec (mapcar (function (lambda (x) | 942 | (cons 'vec (mapcar (lambda (x) |
| 943 | (if (math-vectorp x) | 943 | (if (math-vectorp x) |
| 944 | (math-mimic-ident a x) | 944 | (math-mimic-ident a x) |
| 945 | a))) | 945 | a)) |
| 946 | (cdr m))) | 946 | (cdr m))) |
| 947 | (math-dimension-error)) | 947 | (math-dimension-error)) |
| 948 | (calcFunc-idn a)))) | 948 | (calcFunc-idn a)))) |
diff --git a/lisp/calc/calc-yank.el b/lisp/calc/calc-yank.el index e03c00243c4..6186df718db 100644 --- a/lisp/calc/calc-yank.el +++ b/lisp/calc/calc-yank.el | |||
| @@ -643,12 +643,11 @@ Interactively, reads the register using `register-read-with-preview'." | |||
| 643 | (allow-ret (> n 1)) | 643 | (allow-ret (> n 1)) |
| 644 | (list (math-showing-full-precision | 644 | (list (math-showing-full-precision |
| 645 | (mapcar (if (> n 1) | 645 | (mapcar (if (> n 1) |
| 646 | (function (lambda (x) | 646 | (lambda (x) |
| 647 | (math-format-flat-expr x 0))) | 647 | (math-format-flat-expr x 0)) |
| 648 | (function | 648 | (lambda (x) |
| 649 | (lambda (x) | 649 | (if (math-vectorp x) (setq allow-ret t)) |
| 650 | (if (math-vectorp x) (setq allow-ret t)) | 650 | (math-format-nice-expr x (frame-width)))) |
| 651 | (math-format-nice-expr x (frame-width))))) | ||
| 652 | (if (> n 0) | 651 | (if (> n 0) |
| 653 | (calc-top-list n) | 652 | (calc-top-list n) |
| 654 | (calc-top-list 1 (- n))))))) | 653 | (calc-top-list 1 (- n))))))) |
diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index 5716189b342..9d869f359bc 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el | |||
| @@ -506,7 +506,7 @@ The variable VAR will be added to `calc-mode-var-list'." | |||
| 506 | 506 | ||
| 507 | (defun calc-mode-var-list-restore-default-values () | 507 | (defun calc-mode-var-list-restore-default-values () |
| 508 | "Restore the default values of the variables in `calc-mode-var-list'." | 508 | "Restore the default values of the variables in `calc-mode-var-list'." |
| 509 | (mapcar (function (lambda (v) (set (car v) (nth 1 v)))) | 509 | (mapcar (lambda (v) (set (car v) (nth 1 v))) |
| 510 | calc-mode-var-list)) | 510 | calc-mode-var-list)) |
| 511 | 511 | ||
| 512 | (defun calc-mode-var-list-restore-saved-values () | 512 | (defun calc-mode-var-list-restore-saved-values () |
| @@ -535,7 +535,7 @@ The variable VAR will be added to `calc-mode-var-list'." | |||
| 535 | newvarlist))) | 535 | newvarlist))) |
| 536 | (setq varlist (cdr varlist))))))) | 536 | (setq varlist (cdr varlist))))))) |
| 537 | (if newvarlist | 537 | (if newvarlist |
| 538 | (mapcar (function (lambda (v) (set (car v) (nth 1 v)))) | 538 | (mapcar (lambda (v) (set (car v) (nth 1 v))) |
| 539 | newvarlist) | 539 | newvarlist) |
| 540 | (calc-mode-var-list-restore-default-values)))) | 540 | (calc-mode-var-list-restore-default-values)))) |
| 541 | 541 | ||
| @@ -1315,8 +1315,9 @@ Notations: 3.14e6 3.14 * 10^6 | |||
| 1315 | \\{calc-mode-map} | 1315 | \\{calc-mode-map} |
| 1316 | " | 1316 | " |
| 1317 | (interactive) | 1317 | (interactive) |
| 1318 | (mapc (function ;FIXME: Why (set-default v (symbol-value v)) ?!?!? | 1318 | (mapc (lambda (v) |
| 1319 | (lambda (v) (set-default v (symbol-value v)))) | 1319 | ;; FIXME: Why (set-default v (symbol-value v)) ?!?!? |
| 1320 | (set-default v (symbol-value v))) | ||
| 1320 | calc-local-var-list) | 1321 | calc-local-var-list) |
| 1321 | (kill-all-local-variables) | 1322 | (kill-all-local-variables) |
| 1322 | (use-local-map (if (eq calc-algebraic-mode 'total) | 1323 | (use-local-map (if (eq calc-algebraic-mode 'total) |
| @@ -1537,7 +1538,7 @@ See `window-dedicated-p' for what that means." | |||
| 1537 | (let ((tail (nthcdr (1- calc-undo-length) calc-undo-list))) | 1538 | (let ((tail (nthcdr (1- calc-undo-length) calc-undo-list))) |
| 1538 | (if tail (setcdr tail nil))) | 1539 | (if tail (setcdr tail nil))) |
| 1539 | (setq calc-redo-list nil)))) | 1540 | (setq calc-redo-list nil)))) |
| 1540 | (mapc (function (lambda (v) (set-default v (symbol-value v)))) | 1541 | (mapc (lambda (v) (set-default v (symbol-value v))) |
| 1541 | calc-local-var-list) | 1542 | calc-local-var-list) |
| 1542 | (let ((buf (current-buffer)) | 1543 | (let ((buf (current-buffer)) |
| 1543 | (win (get-buffer-window (current-buffer))) | 1544 | (win (get-buffer-window (current-buffer))) |
diff --git a/lisp/calc/calcalg2.el b/lisp/calc/calcalg2.el index 7894bd93015..bf4d6261910 100644 --- a/lisp/calc/calcalg2.el +++ b/lisp/calc/calcalg2.el | |||
| @@ -361,175 +361,175 @@ | |||
| 361 | res)))) | 361 | res)))) |
| 362 | 362 | ||
| 363 | (put 'calcFunc-inv\' 'math-derivative-1 | 363 | (put 'calcFunc-inv\' 'math-derivative-1 |
| 364 | (function (lambda (u) (math-neg (math-div 1 (math-sqr u)))))) | 364 | (lambda (u) (math-neg (math-div 1 (math-sqr u))))) |
| 365 | 365 | ||
| 366 | (put 'calcFunc-sqrt\' 'math-derivative-1 | 366 | (put 'calcFunc-sqrt\' 'math-derivative-1 |
| 367 | (function (lambda (u) (math-div 1 (math-mul 2 (list 'calcFunc-sqrt u)))))) | 367 | (lambda (u) (math-div 1 (math-mul 2 (list 'calcFunc-sqrt u))))) |
| 368 | 368 | ||
| 369 | (put 'calcFunc-deg\' 'math-derivative-1 | 369 | (put 'calcFunc-deg\' 'math-derivative-1 |
| 370 | (function (lambda (_) (math-div-float '(float 18 1) (math-pi))))) | 370 | (lambda (_) (math-div-float '(float 18 1) (math-pi)))) |
| 371 | 371 | ||
| 372 | (put 'calcFunc-rad\' 'math-derivative-1 | 372 | (put 'calcFunc-rad\' 'math-derivative-1 |
| 373 | (function (lambda (_) (math-pi-over-180)))) | 373 | (lambda (_) (math-pi-over-180))) |
| 374 | 374 | ||
| 375 | (put 'calcFunc-ln\' 'math-derivative-1 | 375 | (put 'calcFunc-ln\' 'math-derivative-1 |
| 376 | (function (lambda (u) (math-div 1 u)))) | 376 | (lambda (u) (math-div 1 u))) |
| 377 | 377 | ||
| 378 | (put 'calcFunc-log10\' 'math-derivative-1 | 378 | (put 'calcFunc-log10\' 'math-derivative-1 |
| 379 | (function (lambda (u) | 379 | (lambda (u) |
| 380 | (math-div (math-div 1 (math-normalize '(calcFunc-ln 10))) | 380 | (math-div (math-div 1 (math-normalize '(calcFunc-ln 10))) |
| 381 | u)))) | 381 | u))) |
| 382 | 382 | ||
| 383 | (put 'calcFunc-lnp1\' 'math-derivative-1 | 383 | (put 'calcFunc-lnp1\' 'math-derivative-1 |
| 384 | (function (lambda (u) (math-div 1 (math-add u 1))))) | 384 | (lambda (u) (math-div 1 (math-add u 1)))) |
| 385 | 385 | ||
| 386 | (put 'calcFunc-log\' 'math-derivative-2 | 386 | (put 'calcFunc-log\' 'math-derivative-2 |
| 387 | (function (lambda (x b) | 387 | (lambda (x b) |
| 388 | (and (not (Math-zerop b)) | 388 | (and (not (Math-zerop b)) |
| 389 | (let ((lnv (math-normalize | 389 | (let ((lnv (math-normalize |
| 390 | (list 'calcFunc-ln b)))) | 390 | (list 'calcFunc-ln b)))) |
| 391 | (math-div 1 (math-mul lnv x))))))) | 391 | (math-div 1 (math-mul lnv x)))))) |
| 392 | 392 | ||
| 393 | (put 'calcFunc-log\'2 'math-derivative-2 | 393 | (put 'calcFunc-log\'2 'math-derivative-2 |
| 394 | (function (lambda (x b) | 394 | (lambda (x b) |
| 395 | (let ((lnv (list 'calcFunc-ln b))) | 395 | (let ((lnv (list 'calcFunc-ln b))) |
| 396 | (math-neg (math-div (list 'calcFunc-log x b) | 396 | (math-neg (math-div (list 'calcFunc-log x b) |
| 397 | (math-mul lnv b))))))) | 397 | (math-mul lnv b)))))) |
| 398 | 398 | ||
| 399 | (put 'calcFunc-exp\' 'math-derivative-1 | 399 | (put 'calcFunc-exp\' 'math-derivative-1 |
| 400 | (function (lambda (u) (math-normalize (list 'calcFunc-exp u))))) | 400 | (lambda (u) (math-normalize (list 'calcFunc-exp u)))) |
| 401 | 401 | ||
| 402 | (put 'calcFunc-expm1\' 'math-derivative-1 | 402 | (put 'calcFunc-expm1\' 'math-derivative-1 |
| 403 | (function (lambda (u) (math-normalize (list 'calcFunc-expm1 u))))) | 403 | (lambda (u) (math-normalize (list 'calcFunc-expm1 u)))) |
| 404 | 404 | ||
| 405 | (put 'calcFunc-sin\' 'math-derivative-1 | 405 | (put 'calcFunc-sin\' 'math-derivative-1 |
| 406 | (function (lambda (u) (math-to-radians-2 (math-normalize | 406 | (lambda (u) (math-to-radians-2 (math-normalize |
| 407 | (list 'calcFunc-cos u)) t)))) | 407 | (list 'calcFunc-cos u)) t))) |
| 408 | 408 | ||
| 409 | (put 'calcFunc-cos\' 'math-derivative-1 | 409 | (put 'calcFunc-cos\' 'math-derivative-1 |
| 410 | (function (lambda (u) (math-neg (math-to-radians-2 | 410 | (lambda (u) (math-neg (math-to-radians-2 |
| 411 | (math-normalize | 411 | (math-normalize |
| 412 | (list 'calcFunc-sin u)) t))))) | 412 | (list 'calcFunc-sin u)) t)))) |
| 413 | 413 | ||
| 414 | (put 'calcFunc-tan\' 'math-derivative-1 | 414 | (put 'calcFunc-tan\' 'math-derivative-1 |
| 415 | (function (lambda (u) (math-to-radians-2 | 415 | (lambda (u) (math-to-radians-2 |
| 416 | (math-sqr | 416 | (math-sqr |
| 417 | (math-normalize | 417 | (math-normalize |
| 418 | (list 'calcFunc-sec u))) t)))) | 418 | (list 'calcFunc-sec u))) t))) |
| 419 | 419 | ||
| 420 | (put 'calcFunc-sec\' 'math-derivative-1 | 420 | (put 'calcFunc-sec\' 'math-derivative-1 |
| 421 | (function (lambda (u) (math-to-radians-2 | 421 | (lambda (u) (math-to-radians-2 |
| 422 | (math-mul | 422 | (math-mul |
| 423 | (math-normalize | 423 | (math-normalize |
| 424 | (list 'calcFunc-sec u)) | 424 | (list 'calcFunc-sec u)) |
| 425 | (math-normalize | 425 | (math-normalize |
| 426 | (list 'calcFunc-tan u))) t)))) | 426 | (list 'calcFunc-tan u))) t))) |
| 427 | 427 | ||
| 428 | (put 'calcFunc-csc\' 'math-derivative-1 | 428 | (put 'calcFunc-csc\' 'math-derivative-1 |
| 429 | (function (lambda (u) (math-neg | 429 | (lambda (u) (math-neg |
| 430 | (math-to-radians-2 | 430 | (math-to-radians-2 |
| 431 | (math-mul | 431 | (math-mul |
| 432 | (math-normalize | 432 | (math-normalize |
| 433 | (list 'calcFunc-csc u)) | 433 | (list 'calcFunc-csc u)) |
| 434 | (math-normalize | 434 | (math-normalize |
| 435 | (list 'calcFunc-cot u))) t))))) | 435 | (list 'calcFunc-cot u))) t)))) |
| 436 | 436 | ||
| 437 | (put 'calcFunc-cot\' 'math-derivative-1 | 437 | (put 'calcFunc-cot\' 'math-derivative-1 |
| 438 | (function (lambda (u) (math-neg | 438 | (lambda (u) (math-neg |
| 439 | (math-to-radians-2 | 439 | (math-to-radians-2 |
| 440 | (math-sqr | 440 | (math-sqr |
| 441 | (math-normalize | 441 | (math-normalize |
| 442 | (list 'calcFunc-csc u))) t))))) | 442 | (list 'calcFunc-csc u))) t)))) |
| 443 | 443 | ||
| 444 | (put 'calcFunc-arcsin\' 'math-derivative-1 | 444 | (put 'calcFunc-arcsin\' 'math-derivative-1 |
| 445 | (function (lambda (u) | 445 | (lambda (u) |
| 446 | (math-from-radians-2 | 446 | (math-from-radians-2 |
| 447 | (math-div 1 (math-normalize | 447 | (math-div 1 (math-normalize |
| 448 | (list 'calcFunc-sqrt | 448 | (list 'calcFunc-sqrt |
| 449 | (math-sub 1 (math-sqr u))))) t)))) | 449 | (math-sub 1 (math-sqr u))))) t))) |
| 450 | 450 | ||
| 451 | (put 'calcFunc-arccos\' 'math-derivative-1 | 451 | (put 'calcFunc-arccos\' 'math-derivative-1 |
| 452 | (function (lambda (u) | 452 | (lambda (u) |
| 453 | (math-from-radians-2 | 453 | (math-from-radians-2 |
| 454 | (math-div -1 (math-normalize | 454 | (math-div -1 (math-normalize |
| 455 | (list 'calcFunc-sqrt | 455 | (list 'calcFunc-sqrt |
| 456 | (math-sub 1 (math-sqr u))))) t)))) | 456 | (math-sub 1 (math-sqr u))))) t))) |
| 457 | 457 | ||
| 458 | (put 'calcFunc-arctan\' 'math-derivative-1 | 458 | (put 'calcFunc-arctan\' 'math-derivative-1 |
| 459 | (function (lambda (u) (math-from-radians-2 | 459 | (lambda (u) (math-from-radians-2 |
| 460 | (math-div 1 (math-add 1 (math-sqr u))) t)))) | 460 | (math-div 1 (math-add 1 (math-sqr u))) t))) |
| 461 | 461 | ||
| 462 | (put 'calcFunc-sinh\' 'math-derivative-1 | 462 | (put 'calcFunc-sinh\' 'math-derivative-1 |
| 463 | (function (lambda (u) (math-normalize (list 'calcFunc-cosh u))))) | 463 | (lambda (u) (math-normalize (list 'calcFunc-cosh u)))) |
| 464 | 464 | ||
| 465 | (put 'calcFunc-cosh\' 'math-derivative-1 | 465 | (put 'calcFunc-cosh\' 'math-derivative-1 |
| 466 | (function (lambda (u) (math-normalize (list 'calcFunc-sinh u))))) | 466 | (lambda (u) (math-normalize (list 'calcFunc-sinh u)))) |
| 467 | 467 | ||
| 468 | (put 'calcFunc-tanh\' 'math-derivative-1 | 468 | (put 'calcFunc-tanh\' 'math-derivative-1 |
| 469 | (function (lambda (u) (math-sqr | 469 | (lambda (u) (math-sqr |
| 470 | (math-normalize | 470 | (math-normalize |
| 471 | (list 'calcFunc-sech u)))))) | 471 | (list 'calcFunc-sech u))))) |
| 472 | 472 | ||
| 473 | (put 'calcFunc-sech\' 'math-derivative-1 | 473 | (put 'calcFunc-sech\' 'math-derivative-1 |
| 474 | (function (lambda (u) (math-neg | 474 | (lambda (u) (math-neg |
| 475 | (math-mul | 475 | (math-mul |
| 476 | (math-normalize (list 'calcFunc-sech u)) | 476 | (math-normalize (list 'calcFunc-sech u)) |
| 477 | (math-normalize (list 'calcFunc-tanh u))))))) | 477 | (math-normalize (list 'calcFunc-tanh u)))))) |
| 478 | 478 | ||
| 479 | (put 'calcFunc-csch\' 'math-derivative-1 | 479 | (put 'calcFunc-csch\' 'math-derivative-1 |
| 480 | (function (lambda (u) (math-neg | 480 | (lambda (u) (math-neg |
| 481 | (math-mul | 481 | (math-mul |
| 482 | (math-normalize (list 'calcFunc-csch u)) | 482 | (math-normalize (list 'calcFunc-csch u)) |
| 483 | (math-normalize (list 'calcFunc-coth u))))))) | 483 | (math-normalize (list 'calcFunc-coth u)))))) |
| 484 | 484 | ||
| 485 | (put 'calcFunc-coth\' 'math-derivative-1 | 485 | (put 'calcFunc-coth\' 'math-derivative-1 |
| 486 | (function (lambda (u) (math-neg | 486 | (lambda (u) (math-neg |
| 487 | (math-sqr | 487 | (math-sqr |
| 488 | (math-normalize | 488 | (math-normalize |
| 489 | (list 'calcFunc-csch u))))))) | 489 | (list 'calcFunc-csch u)))))) |
| 490 | 490 | ||
| 491 | (put 'calcFunc-arcsinh\' 'math-derivative-1 | 491 | (put 'calcFunc-arcsinh\' 'math-derivative-1 |
| 492 | (function (lambda (u) | 492 | (lambda (u) |
| 493 | (math-div 1 (math-normalize | 493 | (math-div 1 (math-normalize |
| 494 | (list 'calcFunc-sqrt | 494 | (list 'calcFunc-sqrt |
| 495 | (math-add (math-sqr u) 1))))))) | 495 | (math-add (math-sqr u) 1)))))) |
| 496 | 496 | ||
| 497 | (put 'calcFunc-arccosh\' 'math-derivative-1 | 497 | (put 'calcFunc-arccosh\' 'math-derivative-1 |
| 498 | (function (lambda (u) | 498 | (lambda (u) |
| 499 | (math-div 1 (math-normalize | 499 | (math-div 1 (math-normalize |
| 500 | (list 'calcFunc-sqrt | 500 | (list 'calcFunc-sqrt |
| 501 | (math-add (math-sqr u) -1))))))) | 501 | (math-add (math-sqr u) -1)))))) |
| 502 | 502 | ||
| 503 | (put 'calcFunc-arctanh\' 'math-derivative-1 | 503 | (put 'calcFunc-arctanh\' 'math-derivative-1 |
| 504 | (function (lambda (u) (math-div 1 (math-sub 1 (math-sqr u)))))) | 504 | (lambda (u) (math-div 1 (math-sub 1 (math-sqr u))))) |
| 505 | 505 | ||
| 506 | (put 'calcFunc-bern\'2 'math-derivative-2 | 506 | (put 'calcFunc-bern\'2 'math-derivative-2 |
| 507 | (function (lambda (n x) | 507 | (lambda (n x) |
| 508 | (math-mul n (list 'calcFunc-bern (math-add n -1) x))))) | 508 | (math-mul n (list 'calcFunc-bern (math-add n -1) x)))) |
| 509 | 509 | ||
| 510 | (put 'calcFunc-euler\'2 'math-derivative-2 | 510 | (put 'calcFunc-euler\'2 'math-derivative-2 |
| 511 | (function (lambda (n x) | 511 | (lambda (n x) |
| 512 | (math-mul n (list 'calcFunc-euler (math-add n -1) x))))) | 512 | (math-mul n (list 'calcFunc-euler (math-add n -1) x)))) |
| 513 | 513 | ||
| 514 | (put 'calcFunc-gammag\'2 'math-derivative-2 | 514 | (put 'calcFunc-gammag\'2 'math-derivative-2 |
| 515 | (function (lambda (a x) (math-deriv-gamma a x 1)))) | 515 | (lambda (a x) (math-deriv-gamma a x 1))) |
| 516 | 516 | ||
| 517 | (put 'calcFunc-gammaG\'2 'math-derivative-2 | 517 | (put 'calcFunc-gammaG\'2 'math-derivative-2 |
| 518 | (function (lambda (a x) (math-deriv-gamma a x -1)))) | 518 | (lambda (a x) (math-deriv-gamma a x -1))) |
| 519 | 519 | ||
| 520 | (put 'calcFunc-gammaP\'2 'math-derivative-2 | 520 | (put 'calcFunc-gammaP\'2 'math-derivative-2 |
| 521 | (function (lambda (a x) (math-deriv-gamma a x | 521 | (lambda (a x) (math-deriv-gamma a x |
| 522 | (math-div | 522 | (math-div |
| 523 | 1 (math-normalize | 523 | 1 (math-normalize |
| 524 | (list 'calcFunc-gamma | 524 | (list 'calcFunc-gamma |
| 525 | a))))))) | 525 | a)))))) |
| 526 | 526 | ||
| 527 | (put 'calcFunc-gammaQ\'2 'math-derivative-2 | 527 | (put 'calcFunc-gammaQ\'2 'math-derivative-2 |
| 528 | (function (lambda (a x) (math-deriv-gamma a x | 528 | (lambda (a x) (math-deriv-gamma a x |
| 529 | (math-div | 529 | (math-div |
| 530 | -1 (math-normalize | 530 | -1 (math-normalize |
| 531 | (list 'calcFunc-gamma | 531 | (list 'calcFunc-gamma |
| 532 | a))))))) | 532 | a)))))) |
| 533 | 533 | ||
| 534 | (defun math-deriv-gamma (a x scale) | 534 | (defun math-deriv-gamma (a x scale) |
| 535 | (math-mul scale | 535 | (math-mul scale |
| @@ -537,13 +537,13 @@ | |||
| 537 | (list 'calcFunc-exp (math-neg x))))) | 537 | (list 'calcFunc-exp (math-neg x))))) |
| 538 | 538 | ||
| 539 | (put 'calcFunc-betaB\' 'math-derivative-3 | 539 | (put 'calcFunc-betaB\' 'math-derivative-3 |
| 540 | (function (lambda (x a b) (math-deriv-beta x a b 1)))) | 540 | (lambda (x a b) (math-deriv-beta x a b 1))) |
| 541 | 541 | ||
| 542 | (put 'calcFunc-betaI\' 'math-derivative-3 | 542 | (put 'calcFunc-betaI\' 'math-derivative-3 |
| 543 | (function (lambda (x a b) (math-deriv-beta x a b | 543 | (lambda (x a b) (math-deriv-beta x a b |
| 544 | (math-div | 544 | (math-div |
| 545 | 1 (list 'calcFunc-beta | 545 | 1 (list 'calcFunc-beta |
| 546 | a b)))))) | 546 | a b))))) |
| 547 | 547 | ||
| 548 | (defun math-deriv-beta (x a b scale) | 548 | (defun math-deriv-beta (x a b scale) |
| 549 | (math-mul (math-mul (math-pow x (math-add a -1)) | 549 | (math-mul (math-mul (math-pow x (math-add a -1)) |
| @@ -551,101 +551,96 @@ | |||
| 551 | scale)) | 551 | scale)) |
| 552 | 552 | ||
| 553 | (put 'calcFunc-erf\' 'math-derivative-1 | 553 | (put 'calcFunc-erf\' 'math-derivative-1 |
| 554 | (function (lambda (x) (math-div 2 | 554 | (lambda (x) (math-div 2 |
| 555 | (math-mul (list 'calcFunc-exp | 555 | (math-mul (list 'calcFunc-exp |
| 556 | (math-sqr x)) | 556 | (math-sqr x)) |
| 557 | (if calc-symbolic-mode | 557 | (if calc-symbolic-mode |
| 558 | '(calcFunc-sqrt | 558 | '(calcFunc-sqrt |
| 559 | (var pi var-pi)) | 559 | (var pi var-pi)) |
| 560 | (math-sqrt-pi))))))) | 560 | (math-sqrt-pi)))))) |
| 561 | 561 | ||
| 562 | (put 'calcFunc-erfc\' 'math-derivative-1 | 562 | (put 'calcFunc-erfc\' 'math-derivative-1 |
| 563 | (function (lambda (x) (math-div -2 | 563 | (lambda (x) (math-div -2 |
| 564 | (math-mul (list 'calcFunc-exp | 564 | (math-mul (list 'calcFunc-exp |
| 565 | (math-sqr x)) | 565 | (math-sqr x)) |
| 566 | (if calc-symbolic-mode | 566 | (if calc-symbolic-mode |
| 567 | '(calcFunc-sqrt | 567 | '(calcFunc-sqrt |
| 568 | (var pi var-pi)) | 568 | (var pi var-pi)) |
| 569 | (math-sqrt-pi))))))) | 569 | (math-sqrt-pi)))))) |
| 570 | 570 | ||
| 571 | (put 'calcFunc-besJ\'2 'math-derivative-2 | 571 | (put 'calcFunc-besJ\'2 'math-derivative-2 |
| 572 | (function (lambda (v z) (math-div (math-sub (list 'calcFunc-besJ | 572 | (lambda (v z) (math-div (math-sub (list 'calcFunc-besJ |
| 573 | (math-add v -1) | 573 | (math-add v -1) |
| 574 | z) | 574 | z) |
| 575 | (list 'calcFunc-besJ | 575 | (list 'calcFunc-besJ |
| 576 | (math-add v 1) | 576 | (math-add v 1) |
| 577 | z)) | 577 | z)) |
| 578 | 2)))) | 578 | 2))) |
| 579 | 579 | ||
| 580 | (put 'calcFunc-besY\'2 'math-derivative-2 | 580 | (put 'calcFunc-besY\'2 'math-derivative-2 |
| 581 | (function (lambda (v z) (math-div (math-sub (list 'calcFunc-besY | 581 | (lambda (v z) (math-div (math-sub (list 'calcFunc-besY |
| 582 | (math-add v -1) | 582 | (math-add v -1) |
| 583 | z) | 583 | z) |
| 584 | (list 'calcFunc-besY | 584 | (list 'calcFunc-besY |
| 585 | (math-add v 1) | 585 | (math-add v 1) |
| 586 | z)) | 586 | z)) |
| 587 | 2)))) | 587 | 2))) |
| 588 | 588 | ||
| 589 | (put 'calcFunc-sum 'math-derivative-n | 589 | (put 'calcFunc-sum 'math-derivative-n |
| 590 | (function | 590 | (lambda (expr) |
| 591 | (lambda (expr) | 591 | (if (math-expr-contains (cons 'vec (cdr (cdr expr))) math-deriv-var) |
| 592 | (if (math-expr-contains (cons 'vec (cdr (cdr expr))) math-deriv-var) | 592 | (throw 'math-deriv nil) |
| 593 | (throw 'math-deriv nil) | 593 | (cons 'calcFunc-sum |
| 594 | (cons 'calcFunc-sum | 594 | (cons (math-derivative (nth 1 expr)) |
| 595 | (cons (math-derivative (nth 1 expr)) | 595 | (cdr (cdr expr))))))) |
| 596 | (cdr (cdr expr)))))))) | ||
| 597 | 596 | ||
| 598 | (put 'calcFunc-prod 'math-derivative-n | 597 | (put 'calcFunc-prod 'math-derivative-n |
| 599 | (function | 598 | (lambda (expr) |
| 600 | (lambda (expr) | 599 | (if (math-expr-contains (cons 'vec (cdr (cdr expr))) math-deriv-var) |
| 601 | (if (math-expr-contains (cons 'vec (cdr (cdr expr))) math-deriv-var) | 600 | (throw 'math-deriv nil) |
| 602 | (throw 'math-deriv nil) | 601 | (math-mul expr |
| 603 | (math-mul expr | 602 | (cons 'calcFunc-sum |
| 604 | (cons 'calcFunc-sum | 603 | (cons (math-div (math-derivative (nth 1 expr)) |
| 605 | (cons (math-div (math-derivative (nth 1 expr)) | 604 | (nth 1 expr)) |
| 606 | (nth 1 expr)) | 605 | (cdr (cdr expr)))))))) |
| 607 | (cdr (cdr expr))))))))) | ||
| 608 | 606 | ||
| 609 | (put 'calcFunc-integ 'math-derivative-n | 607 | (put 'calcFunc-integ 'math-derivative-n |
| 610 | (function | 608 | (lambda (expr) |
| 611 | (lambda (expr) | 609 | (if (= (length expr) 3) |
| 612 | (if (= (length expr) 3) | 610 | (if (equal (nth 2 expr) math-deriv-var) |
| 613 | (if (equal (nth 2 expr) math-deriv-var) | 611 | (nth 1 expr) |
| 614 | (nth 1 expr) | 612 | (math-normalize |
| 615 | (math-normalize | 613 | (list 'calcFunc-integ |
| 616 | (list 'calcFunc-integ | 614 | (math-derivative (nth 1 expr)) |
| 617 | (math-derivative (nth 1 expr)) | 615 | (nth 2 expr)))) |
| 618 | (nth 2 expr)))) | 616 | (if (= (length expr) 5) |
| 619 | (if (= (length expr) 5) | 617 | (let ((lower (math-expr-subst (nth 1 expr) (nth 2 expr) |
| 620 | (let ((lower (math-expr-subst (nth 1 expr) (nth 2 expr) | 618 | (nth 3 expr))) |
| 621 | (nth 3 expr))) | 619 | (upper (math-expr-subst (nth 1 expr) (nth 2 expr) |
| 622 | (upper (math-expr-subst (nth 1 expr) (nth 2 expr) | 620 | (nth 4 expr)))) |
| 623 | (nth 4 expr)))) | 621 | (math-add (math-sub (math-mul upper |
| 624 | (math-add (math-sub (math-mul upper | 622 | (math-derivative (nth 4 expr))) |
| 625 | (math-derivative (nth 4 expr))) | 623 | (math-mul lower |
| 626 | (math-mul lower | 624 | (math-derivative (nth 3 expr)))) |
| 627 | (math-derivative (nth 3 expr)))) | 625 | (if (equal (nth 2 expr) math-deriv-var) |
| 628 | (if (equal (nth 2 expr) math-deriv-var) | 626 | 0 |
| 629 | 0 | 627 | (math-normalize |
| 630 | (math-normalize | 628 | (list 'calcFunc-integ |
| 631 | (list 'calcFunc-integ | 629 | (math-derivative (nth 1 expr)) (nth 2 expr) |
| 632 | (math-derivative (nth 1 expr)) (nth 2 expr) | 630 | (nth 3 expr) (nth 4 expr)))))))))) |
| 633 | (nth 3 expr) (nth 4 expr))))))))))) | ||
| 634 | 631 | ||
| 635 | (put 'calcFunc-if 'math-derivative-n | 632 | (put 'calcFunc-if 'math-derivative-n |
| 636 | (function | 633 | (lambda (expr) |
| 637 | (lambda (expr) | 634 | (and (= (length expr) 4) |
| 638 | (and (= (length expr) 4) | 635 | (list 'calcFunc-if (nth 1 expr) |
| 639 | (list 'calcFunc-if (nth 1 expr) | 636 | (math-derivative (nth 2 expr)) |
| 640 | (math-derivative (nth 2 expr)) | 637 | (math-derivative (nth 3 expr)))))) |
| 641 | (math-derivative (nth 3 expr))))))) | ||
| 642 | 638 | ||
| 643 | (put 'calcFunc-subscr 'math-derivative-n | 639 | (put 'calcFunc-subscr 'math-derivative-n |
| 644 | (function | 640 | (lambda (expr) |
| 645 | (lambda (expr) | 641 | (and (= (length expr) 3) |
| 646 | (and (= (length expr) 3) | 642 | (list 'calcFunc-subscr (nth 1 expr) |
| 647 | (list 'calcFunc-subscr (nth 1 expr) | 643 | (math-derivative (nth 2 expr)))))) |
| 648 | (math-derivative (nth 2 expr))))))) | ||
| 649 | 644 | ||
| 650 | 645 | ||
| 651 | (defvar math-integ-var '(var X ---)) | 646 | (defvar math-integ-var '(var X ---)) |
| @@ -1015,11 +1010,10 @@ | |||
| 1015 | res '(calcFunc-integsubst))) | 1010 | res '(calcFunc-integsubst))) |
| 1016 | (and (memq (length part) '(3 4 5)) | 1011 | (and (memq (length part) '(3 4 5)) |
| 1017 | (let ((parts (mapcar | 1012 | (let ((parts (mapcar |
| 1018 | (function | 1013 | (lambda (x) |
| 1019 | (lambda (x) | 1014 | (math-expr-subst |
| 1020 | (math-expr-subst | 1015 | x (nth 2 part) |
| 1021 | x (nth 2 part) | 1016 | math-integ-var)) |
| 1022 | math-integ-var))) | ||
| 1023 | (cdr part)))) | 1017 | (cdr part)))) |
| 1024 | (math-integrate-by-substitution | 1018 | (math-integrate-by-substitution |
| 1025 | expr (car parts) t | 1019 | expr (car parts) t |
| @@ -1516,7 +1510,7 @@ | |||
| 1516 | var low high) | 1510 | var low high) |
| 1517 | (nth 2 (nth 2 expr)))) | 1511 | (nth 2 (nth 2 expr)))) |
| 1518 | ((eq (car-safe expr) 'vec) | 1512 | ((eq (car-safe expr) 'vec) |
| 1519 | (cons 'vec (mapcar (function (lambda (x) (calcFunc-integ x var low high))) | 1513 | (cons 'vec (mapcar (lambda (x) (calcFunc-integ x var low high)) |
| 1520 | (cdr expr)))) | 1514 | (cdr expr)))) |
| 1521 | (t | 1515 | (t |
| 1522 | (let ((state (list calc-angle-mode | 1516 | (let ((state (list calc-angle-mode |
| @@ -2742,28 +2736,27 @@ | |||
| 2742 | math-t1 math-t2 math-t3) | 2736 | math-t1 math-t2 math-t3) |
| 2743 | (setq math-t2 (math-polynomial-base | 2737 | (setq math-t2 (math-polynomial-base |
| 2744 | math-solve-lhs | 2738 | math-solve-lhs |
| 2745 | (function | 2739 | (lambda (solve-b) |
| 2746 | (lambda (solve-b) | 2740 | (let ((math-solve-b solve-b) |
| 2747 | (let ((math-solve-b solve-b) | 2741 | (math-poly-neg-powers '(1)) |
| 2748 | (math-poly-neg-powers '(1)) | 2742 | (math-poly-mult-powers nil) |
| 2749 | (math-poly-mult-powers nil) | 2743 | (math-poly-frac-powers 1) |
| 2750 | (math-poly-frac-powers 1) | 2744 | (math-poly-exp-base t)) |
| 2751 | (math-poly-exp-base t)) | 2745 | (and (not (equal math-solve-b math-solve-lhs)) |
| 2752 | (and (not (equal math-solve-b math-solve-lhs)) | 2746 | (or (not (memq (car-safe math-solve-b) '(+ -))) sub-rhs) |
| 2753 | (or (not (memq (car-safe math-solve-b) '(+ -))) sub-rhs) | 2747 | (setq math-t3 '(1 0) math-t2 1 |
| 2754 | (setq math-t3 '(1 0) math-t2 1 | 2748 | math-t1 (math-is-polynomial math-solve-lhs |
| 2755 | math-t1 (math-is-polynomial math-solve-lhs | 2749 | math-solve-b 50)) |
| 2756 | math-solve-b 50)) | 2750 | (if (and (equal math-poly-neg-powers '(1)) |
| 2757 | (if (and (equal math-poly-neg-powers '(1)) | 2751 | (memq math-poly-mult-powers '(nil 1)) |
| 2758 | (memq math-poly-mult-powers '(nil 1)) | 2752 | (eq math-poly-frac-powers 1) |
| 2759 | (eq math-poly-frac-powers 1) | 2753 | sub-rhs) |
| 2760 | sub-rhs) | 2754 | (setq math-t1 (cons (math-sub (car math-t1) math-solve-rhs) |
| 2761 | (setq math-t1 (cons (math-sub (car math-t1) math-solve-rhs) | 2755 | (cdr math-t1))) |
| 2762 | (cdr math-t1))) | 2756 | (math-solve-poly-funny-powers sub-rhs)) |
| 2763 | (math-solve-poly-funny-powers sub-rhs)) | 2757 | (math-solve-crunch-poly degree) |
| 2764 | (math-solve-crunch-poly degree) | 2758 | (or (math-expr-contains math-solve-b math-solve-var) |
| 2765 | (or (math-expr-contains math-solve-b math-solve-var) | 2759 | (math-expr-contains (car math-t3) math-solve-var))))))) |
| 2766 | (math-expr-contains (car math-t3) math-solve-var)))))))) | ||
| 2767 | (if math-t2 | 2760 | (if math-t2 |
| 2768 | (list (math-pow math-t2 (car math-t3)) | 2761 | (list (math-pow math-t2 (car math-t3)) |
| 2769 | (cons 'vec math-t1) | 2762 | (cons 'vec math-t1) |
| @@ -3326,12 +3319,11 @@ | |||
| 3326 | (delq (car v) (copy-sequence var-list)) | 3319 | (delq (car v) (copy-sequence var-list)) |
| 3327 | (let ((math-solve-simplifying nil) | 3320 | (let ((math-solve-simplifying nil) |
| 3328 | (s (mapcar | 3321 | (s (mapcar |
| 3329 | (function | 3322 | (lambda (x) |
| 3330 | (lambda (x) | 3323 | (cons |
| 3331 | (cons | 3324 | (car x) |
| 3332 | (car x) | 3325 | (math-solve-system-subst |
| 3333 | (math-solve-system-subst | 3326 | (cdr x)))) |
| 3334 | (cdr x))))) | ||
| 3335 | solns))) | 3327 | solns))) |
| 3336 | (if elim | 3328 | (if elim |
| 3337 | s | 3329 | s |
| @@ -3347,35 +3339,33 @@ | |||
| 3347 | 3339 | ||
| 3348 | ;; Eliminated all variables, so now put solution into the proper format. | 3340 | ;; Eliminated all variables, so now put solution into the proper format. |
| 3349 | (setq solns (sort solns | 3341 | (setq solns (sort solns |
| 3350 | (function | 3342 | (lambda (x y) |
| 3351 | (lambda (x y) | 3343 | (not (memq (car x) (memq (car y) math-solve-vars)))))) |
| 3352 | (not (memq (car x) (memq (car y) math-solve-vars))))))) | ||
| 3353 | (if (eq math-solve-full 'all) | 3344 | (if (eq math-solve-full 'all) |
| 3354 | (math-transpose | 3345 | (math-transpose |
| 3355 | (math-normalize | 3346 | (math-normalize |
| 3356 | (cons 'vec | 3347 | (cons 'vec |
| 3357 | (if solns | 3348 | (if solns |
| 3358 | (mapcar (function (lambda (x) (cons 'vec (cdr x)))) solns) | 3349 | (mapcar (lambda (x) (cons 'vec (cdr x))) solns) |
| 3359 | (mapcar (function (lambda (x) (cons 'vec x))) eqn-list))))) | 3350 | (mapcar (lambda (x) (cons 'vec x)) eqn-list))))) |
| 3360 | (math-normalize | 3351 | (math-normalize |
| 3361 | (cons 'vec | 3352 | (cons 'vec |
| 3362 | (if solns | 3353 | (if solns |
| 3363 | (mapcar (function (lambda (x) (cons 'calcFunc-eq x))) solns) | 3354 | (mapcar (lambda (x) (cons 'calcFunc-eq x)) solns) |
| 3364 | (mapcar 'car eqn-list))))))) | 3355 | (mapcar #'car eqn-list))))))) |
| 3365 | 3356 | ||
| 3366 | (defun math-solve-system-subst (x) ; uses "res" and "v" | 3357 | (defun math-solve-system-subst (x) ; uses "res" and "v" |
| 3367 | (let ((accum nil) | 3358 | (let ((accum nil) |
| 3368 | (res2 math-solve-system-res)) | 3359 | (res2 math-solve-system-res)) |
| 3369 | (while x | 3360 | (while x |
| 3370 | (setq accum (nconc accum | 3361 | (setq accum (nconc accum |
| 3371 | (mapcar (function | 3362 | (mapcar (lambda (r) |
| 3372 | (lambda (r) | 3363 | (if math-solve-simplifying |
| 3373 | (if math-solve-simplifying | 3364 | (math-simplify |
| 3374 | (math-simplify | 3365 | (math-expr-subst |
| 3375 | (math-expr-subst | 3366 | (car x) math-solve-system-vv r)) |
| 3376 | (car x) math-solve-system-vv r)) | 3367 | (math-expr-subst |
| 3377 | (math-expr-subst | 3368 | (car x) math-solve-system-vv r))) |
| 3378 | (car x) math-solve-system-vv r)))) | ||
| 3379 | (car res2))) | 3369 | (car res2))) |
| 3380 | x (cdr x) | 3370 | x (cdr x) |
| 3381 | res2 (cdr res2))) | 3371 | res2 (cdr res2))) |
| @@ -3471,11 +3461,10 @@ | |||
| 3471 | (let ((old-len (length res)) | 3461 | (let ((old-len (length res)) |
| 3472 | new-len) | 3462 | new-len) |
| 3473 | (setq res (delq nil | 3463 | (setq res (delq nil |
| 3474 | (mapcar (function | 3464 | (mapcar (lambda (x) |
| 3475 | (lambda (x) | 3465 | (and (not (memq (car-safe x) |
| 3476 | (and (not (memq (car-safe x) | 3466 | '(cplx polar))) |
| 3477 | '(cplx polar))) | 3467 | x)) |
| 3478 | x))) | ||
| 3479 | res)) | 3468 | res)) |
| 3480 | new-len (length res)) | 3469 | new-len (length res)) |
| 3481 | (if (< new-len old-len) | 3470 | (if (< new-len old-len) |
| @@ -3545,119 +3534,119 @@ | |||
| 3545 | 3534 | ||
| 3546 | 3535 | ||
| 3547 | (put 'calcFunc-inv 'math-inverse | 3536 | (put 'calcFunc-inv 'math-inverse |
| 3548 | (function (lambda (x) (math-div 1 x)))) | 3537 | (lambda (x) (math-div 1 x))) |
| 3549 | (put 'calcFunc-inv 'math-inverse-sign -1) | 3538 | (put 'calcFunc-inv 'math-inverse-sign -1) |
| 3550 | 3539 | ||
| 3551 | (put 'calcFunc-sqrt 'math-inverse | 3540 | (put 'calcFunc-sqrt 'math-inverse |
| 3552 | (function (lambda (x) (math-sqr x)))) | 3541 | (lambda (x) (math-sqr x))) |
| 3553 | 3542 | ||
| 3554 | (put 'calcFunc-conj 'math-inverse | 3543 | (put 'calcFunc-conj 'math-inverse |
| 3555 | (function (lambda (x) (list 'calcFunc-conj x)))) | 3544 | (lambda (x) (list 'calcFunc-conj x))) |
| 3556 | 3545 | ||
| 3557 | (put 'calcFunc-abs 'math-inverse | 3546 | (put 'calcFunc-abs 'math-inverse |
| 3558 | (function (lambda (x) (math-solve-get-sign x)))) | 3547 | (lambda (x) (math-solve-get-sign x))) |
| 3559 | 3548 | ||
| 3560 | (put 'calcFunc-deg 'math-inverse | 3549 | (put 'calcFunc-deg 'math-inverse |
| 3561 | (function (lambda (x) (list 'calcFunc-rad x)))) | 3550 | (lambda (x) (list 'calcFunc-rad x))) |
| 3562 | (put 'calcFunc-deg 'math-inverse-sign 1) | 3551 | (put 'calcFunc-deg 'math-inverse-sign 1) |
| 3563 | 3552 | ||
| 3564 | (put 'calcFunc-rad 'math-inverse | 3553 | (put 'calcFunc-rad 'math-inverse |
| 3565 | (function (lambda (x) (list 'calcFunc-deg x)))) | 3554 | (lambda (x) (list 'calcFunc-deg x))) |
| 3566 | (put 'calcFunc-rad 'math-inverse-sign 1) | 3555 | (put 'calcFunc-rad 'math-inverse-sign 1) |
| 3567 | 3556 | ||
| 3568 | (put 'calcFunc-ln 'math-inverse | 3557 | (put 'calcFunc-ln 'math-inverse |
| 3569 | (function (lambda (x) (list 'calcFunc-exp x)))) | 3558 | (lambda (x) (list 'calcFunc-exp x))) |
| 3570 | (put 'calcFunc-ln 'math-inverse-sign 1) | 3559 | (put 'calcFunc-ln 'math-inverse-sign 1) |
| 3571 | 3560 | ||
| 3572 | (put 'calcFunc-log10 'math-inverse | 3561 | (put 'calcFunc-log10 'math-inverse |
| 3573 | (function (lambda (x) (list 'calcFunc-exp10 x)))) | 3562 | (lambda (x) (list 'calcFunc-exp10 x))) |
| 3574 | (put 'calcFunc-log10 'math-inverse-sign 1) | 3563 | (put 'calcFunc-log10 'math-inverse-sign 1) |
| 3575 | 3564 | ||
| 3576 | (put 'calcFunc-lnp1 'math-inverse | 3565 | (put 'calcFunc-lnp1 'math-inverse |
| 3577 | (function (lambda (x) (list 'calcFunc-expm1 x)))) | 3566 | (lambda (x) (list 'calcFunc-expm1 x))) |
| 3578 | (put 'calcFunc-lnp1 'math-inverse-sign 1) | 3567 | (put 'calcFunc-lnp1 'math-inverse-sign 1) |
| 3579 | 3568 | ||
| 3580 | (put 'calcFunc-exp 'math-inverse | 3569 | (put 'calcFunc-exp 'math-inverse |
| 3581 | (function (lambda (x) (math-add (math-normalize (list 'calcFunc-ln x)) | 3570 | (lambda (x) (math-add (math-normalize (list 'calcFunc-ln x)) |
| 3582 | (math-mul 2 | 3571 | (math-mul 2 |
| 3583 | (math-mul '(var pi var-pi) | 3572 | (math-mul '(var pi var-pi) |
| 3584 | (math-solve-get-int | 3573 | (math-solve-get-int |
| 3585 | '(var i var-i)))))))) | 3574 | '(var i var-i))))))) |
| 3586 | (put 'calcFunc-exp 'math-inverse-sign 1) | 3575 | (put 'calcFunc-exp 'math-inverse-sign 1) |
| 3587 | 3576 | ||
| 3588 | (put 'calcFunc-expm1 'math-inverse | 3577 | (put 'calcFunc-expm1 'math-inverse |
| 3589 | (function (lambda (x) (math-add (math-normalize (list 'calcFunc-lnp1 x)) | 3578 | (lambda (x) (math-add (math-normalize (list 'calcFunc-lnp1 x)) |
| 3590 | (math-mul 2 | 3579 | (math-mul 2 |
| 3591 | (math-mul '(var pi var-pi) | 3580 | (math-mul '(var pi var-pi) |
| 3592 | (math-solve-get-int | 3581 | (math-solve-get-int |
| 3593 | '(var i var-i)))))))) | 3582 | '(var i var-i))))))) |
| 3594 | (put 'calcFunc-expm1 'math-inverse-sign 1) | 3583 | (put 'calcFunc-expm1 'math-inverse-sign 1) |
| 3595 | 3584 | ||
| 3596 | (put 'calcFunc-sin 'math-inverse | 3585 | (put 'calcFunc-sin 'math-inverse |
| 3597 | (function (lambda (x) (let ((n (math-solve-get-int 1))) | 3586 | (lambda (x) (let ((n (math-solve-get-int 1))) |
| 3598 | (math-add (math-mul (math-normalize | 3587 | (math-add (math-mul (math-normalize |
| 3599 | (list 'calcFunc-arcsin x)) | 3588 | (list 'calcFunc-arcsin x)) |
| 3600 | (math-pow -1 n)) | 3589 | (math-pow -1 n)) |
| 3601 | (math-mul (math-half-circle t) | 3590 | (math-mul (math-half-circle t) |
| 3602 | n)))))) | 3591 | n))))) |
| 3603 | 3592 | ||
| 3604 | (put 'calcFunc-cos 'math-inverse | 3593 | (put 'calcFunc-cos 'math-inverse |
| 3605 | (function (lambda (x) (math-add (math-solve-get-sign | 3594 | (lambda (x) (math-add (math-solve-get-sign |
| 3606 | (math-normalize | 3595 | (math-normalize |
| 3607 | (list 'calcFunc-arccos x))) | 3596 | (list 'calcFunc-arccos x))) |
| 3608 | (math-solve-get-int | 3597 | (math-solve-get-int |
| 3609 | (math-full-circle t)))))) | 3598 | (math-full-circle t))))) |
| 3610 | 3599 | ||
| 3611 | (put 'calcFunc-tan 'math-inverse | 3600 | (put 'calcFunc-tan 'math-inverse |
| 3612 | (function (lambda (x) (math-add (math-normalize (list 'calcFunc-arctan x)) | 3601 | (lambda (x) (math-add (math-normalize (list 'calcFunc-arctan x)) |
| 3613 | (math-solve-get-int | 3602 | (math-solve-get-int |
| 3614 | (math-half-circle t)))))) | 3603 | (math-half-circle t))))) |
| 3615 | 3604 | ||
| 3616 | (put 'calcFunc-arcsin 'math-inverse | 3605 | (put 'calcFunc-arcsin 'math-inverse |
| 3617 | (function (lambda (x) (math-normalize (list 'calcFunc-sin x))))) | 3606 | (lambda (x) (math-normalize (list 'calcFunc-sin x)))) |
| 3618 | 3607 | ||
| 3619 | (put 'calcFunc-arccos 'math-inverse | 3608 | (put 'calcFunc-arccos 'math-inverse |
| 3620 | (function (lambda (x) (math-normalize (list 'calcFunc-cos x))))) | 3609 | (lambda (x) (math-normalize (list 'calcFunc-cos x)))) |
| 3621 | 3610 | ||
| 3622 | (put 'calcFunc-arctan 'math-inverse | 3611 | (put 'calcFunc-arctan 'math-inverse |
| 3623 | (function (lambda (x) (math-normalize (list 'calcFunc-tan x))))) | 3612 | (lambda (x) (math-normalize (list 'calcFunc-tan x)))) |
| 3624 | 3613 | ||
| 3625 | (put 'calcFunc-sinh 'math-inverse | 3614 | (put 'calcFunc-sinh 'math-inverse |
| 3626 | (function (lambda (x) (let ((n (math-solve-get-int 1))) | 3615 | (lambda (x) (let ((n (math-solve-get-int 1))) |
| 3627 | (math-add (math-mul (math-normalize | 3616 | (math-add (math-mul (math-normalize |
| 3628 | (list 'calcFunc-arcsinh x)) | 3617 | (list 'calcFunc-arcsinh x)) |
| 3629 | (math-pow -1 n)) | 3618 | (math-pow -1 n)) |
| 3630 | (math-mul (math-half-circle t) | 3619 | (math-mul (math-half-circle t) |
| 3631 | (math-mul | 3620 | (math-mul |
| 3632 | '(var i var-i) | 3621 | '(var i var-i) |
| 3633 | n))))))) | 3622 | n)))))) |
| 3634 | (put 'calcFunc-sinh 'math-inverse-sign 1) | 3623 | (put 'calcFunc-sinh 'math-inverse-sign 1) |
| 3635 | 3624 | ||
| 3636 | (put 'calcFunc-cosh 'math-inverse | 3625 | (put 'calcFunc-cosh 'math-inverse |
| 3637 | (function (lambda (x) (math-add (math-solve-get-sign | 3626 | (lambda (x) (math-add (math-solve-get-sign |
| 3638 | (math-normalize | 3627 | (math-normalize |
| 3639 | (list 'calcFunc-arccosh x))) | 3628 | (list 'calcFunc-arccosh x))) |
| 3640 | (math-mul (math-full-circle t) | 3629 | (math-mul (math-full-circle t) |
| 3641 | (math-solve-get-int | 3630 | (math-solve-get-int |
| 3642 | '(var i var-i))))))) | 3631 | '(var i var-i)))))) |
| 3643 | 3632 | ||
| 3644 | (put 'calcFunc-tanh 'math-inverse | 3633 | (put 'calcFunc-tanh 'math-inverse |
| 3645 | (function (lambda (x) (math-add (math-normalize | 3634 | (lambda (x) (math-add (math-normalize |
| 3646 | (list 'calcFunc-arctanh x)) | 3635 | (list 'calcFunc-arctanh x)) |
| 3647 | (math-mul (math-half-circle t) | 3636 | (math-mul (math-half-circle t) |
| 3648 | (math-solve-get-int | 3637 | (math-solve-get-int |
| 3649 | '(var i var-i))))))) | 3638 | '(var i var-i)))))) |
| 3650 | (put 'calcFunc-tanh 'math-inverse-sign 1) | 3639 | (put 'calcFunc-tanh 'math-inverse-sign 1) |
| 3651 | 3640 | ||
| 3652 | (put 'calcFunc-arcsinh 'math-inverse | 3641 | (put 'calcFunc-arcsinh 'math-inverse |
| 3653 | (function (lambda (x) (math-normalize (list 'calcFunc-sinh x))))) | 3642 | (lambda (x) (math-normalize (list 'calcFunc-sinh x)))) |
| 3654 | (put 'calcFunc-arcsinh 'math-inverse-sign 1) | 3643 | (put 'calcFunc-arcsinh 'math-inverse-sign 1) |
| 3655 | 3644 | ||
| 3656 | (put 'calcFunc-arccosh 'math-inverse | 3645 | (put 'calcFunc-arccosh 'math-inverse |
| 3657 | (function (lambda (x) (math-normalize (list 'calcFunc-cosh x))))) | 3646 | (lambda (x) (math-normalize (list 'calcFunc-cosh x)))) |
| 3658 | 3647 | ||
| 3659 | (put 'calcFunc-arctanh 'math-inverse | 3648 | (put 'calcFunc-arctanh 'math-inverse |
| 3660 | (function (lambda (x) (math-normalize (list 'calcFunc-tanh x))))) | 3649 | (lambda (x) (math-normalize (list 'calcFunc-tanh x)))) |
| 3661 | (put 'calcFunc-arctanh 'math-inverse-sign 1) | 3650 | (put 'calcFunc-arctanh 'math-inverse-sign 1) |
| 3662 | 3651 | ||
| 3663 | 3652 | ||
diff --git a/lisp/calc/calcalg3.el b/lisp/calc/calcalg3.el index f1f67211b84..fdcde95dae7 100644 --- a/lisp/calc/calcalg3.el +++ b/lisp/calc/calcalg3.el | |||
| @@ -480,13 +480,13 @@ | |||
| 480 | "Fitting variables" | 480 | "Fitting variables" |
| 481 | (format "%s; %s" | 481 | (format "%s; %s" |
| 482 | (mapconcat 'symbol-name | 482 | (mapconcat 'symbol-name |
| 483 | (mapcar (function (lambda (v) | 483 | (mapcar (lambda (v) |
| 484 | (nth 1 v))) | 484 | (nth 1 v)) |
| 485 | defv) | 485 | defv) |
| 486 | ",") | 486 | ",") |
| 487 | (mapconcat 'symbol-name | 487 | (mapconcat 'symbol-name |
| 488 | (mapcar (function (lambda (v) | 488 | (mapcar (lambda (v) |
| 489 | (nth 1 v))) | 489 | (nth 1 v)) |
| 490 | defc) | 490 | defc) |
| 491 | ","))))) | 491 | ","))))) |
| 492 | (coefs nil)) | 492 | (coefs nil)) |
| @@ -1336,7 +1336,7 @@ | |||
| 1336 | (or (> (length (nth 1 data)) 2) | 1336 | (or (> (length (nth 1 data)) 2) |
| 1337 | (math-reject-arg data "*Too few data points")) | 1337 | (math-reject-arg data "*Too few data points")) |
| 1338 | (if (and (math-vectorp x) (or (math-constp x) math-expand-formulas)) | 1338 | (if (and (math-vectorp x) (or (math-constp x) math-expand-formulas)) |
| 1339 | (cons 'vec (mapcar (function (lambda (x) (calcFunc-polint data x))) | 1339 | (cons 'vec (mapcar (lambda (x) (calcFunc-polint data x)) |
| 1340 | (cdr x))) | 1340 | (cdr x))) |
| 1341 | (or (math-objectp x) math-expand-formulas (math-reject-arg x 'objectp)) | 1341 | (or (math-objectp x) math-expand-formulas (math-reject-arg x 'objectp)) |
| 1342 | (math-with-extra-prec 2 | 1342 | (math-with-extra-prec 2 |
| @@ -1352,7 +1352,7 @@ | |||
| 1352 | (or (> (length (nth 1 data)) 2) | 1352 | (or (> (length (nth 1 data)) 2) |
| 1353 | (math-reject-arg data "*Too few data points")) | 1353 | (math-reject-arg data "*Too few data points")) |
| 1354 | (if (and (math-vectorp x) (or (math-constp x) math-expand-formulas)) | 1354 | (if (and (math-vectorp x) (or (math-constp x) math-expand-formulas)) |
| 1355 | (cons 'vec (mapcar (function (lambda (x) (calcFunc-ratint data x))) | 1355 | (cons 'vec (mapcar (lambda (x) (calcFunc-ratint data x)) |
| 1356 | (cdr x))) | 1356 | (cdr x))) |
| 1357 | (or (math-objectp x) math-expand-formulas (math-reject-arg x 'objectp)) | 1357 | (or (math-objectp x) math-expand-formulas (math-reject-arg x 'objectp)) |
| 1358 | (math-with-extra-prec 2 | 1358 | (math-with-extra-prec 2 |
| @@ -1910,8 +1910,8 @@ | |||
| 1910 | (while p | 1910 | (while p |
| 1911 | (setq vars (delq (assoc (car-safe p) vars) vars) | 1911 | (setq vars (delq (assoc (car-safe p) vars) vars) |
| 1912 | p (cdr p))) | 1912 | p (cdr p))) |
| 1913 | (sort (mapcar 'car vars) | 1913 | (sort (mapcar #'car vars) |
| 1914 | (function (lambda (x y) (string< (nth 1 x) (nth 1 y))))))) | 1914 | (lambda (x y) (string< (nth 1 x) (nth 1 y)))))) |
| 1915 | 1915 | ||
| 1916 | ;; The variables math-all-vars-vars (the vars for math-all-vars) and | 1916 | ;; The variables math-all-vars-vars (the vars for math-all-vars) and |
| 1917 | ;; math-all-vars-found are local to math-all-vars-in, but are used by | 1917 | ;; math-all-vars-found are local to math-all-vars-in, but are used by |
diff --git a/lisp/calc/calccomp.el b/lisp/calc/calccomp.el index 1f3ae842638..e4f6e989ecf 100644 --- a/lisp/calc/calccomp.el +++ b/lisp/calc/calccomp.el | |||
| @@ -464,14 +464,13 @@ | |||
| 464 | (math-compose-vector (cdr (nth 1 a)) | 464 | (math-compose-vector (cdr (nth 1 a)) |
| 465 | (math-vector-to-string sep nil) | 465 | (math-vector-to-string sep nil) |
| 466 | (or cprec prec)) | 466 | (or cprec prec)) |
| 467 | (cons 'horiz (mapcar (function | 467 | (cons 'horiz (mapcar (lambda (x) |
| 468 | (lambda (x) | 468 | (if (eq (car-safe x) 'calcFunc-bstring) |
| 469 | (if (eq (car-safe x) 'calcFunc-bstring) | 469 | (prog1 |
| 470 | (prog1 | 470 | (math-compose-expr |
| 471 | (math-compose-expr | 471 | x (or bprec cprec prec)) |
| 472 | x (or bprec cprec prec)) | 472 | (setq bprec -123)) |
| 473 | (setq bprec -123)) | 473 | (math-compose-expr x (or cprec prec)))) |
| 474 | (math-compose-expr x (or cprec prec))))) | ||
| 475 | (cdr (nth 1 a))))))) | 474 | (cdr (nth 1 a))))))) |
| 476 | ((and (memq (car a) '(calcFunc-cvert calcFunc-clvert calcFunc-crvert)) | 475 | ((and (memq (car a) '(calcFunc-cvert calcFunc-clvert calcFunc-crvert)) |
| 477 | (not (eq calc-language 'unform)) | 476 | (not (eq calc-language 'unform)) |
| @@ -482,47 +481,46 @@ | |||
| 482 | (let* ((base 0) | 481 | (let* ((base 0) |
| 483 | (v 0) | 482 | (v 0) |
| 484 | (prec (or (nth 2 a) prec)) | 483 | (prec (or (nth 2 a) prec)) |
| 485 | (c (mapcar (function | 484 | (c (mapcar (lambda (x) |
| 486 | (lambda (x) | 485 | (let ((b nil) (cc nil) a d) |
| 487 | (let ((b nil) (cc nil) a d) | 486 | (if (and (memq (car-safe x) '(calcFunc-cbase |
| 488 | (if (and (memq (car-safe x) '(calcFunc-cbase | 487 | calcFunc-ctbase |
| 489 | calcFunc-ctbase | 488 | calcFunc-cbbase)) |
| 490 | calcFunc-cbbase)) | 489 | (memq (length x) '(1 2))) |
| 491 | (memq (length x) '(1 2))) | 490 | (setq b (car x) |
| 492 | (setq b (car x) | 491 | x (nth 1 x))) |
| 493 | x (nth 1 x))) | 492 | (if (and (eq (car-safe x) 'calcFunc-crule) |
| 494 | (if (and (eq (car-safe x) 'calcFunc-crule) | 493 | (memq (length x) '(1 2)) |
| 495 | (memq (length x) '(1 2)) | 494 | (or (null (nth 1 x)) |
| 496 | (or (null (nth 1 x)) | 495 | (and (math-vectorp (nth 1 x)) |
| 497 | (and (math-vectorp (nth 1 x)) | 496 | (= (length (nth 1 x)) 2) |
| 498 | (= (length (nth 1 x)) 2) | 497 | (math-vector-is-string |
| 499 | (math-vector-is-string | 498 | (nth 1 x))) |
| 500 | (nth 1 x))) | 499 | (and (natnump (nth 1 x)) |
| 501 | (and (natnump (nth 1 x)) | 500 | (<= (nth 1 x) 255)))) |
| 502 | (<= (nth 1 x) 255)))) | 501 | (setq cc (list |
| 503 | (setq cc (list | 502 | 'rule |
| 504 | 'rule | 503 | (if (math-vectorp (nth 1 x)) |
| 505 | (if (math-vectorp (nth 1 x)) | 504 | (aref (math-vector-to-string |
| 506 | (aref (math-vector-to-string | 505 | (nth 1 x) nil) 0) |
| 507 | (nth 1 x) nil) 0) | 506 | (or (nth 1 x) ?-)))) |
| 508 | (or (nth 1 x) ?-)))) | 507 | (or (and (memq (car-safe x) '(calcFunc-cvspace |
| 509 | (or (and (memq (car-safe x) '(calcFunc-cvspace | 508 | calcFunc-ctspace |
| 510 | calcFunc-ctspace | 509 | calcFunc-cbspace)) |
| 511 | calcFunc-cbspace)) | 510 | (memq (length x) '(2 3)) |
| 512 | (memq (length x) '(2 3)) | 511 | (eq (nth 1 x) 0)) |
| 513 | (eq (nth 1 x) 0)) | 512 | (null x) |
| 514 | (null x) | 513 | (setq cc (math-compose-expr x prec)))) |
| 515 | (setq cc (math-compose-expr x prec)))) | 514 | (setq a (if cc (math-comp-ascent cc) 0) |
| 516 | (setq a (if cc (math-comp-ascent cc) 0) | 515 | d (if cc (math-comp-descent cc) 0)) |
| 517 | d (if cc (math-comp-descent cc) 0)) | 516 | (if (eq b 'calcFunc-cbase) |
| 518 | (if (eq b 'calcFunc-cbase) | 517 | (setq base (+ v a -1)) |
| 519 | (setq base (+ v a -1)) | 518 | (if (eq b 'calcFunc-ctbase) |
| 520 | (if (eq b 'calcFunc-ctbase) | 519 | (setq base v) |
| 521 | (setq base v) | 520 | (if (eq b 'calcFunc-cbbase) |
| 522 | (if (eq b 'calcFunc-cbbase) | 521 | (setq base (+ v a d -1))))) |
| 523 | (setq base (+ v a d -1))))) | 522 | (setq v (+ v a d)) |
| 524 | (setq v (+ v a d)) | 523 | cc)) |
| 525 | cc))) | ||
| 526 | (cdr (nth 1 a))))) | 524 | (cdr (nth 1 a))))) |
| 527 | (setq c (delq nil c)) | 525 | (setq c (delq nil c)) |
| 528 | (if c | 526 | (if c |
| @@ -865,16 +863,15 @@ | |||
| 865 | (while (<= (setq col (1+ col)) cols) | 863 | (while (<= (setq col (1+ col)) cols) |
| 866 | (setq res (cons (cons math-comp-just | 864 | (setq res (cons (cons math-comp-just |
| 867 | (cons base | 865 | (cons base |
| 868 | (mapcar (function | 866 | (mapcar (lambda (r) |
| 869 | (lambda (r) | 867 | (list 'horiz |
| 870 | (list 'horiz | 868 | (math-compose-expr |
| 871 | (math-compose-expr | 869 | (nth col r) |
| 872 | (nth col r) | 870 | math-comp-vector-prec) |
| 873 | math-comp-vector-prec) | 871 | (if (= col cols) |
| 874 | (if (= col cols) | 872 | "" |
| 875 | "" | 873 | (concat |
| 876 | (concat | 874 | math-comp-comma-spc " ")))) |
| 877 | math-comp-comma-spc " "))))) | ||
| 878 | a))) | 875 | a))) |
| 879 | res))) | 876 | res))) |
| 880 | (nreverse res))) | 877 | (nreverse res))) |
| @@ -923,7 +920,7 @@ | |||
| 923 | ( ?\^? . "\\^?" ))) | 920 | ( ?\^? . "\\^?" ))) |
| 924 | 921 | ||
| 925 | (defun math-vector-to-string (a &optional quoted) | 922 | (defun math-vector-to-string (a &optional quoted) |
| 926 | (setq a (concat (mapcar (function (lambda (x) (if (consp x) (nth 1 x) x))) | 923 | (setq a (concat (mapcar (lambda (x) (if (consp x) (nth 1 x) x)) |
| 927 | (cdr a)))) | 924 | (cdr a)))) |
| 928 | (if (string-match "[\000-\037\177\\\"]" a) | 925 | (if (string-match "[\000-\037\177\\\"]" a) |
| 929 | (let ((p 0) | 926 | (let ((p 0) |
diff --git a/lisp/cedet/inversion.el b/lisp/cedet/inversion.el index d47701d5a8b..113f4056e2c 100644 --- a/lisp/cedet/inversion.el +++ b/lisp/cedet/inversion.el | |||
| @@ -349,7 +349,11 @@ Optional argument RESERVED is saved for later use." | |||
| 349 | ;;;###autoload | 349 | ;;;###autoload |
| 350 | (defun inversion-require-emacs (emacs-ver xemacs-ver sxemacs-ver) | 350 | (defun inversion-require-emacs (emacs-ver xemacs-ver sxemacs-ver) |
| 351 | "Declare that you need either EMACS-VER, XEMACS-VER or SXEMACS-ver. | 351 | "Declare that you need either EMACS-VER, XEMACS-VER or SXEMACS-ver. |
| 352 | Only checks one based on which kind of Emacs is being run." | 352 | Only checks one based on which kind of Emacs is being run. |
| 353 | |||
| 354 | This function is obsolete; do this instead: | ||
| 355 | (when (version<= \"28.1\" emacs-version) ...)" | ||
| 356 | (declare (obsolete nil "28.1")) | ||
| 353 | (let ((err (inversion-test 'emacs | 357 | (let ((err (inversion-test 'emacs |
| 354 | (cond ((featurep 'sxemacs) | 358 | (cond ((featurep 'sxemacs) |
| 355 | sxemacs-ver) | 359 | sxemacs-ver) |
diff --git a/lisp/cedet/semantic/bovine/el.el b/lisp/cedet/semantic/bovine/el.el index bbed1d94f20..2f05b99e467 100644 --- a/lisp/cedet/semantic/bovine/el.el +++ b/lisp/cedet/semantic/bovine/el.el | |||
| @@ -464,27 +464,11 @@ Return a bovination list to use." | |||
| 464 | (define-mode-local-override semantic-dependency-tag-file | 464 | (define-mode-local-override semantic-dependency-tag-file |
| 465 | emacs-lisp-mode (tag) | 465 | emacs-lisp-mode (tag) |
| 466 | "Find the file BUFFER depends on described by TAG." | 466 | "Find the file BUFFER depends on described by TAG." |
| 467 | (if (fboundp 'find-library-name) | 467 | (condition-case nil |
| 468 | (condition-case nil | 468 | (find-library-name (semantic-tag-name tag)) |
| 469 | ;; Try an Emacs 22 fcn. This throws errors. | 469 | (error |
| 470 | (find-library-name (semantic-tag-name tag)) | 470 | (message "semantic: cannot find source file %s" |
| 471 | (error | 471 | (semantic-tag-name tag))))) |
| 472 | (message "semantic: cannot find source file %s" | ||
| 473 | (semantic-tag-name tag)))) | ||
| 474 | ;; No handy function available. (Older Emacsen) | ||
| 475 | (let* ((lib (locate-library (semantic-tag-name tag))) | ||
| 476 | (name (if lib (file-name-sans-extension lib) nil)) | ||
| 477 | (nameel (concat name ".el"))) | ||
| 478 | (cond | ||
| 479 | ((and name (file-exists-p nameel)) nameel) | ||
| 480 | ((and name (file-exists-p (concat name ".el.gz"))) | ||
| 481 | ;; This is the linux distro case. | ||
| 482 | (concat name ".el.gz")) | ||
| 483 | ;; Source file does not exist. | ||
| 484 | (name | ||
| 485 | (message "semantic: cannot find source file %s" (concat name ".el"))) | ||
| 486 | (t | ||
| 487 | nil))))) | ||
| 488 | 472 | ||
| 489 | ;;; DOC Strings | 473 | ;;; DOC Strings |
| 490 | ;; | 474 | ;; |
diff --git a/lisp/cedet/semantic/format.el b/lisp/cedet/semantic/format.el index bb2954be561..e972015c6bf 100644 --- a/lisp/cedet/semantic/format.el +++ b/lisp/cedet/semantic/format.el | |||
| @@ -32,7 +32,6 @@ | |||
| 32 | ;; | 32 | ;; |
| 33 | 33 | ||
| 34 | ;;; Code: | 34 | ;;; Code: |
| 35 | (eval-when-compile (require 'font-lock)) | ||
| 36 | (require 'semantic) | 35 | (require 'semantic) |
| 37 | (require 'semantic/tag-ls) | 36 | (require 'semantic/tag-ls) |
| 38 | (require 'ezimage) | 37 | (require 'ezimage) |
| @@ -119,12 +118,10 @@ be used unless font lock is a feature.") | |||
| 119 | "Apply onto TEXT a color associated with FACE-CLASS. | 118 | "Apply onto TEXT a color associated with FACE-CLASS. |
| 120 | FACE-CLASS is a tag type found in `semantic-format-face-alist'. | 119 | FACE-CLASS is a tag type found in `semantic-format-face-alist'. |
| 121 | See that variable for details on adding new types." | 120 | See that variable for details on adding new types." |
| 122 | (if (featurep 'font-lock) | 121 | (let ((face (cdr-safe (assoc face-class semantic-format-face-alist))) |
| 123 | (let ((face (cdr-safe (assoc face-class semantic-format-face-alist))) | 122 | (newtext (concat text))) |
| 124 | (newtext (concat text))) | 123 | (put-text-property 0 (length text) 'face face newtext) |
| 125 | (put-text-property 0 (length text) 'face face newtext) | 124 | newtext)) |
| 126 | newtext) | ||
| 127 | text)) | ||
| 128 | 125 | ||
| 129 | (defun semantic--format-colorize-merge-text (precoloredtext face-class) | 126 | (defun semantic--format-colorize-merge-text (precoloredtext face-class) |
| 130 | "Apply onto PRECOLOREDTEXT a color associated with FACE-CLASS. | 127 | "Apply onto PRECOLOREDTEXT a color associated with FACE-CLASS. |
diff --git a/lisp/cedet/semantic/ia.el b/lisp/cedet/semantic/ia.el index 4a129aae74e..e6711608386 100644 --- a/lisp/cedet/semantic/ia.el +++ b/lisp/cedet/semantic/ia.el | |||
| @@ -79,15 +79,14 @@ | |||
| 79 | (insert "(")) | 79 | (insert "(")) |
| 80 | (t nil)))) | 80 | (t nil)))) |
| 81 | 81 | ||
| 82 | (defalias 'semantic-ia-get-completions 'semantic-ia-get-completions-deprecated | 82 | (defalias 'semantic-ia-get-completions 'semantic-ia-get-completions-deprecated) |
| 83 | "`Semantic-ia-get-completions' is obsolete. | 83 | (make-obsolete 'semantic-ia-get-completions |
| 84 | Use `semantic-analyze-possible-completions' instead.") | 84 | #'semantic-analyze-possible-completions "28.1") |
| 85 | 85 | ||
| 86 | (defun semantic-ia-get-completions-deprecated (context point) | 86 | (defun semantic-ia-get-completions-deprecated (context point) |
| 87 | "A function to help transition away from `semantic-ia-get-completions'. | 87 | "A function to help transition away from `semantic-ia-get-completions'. |
| 88 | Return completions based on CONTEXT at POINT. | 88 | Return completions based on CONTEXT at POINT." |
| 89 | You should not use this, nor the aliased version. | 89 | (declare (obsolete semantic-analyze-possible-completions "28.1")) |
| 90 | Use `semantic-analyze-possible-completions' instead." | ||
| 91 | (semantic-analyze-possible-completions context)) | 90 | (semantic-analyze-possible-completions context)) |
| 92 | 91 | ||
| 93 | ;;;###autoload | 92 | ;;;###autoload |
diff --git a/lisp/cedet/semantic/sort.el b/lisp/cedet/semantic/sort.el index 89fc917e0c7..a565d878f15 100644 --- a/lisp/cedet/semantic/sort.el +++ b/lisp/cedet/semantic/sort.el | |||
| @@ -46,11 +46,7 @@ | |||
| 46 | (defun semantic-string-lessp-ci (s1 s2) | 46 | (defun semantic-string-lessp-ci (s1 s2) |
| 47 | "Case insensitive version of `string-lessp'. | 47 | "Case insensitive version of `string-lessp'. |
| 48 | Argument S1 and S2 are the strings to compare." | 48 | Argument S1 and S2 are the strings to compare." |
| 49 | ;; Use downcase instead of upcase because an average name | 49 | (eq (compare-strings s1 0 nil s2 0 nil t) -1)) |
| 50 | ;; has more lower case characters. | ||
| 51 | (if (fboundp 'compare-strings) | ||
| 52 | (eq (compare-strings s1 0 nil s2 0 nil t) -1) | ||
| 53 | (string-lessp (downcase s1) (downcase s2)))) | ||
| 54 | 50 | ||
| 55 | (defun semantic-sort-tag-type (tag) | 51 | (defun semantic-sort-tag-type (tag) |
| 56 | "Return a type string for TAG guaranteed to be a string." | 52 | "Return a type string for TAG guaranteed to be a string." |
diff --git a/lisp/cedet/semantic/symref/grep.el b/lisp/cedet/semantic/symref/grep.el index d8de8ead4e9..29e88cda125 100644 --- a/lisp/cedet/semantic/symref/grep.el +++ b/lisp/cedet/semantic/symref/grep.el | |||
| @@ -167,24 +167,10 @@ This shell should support pipe redirect syntax." | |||
| 167 | (with-current-buffer b | 167 | (with-current-buffer b |
| 168 | (erase-buffer) | 168 | (erase-buffer) |
| 169 | (setq default-directory rootdir) | 169 | (setq default-directory rootdir) |
| 170 | 170 | (let ((cmd (semantic-symref-grep-use-template | |
| 171 | (if (not (fboundp 'grep-compute-defaults)) | 171 | (file-local-name rootdir) filepattern grepflags greppat))) |
| 172 | 172 | (process-file semantic-symref-grep-shell nil b nil | |
| 173 | ;; find . -type f -print0 | xargs -0 -e grep -nH -e | 173 | shell-command-switch cmd))) |
| 174 | ;; Note : I removed -e as it is not posix, nor necessary it seems. | ||
| 175 | |||
| 176 | (let ((cmd (concat "find " (file-local-name rootdir) | ||
| 177 | " -type f " filepattern " -print0 " | ||
| 178 | "| xargs -0 grep -H " grepflags "-e " greppat))) | ||
| 179 | ;;(message "Old command: %s" cmd) | ||
| 180 | (process-file semantic-symref-grep-shell nil b nil | ||
| 181 | shell-command-switch cmd) | ||
| 182 | ) | ||
| 183 | (let ((cmd (semantic-symref-grep-use-template | ||
| 184 | (file-local-name rootdir) filepattern grepflags greppat))) | ||
| 185 | (process-file semantic-symref-grep-shell nil b nil | ||
| 186 | shell-command-switch cmd)) | ||
| 187 | )) | ||
| 188 | (setq ans (semantic-symref-parse-tool-output tool b)) | 174 | (setq ans (semantic-symref-parse-tool-output tool b)) |
| 189 | ;; Return the answer | 175 | ;; Return the answer |
| 190 | ans)) | 176 | ans)) |
diff --git a/lisp/cedet/semantic/tag.el b/lisp/cedet/semantic/tag.el index e677264c5a9..3dadf347736 100644 --- a/lisp/cedet/semantic/tag.el +++ b/lisp/cedet/semantic/tag.el | |||
| @@ -53,6 +53,11 @@ | |||
| 53 | (declare-function semantic-clear-toplevel-cache "semantic") | 53 | (declare-function semantic-clear-toplevel-cache "semantic") |
| 54 | (declare-function semantic-tag-similar-p "semantic/tag-ls") | 54 | (declare-function semantic-tag-similar-p "semantic/tag-ls") |
| 55 | 55 | ||
| 56 | (define-obsolete-variable-alias 'semantic-token-version | ||
| 57 | 'semantic-tag-version "28.1") | ||
| 58 | (define-obsolete-variable-alias 'semantic-token-incompatible-version | ||
| 59 | 'semantic-tag-incompatible-version "28.1") | ||
| 60 | |||
| 56 | (defconst semantic-tag-version "2.0" | 61 | (defconst semantic-tag-version "2.0" |
| 57 | "Version string of semantic tags made with this code.") | 62 | "Version string of semantic tags made with this code.") |
| 58 | 63 | ||
| @@ -1321,12 +1326,6 @@ This function is overridable with the symbol `insert-foreign-tag'." | |||
| 1321 | "Insert foreign tags into log-edit mode." | 1326 | "Insert foreign tags into log-edit mode." |
| 1322 | (insert (concat "(" (semantic-format-tag-name foreign-tag) "): "))) | 1327 | (insert (concat "(" (semantic-format-tag-name foreign-tag) "): "))) |
| 1323 | 1328 | ||
| 1324 | ;;; Compatibility | ||
| 1325 | ;; | ||
| 1326 | (defconst semantic-token-version | ||
| 1327 | semantic-tag-version) | ||
| 1328 | (defconst semantic-token-incompatible-version | ||
| 1329 | semantic-tag-incompatible-version) | ||
| 1330 | 1329 | ||
| 1331 | (provide 'semantic/tag) | 1330 | (provide 'semantic/tag) |
| 1332 | 1331 | ||
diff --git a/lisp/cus-dep.el b/lisp/cus-dep.el index 0eb4dbf9e5f..01b804974d4 100644 --- a/lisp/cus-dep.el +++ b/lisp/cus-dep.el | |||
| @@ -205,7 +205,7 @@ Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS" | |||
| 205 | (setq where (get symbol 'custom-where)) | 205 | (setq where (get symbol 'custom-where)) |
| 206 | (when where | 206 | (when where |
| 207 | (if (or (custom-variable-p symbol) | 207 | (if (or (custom-variable-p symbol) |
| 208 | (custom-facep symbol)) | 208 | (facep symbol)) |
| 209 | ;; This means it's a variable or a face. | 209 | ;; This means it's a variable or a face. |
| 210 | (progn | 210 | (progn |
| 211 | (if (assoc version version-alist) | 211 | (if (assoc version version-alist) |
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index d1077d367d5..eceba8fa4d6 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el | |||
| @@ -1295,10 +1295,11 @@ that were added or redefined since that version." | |||
| 1295 | (push (list symbol 'custom-group) found)) | 1295 | (push (list symbol 'custom-group) found)) |
| 1296 | (if (custom-variable-p symbol) | 1296 | (if (custom-variable-p symbol) |
| 1297 | (push (list symbol 'custom-variable) found)) | 1297 | (push (list symbol 'custom-variable) found)) |
| 1298 | (if (custom-facep symbol) | 1298 | (if (facep symbol) |
| 1299 | (push (list symbol 'custom-face) found))))))) | 1299 | (push (list symbol 'custom-face) found))))))) |
| 1300 | (if found | 1300 | (if found |
| 1301 | (custom-buffer-create (custom-sort-items found t 'first) | 1301 | (custom-buffer-create (custom--filter-obsolete-variables |
| 1302 | (custom-sort-items found t 'first)) | ||
| 1302 | "*Customize Changed Options*") | 1303 | "*Customize Changed Options*") |
| 1303 | (user-error "No user option defaults have been changed since Emacs %s" | 1304 | (user-error "No user option defaults have been changed since Emacs %s" |
| 1304 | since-version)))) | 1305 | since-version)))) |
| @@ -1405,7 +1406,7 @@ symbols `custom-face' or `custom-variable'." | |||
| 1405 | (mapatoms (lambda (symbol) | 1406 | (mapatoms (lambda (symbol) |
| 1406 | (and (or (get symbol 'customized-face) | 1407 | (and (or (get symbol 'customized-face) |
| 1407 | (get symbol 'customized-face-comment)) | 1408 | (get symbol 'customized-face-comment)) |
| 1408 | (custom-facep symbol) | 1409 | (facep symbol) |
| 1409 | (push (list symbol 'custom-face) found)) | 1410 | (push (list symbol 'custom-face) found)) |
| 1410 | (and (or (get symbol 'customized-value) | 1411 | (and (or (get symbol 'customized-value) |
| 1411 | (get symbol 'customized-variable-comment)) | 1412 | (get symbol 'customized-variable-comment)) |
| @@ -1452,7 +1453,7 @@ symbols `custom-face' or `custom-variable'." | |||
| 1452 | (mapatoms (lambda (symbol) | 1453 | (mapatoms (lambda (symbol) |
| 1453 | (and (or (get symbol 'saved-face) | 1454 | (and (or (get symbol 'saved-face) |
| 1454 | (get symbol 'saved-face-comment)) | 1455 | (get symbol 'saved-face-comment)) |
| 1455 | (custom-facep symbol) | 1456 | (facep symbol) |
| 1456 | (push (list symbol 'custom-face) found)) | 1457 | (push (list symbol 'custom-face) found)) |
| 1457 | (and (or (get symbol 'saved-value) | 1458 | (and (or (get symbol 'saved-value) |
| 1458 | (get symbol 'saved-variable-comment)) | 1459 | (get symbol 'saved-variable-comment)) |
| @@ -1490,7 +1491,7 @@ If TYPE is `groups', include only groups." | |||
| 1490 | (if (get symbol 'custom-group) | 1491 | (if (get symbol 'custom-group) |
| 1491 | (push (list symbol 'custom-group) found))) | 1492 | (push (list symbol 'custom-group) found))) |
| 1492 | (if (memq type '(nil faces)) | 1493 | (if (memq type '(nil faces)) |
| 1493 | (if (custom-facep symbol) | 1494 | (if (facep symbol) |
| 1494 | (push (list symbol 'custom-face) found))) | 1495 | (push (list symbol 'custom-face) found))) |
| 1495 | (if (memq type '(nil options)) | 1496 | (if (memq type '(nil options)) |
| 1496 | (if (and (boundp symbol) | 1497 | (if (and (boundp symbol) |
| @@ -1504,7 +1505,8 @@ If TYPE is `groups', include only groups." | |||
| 1504 | (symbol-name type)) | 1505 | (symbol-name type)) |
| 1505 | pattern)) | 1506 | pattern)) |
| 1506 | (custom-buffer-create | 1507 | (custom-buffer-create |
| 1507 | (custom-sort-items found t custom-buffer-order-groups) | 1508 | (custom--filter-obsolete-variables |
| 1509 | (custom-sort-items found t custom-buffer-order-groups)) | ||
| 1508 | "*Customize Apropos*"))) | 1510 | "*Customize Apropos*"))) |
| 1509 | 1511 | ||
| 1510 | ;;;###autoload | 1512 | ;;;###autoload |
| @@ -4232,6 +4234,13 @@ and so forth. The remaining group tags are shown with `custom-group-tag'." | |||
| 4232 | (insert "--------"))) | 4234 | (insert "--------"))) |
| 4233 | (widget-default-create widget)) | 4235 | (widget-default-create widget)) |
| 4234 | 4236 | ||
| 4237 | (defun custom--filter-obsolete-variables (items) | ||
| 4238 | "Filter obsolete variables from ITEMS." | ||
| 4239 | (seq-remove (lambda (item) | ||
| 4240 | (and (eq (nth 1 item) 'custom-variable) | ||
| 4241 | (get (nth 0 item) 'byte-obsolete-variable))) | ||
| 4242 | items)) | ||
| 4243 | |||
| 4235 | (defun custom-group-members (symbol groups-only) | 4244 | (defun custom-group-members (symbol groups-only) |
| 4236 | "Return SYMBOL's custom group members. | 4245 | "Return SYMBOL's custom group members. |
| 4237 | If GROUPS-ONLY is non-nil, return only those members that are groups." | 4246 | If GROUPS-ONLY is non-nil, return only those members that are groups." |
| @@ -4437,12 +4446,13 @@ This works for both graphical and text displays." | |||
| 4437 | ?\s)) | 4446 | ?\s)) |
| 4438 | ;; Members. | 4447 | ;; Members. |
| 4439 | (message "Creating group...") | 4448 | (message "Creating group...") |
| 4440 | (let* ((members (custom-sort-items | 4449 | (let* ((members (custom--filter-obsolete-variables |
| 4441 | members | 4450 | (custom-sort-items |
| 4442 | ;; Never sort the top-level custom group. | 4451 | members |
| 4443 | (unless (eq symbol 'emacs) | 4452 | ;; Never sort the top-level custom group. |
| 4444 | custom-buffer-sort-alphabetically) | 4453 | (unless (eq symbol 'emacs) |
| 4445 | custom-buffer-order-groups)) | 4454 | custom-buffer-sort-alphabetically) |
| 4455 | custom-buffer-order-groups))) | ||
| 4446 | (prefixes (widget-get widget :custom-prefixes)) | 4456 | (prefixes (widget-get widget :custom-prefixes)) |
| 4447 | (custom-prefix-list (custom-prefix-add symbol prefixes)) | 4457 | (custom-prefix-list (custom-prefix-add symbol prefixes)) |
| 4448 | (have-subtitle (and (not (eq symbol 'emacs)) | 4458 | (have-subtitle (and (not (eq symbol 'emacs)) |
| @@ -4888,7 +4898,7 @@ This function does not save the buffer." | |||
| 4888 | (let ((spec (car-safe (get symbol 'theme-face))) | 4898 | (let ((spec (car-safe (get symbol 'theme-face))) |
| 4889 | (value (get symbol 'saved-face)) | 4899 | (value (get symbol 'saved-face)) |
| 4890 | (now (not (or (get symbol 'face-defface-spec) | 4900 | (now (not (or (get symbol 'face-defface-spec) |
| 4891 | (and (not (custom-facep symbol)) | 4901 | (and (not (facep symbol)) |
| 4892 | (not (get symbol 'force-face)))))) | 4902 | (not (get symbol 'force-face)))))) |
| 4893 | (comment (get symbol 'saved-face-comment))) | 4903 | (comment (get symbol 'saved-face-comment))) |
| 4894 | (when (or (and spec (eq (nth 0 spec) 'user)) | 4904 | (when (or (and spec (eq (nth 0 spec) 'user)) |
diff --git a/lisp/cus-face.el b/lisp/cus-face.el index cc766aa4509..199a76e5cc8 100644 --- a/lisp/cus-face.el +++ b/lisp/cus-face.el | |||
| @@ -27,8 +27,6 @@ | |||
| 27 | 27 | ||
| 28 | ;;; Code: | 28 | ;;; Code: |
| 29 | 29 | ||
| 30 | (defalias 'custom-facep 'facep) | ||
| 31 | |||
| 32 | ;;; Declaring a face. | 30 | ;;; Declaring a face. |
| 33 | 31 | ||
| 34 | (defun custom-declare-face (face spec doc &rest args) | 32 | (defun custom-declare-face (face spec doc &rest args) |
| @@ -394,6 +392,8 @@ Each of the arguments ARGS has this form: | |||
| 394 | This means reset FACE to its value in FROM-THEME." | 392 | This means reset FACE to its value in FROM-THEME." |
| 395 | (apply 'custom-theme-reset-faces 'user args)) | 393 | (apply 'custom-theme-reset-faces 'user args)) |
| 396 | 394 | ||
| 395 | (define-obsolete-function-alias 'custom-facep #'facep "28.1") | ||
| 396 | |||
| 397 | ;;; The End. | 397 | ;;; The End. |
| 398 | 398 | ||
| 399 | (provide 'cus-face) | 399 | (provide 'cus-face) |
diff --git a/lisp/edmacro.el b/lisp/edmacro.el index 1d9b4726b04..44cf5aad387 100644 --- a/lisp/edmacro.el +++ b/lisp/edmacro.el | |||
| @@ -535,32 +535,31 @@ doubt, use whitespace." | |||
| 535 | (setq bind-len (1+ text))) | 535 | (setq bind-len (1+ text))) |
| 536 | (t | 536 | (t |
| 537 | (setq desc (mapconcat | 537 | (setq desc (mapconcat |
| 538 | (function | 538 | (lambda (ch) |
| 539 | (lambda (ch) | 539 | (cond |
| 540 | (cond | 540 | ((integerp ch) |
| 541 | ((integerp ch) | 541 | (concat |
| 542 | (concat | 542 | (cl-loop for pf across "ACHMsS" |
| 543 | (cl-loop for pf across "ACHMsS" | 543 | for bit in '(?\A-\^@ ?\C-\^@ ?\H-\^@ |
| 544 | for bit in '(?\A-\^@ ?\C-\^@ ?\H-\^@ | 544 | ?\M-\^@ ?\s-\^@ ?\S-\^@) |
| 545 | ?\M-\^@ ?\s-\^@ ?\S-\^@) | 545 | when (/= (logand ch bit) 0) |
| 546 | when (/= (logand ch bit) 0) | 546 | concat (format "%c-" pf)) |
| 547 | concat (format "%c-" pf)) | 547 | (let ((ch2 (logand ch (1- (ash 1 18))))) |
| 548 | (let ((ch2 (logand ch (1- (ash 1 18))))) | 548 | (cond ((<= ch2 32) |
| 549 | (cond ((<= ch2 32) | 549 | (pcase ch2 |
| 550 | (pcase ch2 | 550 | (0 "NUL") (9 "TAB") (10 "LFD") |
| 551 | (0 "NUL") (9 "TAB") (10 "LFD") | 551 | (13 "RET") (27 "ESC") (32 "SPC") |
| 552 | (13 "RET") (27 "ESC") (32 "SPC") | 552 | (_ |
| 553 | (_ | 553 | (format "C-%c" |
| 554 | (format "C-%c" | 554 | (+ (if (<= ch2 26) 96 64) |
| 555 | (+ (if (<= ch2 26) 96 64) | 555 | ch2))))) |
| 556 | ch2))))) | 556 | ((= ch2 127) "DEL") |
| 557 | ((= ch2 127) "DEL") | 557 | ((<= ch2 maxkey) (char-to-string ch2)) |
| 558 | ((<= ch2 maxkey) (char-to-string ch2)) | 558 | (t (format "\\%o" ch2)))))) |
| 559 | (t (format "\\%o" ch2)))))) | 559 | ((symbolp ch) |
| 560 | ((symbolp ch) | 560 | (format "<%s>" ch)) |
| 561 | (format "<%s>" ch)) | 561 | (t |
| 562 | (t | 562 | (error "Unrecognized item in macro: %s" ch)))) |
| 563 | (error "Unrecognized item in macro: %s" ch))))) | ||
| 564 | (or fkey key) " ")))) | 563 | (or fkey key) " ")))) |
| 565 | (if prefix | 564 | (if prefix |
| 566 | (setq desc (concat (edmacro-sanitize-for-string prefix) desc))) | 565 | (setq desc (concat (edmacro-sanitize-for-string prefix) desc))) |
diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el index fb351879286..e16ce9fded8 100644 --- a/lisp/emacs-lisp/advice.el +++ b/lisp/emacs-lisp/advice.el | |||
| @@ -2375,28 +2375,26 @@ The assignment starts at position INDEX." | |||
| 2375 | (defun ad-insert-argument-access-forms (definition arglist) | 2375 | (defun ad-insert-argument-access-forms (definition arglist) |
| 2376 | "Expands arg-access text macros in DEFINITION according to ARGLIST." | 2376 | "Expands arg-access text macros in DEFINITION according to ARGLIST." |
| 2377 | (ad-substitute-tree | 2377 | (ad-substitute-tree |
| 2378 | (function | 2378 | (lambda (form) |
| 2379 | (lambda (form) | 2379 | (or (eq form 'ad-arg-bindings) |
| 2380 | (or (eq form 'ad-arg-bindings) | 2380 | (and (memq (car-safe form) |
| 2381 | (and (memq (car-safe form) | 2381 | '(ad-get-arg ad-get-args ad-set-arg ad-set-args)) |
| 2382 | '(ad-get-arg ad-get-args ad-set-arg ad-set-args)) | 2382 | (integerp (car-safe (cdr form)))))) |
| 2383 | (integerp (car-safe (cdr form))))))) | 2383 | (lambda (form) |
| 2384 | (function | 2384 | (if (eq form 'ad-arg-bindings) |
| 2385 | (lambda (form) | 2385 | (ad-retrieve-args-form arglist) |
| 2386 | (if (eq form 'ad-arg-bindings) | 2386 | (let ((accessor (car form)) |
| 2387 | (ad-retrieve-args-form arglist) | 2387 | (index (car (cdr form))) |
| 2388 | (let ((accessor (car form)) | 2388 | (val (car (cdr (ad-insert-argument-access-forms |
| 2389 | (index (car (cdr form))) | 2389 | (cdr form) arglist))))) |
| 2390 | (val (car (cdr (ad-insert-argument-access-forms | 2390 | (cond ((eq accessor 'ad-get-arg) |
| 2391 | (cdr form) arglist))))) | 2391 | (ad-get-argument arglist index)) |
| 2392 | (cond ((eq accessor 'ad-get-arg) | 2392 | ((eq accessor 'ad-set-arg) |
| 2393 | (ad-get-argument arglist index)) | 2393 | (ad-set-argument arglist index val)) |
| 2394 | ((eq accessor 'ad-set-arg) | 2394 | ((eq accessor 'ad-get-args) |
| 2395 | (ad-set-argument arglist index val)) | 2395 | (ad-get-arguments arglist index)) |
| 2396 | ((eq accessor 'ad-get-args) | 2396 | ((eq accessor 'ad-set-args) |
| 2397 | (ad-get-arguments arglist index)) | 2397 | (ad-set-arguments arglist index val)))))) |
| 2398 | ((eq accessor 'ad-set-args) | ||
| 2399 | (ad-set-arguments arglist index val))))))) | ||
| 2400 | definition)) | 2398 | definition)) |
| 2401 | 2399 | ||
| 2402 | ;; @@@ Mapping argument lists: | 2400 | ;; @@@ Mapping argument lists: |
diff --git a/lisp/emacs-lisp/benchmark.el b/lisp/emacs-lisp/benchmark.el index 2fa5a878801..8cf1f54411a 100644 --- a/lisp/emacs-lisp/benchmark.el +++ b/lisp/emacs-lisp/benchmark.el | |||
| @@ -43,7 +43,7 @@ | |||
| 43 | ;;;###autoload | 43 | ;;;###autoload |
| 44 | (defmacro benchmark-run (&optional repetitions &rest forms) | 44 | (defmacro benchmark-run (&optional repetitions &rest forms) |
| 45 | "Time execution of FORMS. | 45 | "Time execution of FORMS. |
| 46 | If REPETITIONS is supplied as a number, run forms that many times, | 46 | If REPETITIONS is supplied as a number, run FORMS that many times, |
| 47 | accounting for the overhead of the resulting loop. Otherwise run | 47 | accounting for the overhead of the resulting loop. Otherwise run |
| 48 | FORMS once. | 48 | FORMS once. |
| 49 | Return a list of the total elapsed time for execution, the number of | 49 | Return a list of the total elapsed time for execution, the number of |
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 6d2bff103e7..532f3d1a246 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el | |||
| @@ -2642,7 +2642,8 @@ list that represents a doc string reference. | |||
| 2642 | ;; and similar macros cleaner. | 2642 | ;; and similar macros cleaner. |
| 2643 | (put 'eval 'byte-hunk-handler 'byte-compile-file-form-eval) | 2643 | (put 'eval 'byte-hunk-handler 'byte-compile-file-form-eval) |
| 2644 | (defun byte-compile-file-form-eval (form) | 2644 | (defun byte-compile-file-form-eval (form) |
| 2645 | (if (eq (car-safe (nth 1 form)) 'quote) | 2645 | (if (and (eq (car-safe (nth 1 form)) 'quote) |
| 2646 | (equal (nth 2 form) lexical-binding)) | ||
| 2646 | (nth 1 (nth 1 form)) | 2647 | (nth 1 (nth 1 form)) |
| 2647 | (byte-compile-keep-pending form))) | 2648 | (byte-compile-keep-pending form))) |
| 2648 | 2649 | ||
diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index d3159a37683..a55d78de153 100644 --- a/lisp/emacs-lisp/cl-extra.el +++ b/lisp/emacs-lisp/cl-extra.el | |||
| @@ -209,10 +209,10 @@ non-nil value. | |||
| 209 | \n(fn PREDICATE SEQ...)" | 209 | \n(fn PREDICATE SEQ...)" |
| 210 | (if (or cl-rest (nlistp cl-seq)) | 210 | (if (or cl-rest (nlistp cl-seq)) |
| 211 | (catch 'cl-some | 211 | (catch 'cl-some |
| 212 | (apply 'cl-map nil | 212 | (apply #'cl-map nil |
| 213 | (function (lambda (&rest cl-x) | 213 | (lambda (&rest cl-x) |
| 214 | (let ((cl-res (apply cl-pred cl-x))) | 214 | (let ((cl-res (apply cl-pred cl-x))) |
| 215 | (if cl-res (throw 'cl-some cl-res))))) | 215 | (if cl-res (throw 'cl-some cl-res)))) |
| 216 | cl-seq cl-rest) nil) | 216 | cl-seq cl-rest) nil) |
| 217 | (let ((cl-x nil)) | 217 | (let ((cl-x nil)) |
| 218 | (while (and cl-seq (not (setq cl-x (funcall cl-pred (pop cl-seq)))))) | 218 | (while (and cl-seq (not (setq cl-x (funcall cl-pred (pop cl-seq)))))) |
| @@ -224,9 +224,9 @@ non-nil value. | |||
| 224 | \n(fn PREDICATE SEQ...)" | 224 | \n(fn PREDICATE SEQ...)" |
| 225 | (if (or cl-rest (nlistp cl-seq)) | 225 | (if (or cl-rest (nlistp cl-seq)) |
| 226 | (catch 'cl-every | 226 | (catch 'cl-every |
| 227 | (apply 'cl-map nil | 227 | (apply #'cl-map nil |
| 228 | (function (lambda (&rest cl-x) | 228 | (lambda (&rest cl-x) |
| 229 | (or (apply cl-pred cl-x) (throw 'cl-every nil)))) | 229 | (or (apply cl-pred cl-x) (throw 'cl-every nil))) |
| 230 | cl-seq cl-rest) t) | 230 | cl-seq cl-rest) t) |
| 231 | (while (and cl-seq (funcall cl-pred (car cl-seq))) | 231 | (while (and cl-seq (funcall cl-pred (car cl-seq))) |
| 232 | (setq cl-seq (cdr cl-seq))) | 232 | (setq cl-seq (cdr cl-seq))) |
| @@ -249,14 +249,13 @@ non-nil value. | |||
| 249 | (or cl-base | 249 | (or cl-base |
| 250 | (setq cl-base (copy-sequence [0]))) | 250 | (setq cl-base (copy-sequence [0]))) |
| 251 | (map-keymap | 251 | (map-keymap |
| 252 | (function | 252 | (lambda (cl-key cl-bind) |
| 253 | (lambda (cl-key cl-bind) | 253 | (aset cl-base (1- (length cl-base)) cl-key) |
| 254 | (aset cl-base (1- (length cl-base)) cl-key) | 254 | (if (keymapp cl-bind) |
| 255 | (if (keymapp cl-bind) | 255 | (cl--map-keymap-recursively |
| 256 | (cl--map-keymap-recursively | 256 | cl-func-rec cl-bind |
| 257 | cl-func-rec cl-bind | 257 | (vconcat cl-base (list 0))) |
| 258 | (vconcat cl-base (list 0))) | 258 | (funcall cl-func-rec cl-base cl-bind))) |
| 259 | (funcall cl-func-rec cl-base cl-bind)))) | ||
| 260 | cl-map)) | 259 | cl-map)) |
| 261 | 260 | ||
| 262 | ;;;###autoload | 261 | ;;;###autoload |
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 6f98e0f6d6d..f4b22ffbea2 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el | |||
| @@ -819,16 +819,15 @@ final clause, and matches if no other keys match. | |||
| 819 | (cons | 819 | (cons |
| 820 | 'cond | 820 | 'cond |
| 821 | (mapcar | 821 | (mapcar |
| 822 | (function | 822 | (lambda (c) |
| 823 | (lambda (c) | 823 | (cons (cond ((eq (car c) 'otherwise) t) |
| 824 | (cons (cond ((eq (car c) 'otherwise) t) | 824 | ((eq (car c) 'cl--ecase-error-flag) |
| 825 | ((eq (car c) 'cl--ecase-error-flag) | 825 | `(error "cl-etypecase failed: %s, %s" |
| 826 | `(error "cl-etypecase failed: %s, %s" | 826 | ,temp ',(reverse type-list))) |
| 827 | ,temp ',(reverse type-list))) | 827 | (t |
| 828 | (t | 828 | (push (car c) type-list) |
| 829 | (push (car c) type-list) | 829 | `(cl-typep ,temp ',(car c)))) |
| 830 | `(cl-typep ,temp ',(car c)))) | 830 | (or (cdr c) '(nil)))) |
| 831 | (or (cdr c) '(nil))))) | ||
| 832 | clauses))))) | 831 | clauses))))) |
| 833 | 832 | ||
| 834 | ;;;###autoload | 833 | ;;;###autoload |
| @@ -2793,7 +2792,7 @@ Supported keywords for slots are: | |||
| 2793 | (unless (cl--struct-name-p name) | 2792 | (unless (cl--struct-name-p name) |
| 2794 | (signal 'wrong-type-argument (list 'cl-struct-name-p name 'name))) | 2793 | (signal 'wrong-type-argument (list 'cl-struct-name-p name 'name))) |
| 2795 | (setq descs (cons '(cl-tag-slot) | 2794 | (setq descs (cons '(cl-tag-slot) |
| 2796 | (mapcar (function (lambda (x) (if (consp x) x (list x)))) | 2795 | (mapcar (lambda (x) (if (consp x) x (list x))) |
| 2797 | descs))) | 2796 | descs))) |
| 2798 | (while opts | 2797 | (while opts |
| 2799 | (let ((opt (if (consp (car opts)) (caar opts) (car opts))) | 2798 | (let ((opt (if (consp (car opts)) (caar opts) (car opts))) |
| @@ -2820,9 +2819,8 @@ Supported keywords for slots are: | |||
| 2820 | ;; we include EIEIO classes rather than cl-structs! | 2819 | ;; we include EIEIO classes rather than cl-structs! |
| 2821 | (when include-name (error "Can't :include more than once")) | 2820 | (when include-name (error "Can't :include more than once")) |
| 2822 | (setq include-name (car args)) | 2821 | (setq include-name (car args)) |
| 2823 | (setq include-descs (mapcar (function | 2822 | (setq include-descs (mapcar (lambda (x) |
| 2824 | (lambda (x) | 2823 | (if (consp x) x (list x))) |
| 2825 | (if (consp x) x (list x)))) | ||
| 2826 | (cdr args)))) | 2824 | (cdr args)))) |
| 2827 | ((eq opt :print-function) | 2825 | ((eq opt :print-function) |
| 2828 | (setq print-func (car args))) | 2826 | (setq print-func (car args))) |
diff --git a/lisp/emacs-lisp/cl-seq.el b/lisp/emacs-lisp/cl-seq.el index d34d50172df..8cfdd140f8e 100644 --- a/lisp/emacs-lisp/cl-seq.el +++ b/lisp/emacs-lisp/cl-seq.el | |||
| @@ -69,10 +69,9 @@ | |||
| 69 | (list 'or (list 'memq '(car cl-keys-temp) | 69 | (list 'or (list 'memq '(car cl-keys-temp) |
| 70 | (list 'quote | 70 | (list 'quote |
| 71 | (mapcar | 71 | (mapcar |
| 72 | (function | 72 | (lambda (x) |
| 73 | (lambda (x) | 73 | (if (consp x) |
| 74 | (if (consp x) | 74 | (car x) x)) |
| 75 | (car x) x))) | ||
| 76 | (append kwords | 75 | (append kwords |
| 77 | other-keys)))) | 76 | other-keys)))) |
| 78 | '(car (cdr (memq (quote :allow-other-keys) | 77 | '(car (cdr (memq (quote :allow-other-keys) |
| @@ -668,9 +667,9 @@ This is a destructive function; it reuses the storage of SEQ if possible. | |||
| 668 | (cl--parsing-keywords (:key) () | 667 | (cl--parsing-keywords (:key) () |
| 669 | (if (memq cl-key '(nil identity)) | 668 | (if (memq cl-key '(nil identity)) |
| 670 | (sort cl-seq cl-pred) | 669 | (sort cl-seq cl-pred) |
| 671 | (sort cl-seq (function (lambda (cl-x cl-y) | 670 | (sort cl-seq (lambda (cl-x cl-y) |
| 672 | (funcall cl-pred (funcall cl-key cl-x) | 671 | (funcall cl-pred (funcall cl-key cl-x) |
| 673 | (funcall cl-key cl-y))))))))) | 672 | (funcall cl-key cl-y)))))))) |
| 674 | 673 | ||
| 675 | ;;;###autoload | 674 | ;;;###autoload |
| 676 | (defun cl-stable-sort (cl-seq cl-pred &rest cl-keys) | 675 | (defun cl-stable-sort (cl-seq cl-pred &rest cl-keys) |
diff --git a/lisp/emacs-lisp/easymenu.el b/lisp/emacs-lisp/easymenu.el index 73dabef3fa5..b0198dbf8d5 100644 --- a/lisp/emacs-lisp/easymenu.el +++ b/lisp/emacs-lisp/easymenu.el | |||
| @@ -514,6 +514,7 @@ completely and menu filter functions can be expected to work. | |||
| 514 | If BEFORE is non-nil, add before the item named BEFORE. | 514 | If BEFORE is non-nil, add before the item named BEFORE. |
| 515 | If IN-MENU is non-nil, follow MENU-PATH in IN-MENU. | 515 | If IN-MENU is non-nil, follow MENU-PATH in IN-MENU. |
| 516 | This is a compatibility function; use `easy-menu-add-item'." | 516 | This is a compatibility function; use `easy-menu-add-item'." |
| 517 | (declare (obsolete easy-menu-add-item "28.1")) | ||
| 517 | (easy-menu-add-item (or in-menu (current-global-map)) | 518 | (easy-menu-add-item (or in-menu (current-global-map)) |
| 518 | (cons "menu-bar" menu-path) | 519 | (cons "menu-bar" menu-path) |
| 519 | submenu before)) | 520 | submenu before)) |
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index e310313940f..f242e922bde 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el | |||
| @@ -309,9 +309,8 @@ A lambda list keyword is a symbol that starts with `&'." | |||
| 309 | (defun edebug-sort-alist (alist function) | 309 | (defun edebug-sort-alist (alist function) |
| 310 | ;; Return the ALIST sorted with comparison function FUNCTION. | 310 | ;; Return the ALIST sorted with comparison function FUNCTION. |
| 311 | ;; This uses 'sort so the sorting is destructive. | 311 | ;; This uses 'sort so the sorting is destructive. |
| 312 | (sort alist (function | 312 | (sort alist (lambda (e1 e2) |
| 313 | (lambda (e1 e2) | 313 | (funcall function (car e1) (car e2))))) |
| 314 | (funcall function (car e1) (car e2)))))) | ||
| 315 | 314 | ||
| 316 | ;; Not used. | 315 | ;; Not used. |
| 317 | '(defmacro edebug-save-restriction (&rest body) | 316 | '(defmacro edebug-save-restriction (&rest body) |
| @@ -407,14 +406,13 @@ Return the result of the last expression in BODY." | |||
| 407 | (if (listp window-info) | 406 | (if (listp window-info) |
| 408 | (mapcar (lambda (one-window-info) | 407 | (mapcar (lambda (one-window-info) |
| 409 | (if one-window-info | 408 | (if one-window-info |
| 410 | (apply (function | 409 | (apply (lambda (window buffer point start hscroll) |
| 411 | (lambda (window buffer point start hscroll) | 410 | (if (edebug-window-live-p window) |
| 412 | (if (edebug-window-live-p window) | 411 | (progn |
| 413 | (progn | 412 | (set-window-buffer window buffer) |
| 414 | (set-window-buffer window buffer) | 413 | (set-window-point window point) |
| 415 | (set-window-point window point) | 414 | (set-window-start window start) |
| 416 | (set-window-start window start) | 415 | (set-window-hscroll window hscroll)))) |
| 417 | (set-window-hscroll window hscroll))))) | ||
| 418 | one-window-info))) | 416 | one-window-info))) |
| 419 | window-info) | 417 | window-info) |
| 420 | (set-window-configuration window-info))) | 418 | (set-window-configuration window-info))) |
diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el index 35590123ee6..124900168c3 100644 --- a/lisp/emacs-lisp/lisp.el +++ b/lisp/emacs-lisp/lisp.el | |||
| @@ -784,9 +784,17 @@ This command assumes point is not in a string or comment." | |||
| 784 | (interactive "P") | 784 | (interactive "P") |
| 785 | (insert-pair arg ?\( ?\))) | 785 | (insert-pair arg ?\( ?\))) |
| 786 | 786 | ||
| 787 | (defcustom delete-pair-blink-delay blink-matching-delay | ||
| 788 | "Time in seconds to delay after showing a paired character to delete. | ||
| 789 | It's used by the command `delete-pair'. The value 0 disables blinking." | ||
| 790 | :type 'number | ||
| 791 | :group 'lisp | ||
| 792 | :version "28.1") | ||
| 793 | |||
| 787 | (defun delete-pair (&optional arg) | 794 | (defun delete-pair (&optional arg) |
| 788 | "Delete a pair of characters enclosing ARG sexps that follow point. | 795 | "Delete a pair of characters enclosing ARG sexps that follow point. |
| 789 | A negative ARG deletes a pair around the preceding ARG sexps instead." | 796 | A negative ARG deletes a pair around the preceding ARG sexps instead. |
| 797 | The option `delete-pair-blink-delay' can disable blinking." | ||
| 790 | (interactive "P") | 798 | (interactive "P") |
| 791 | (if arg | 799 | (if arg |
| 792 | (setq arg (prefix-numeric-value arg)) | 800 | (setq arg (prefix-numeric-value arg)) |
| @@ -802,6 +810,9 @@ A negative ARG deletes a pair around the preceding ARG sexps instead." | |||
| 802 | (if (= (length p) 3) (cdr p) p)) | 810 | (if (= (length p) 3) (cdr p) p)) |
| 803 | insert-pair-alist)) | 811 | insert-pair-alist)) |
| 804 | (error "Not after matching pair")) | 812 | (error "Not after matching pair")) |
| 813 | (when (and (numberp delete-pair-blink-delay) | ||
| 814 | (> delete-pair-blink-delay 0)) | ||
| 815 | (sit-for delete-pair-blink-delay)) | ||
| 805 | (delete-char 1))) | 816 | (delete-char 1))) |
| 806 | (delete-char -1)) | 817 | (delete-char -1)) |
| 807 | (save-excursion | 818 | (save-excursion |
| @@ -814,6 +825,9 @@ A negative ARG deletes a pair around the preceding ARG sexps instead." | |||
| 814 | (if (= (length p) 3) (cdr p) p)) | 825 | (if (= (length p) 3) (cdr p) p)) |
| 815 | insert-pair-alist)) | 826 | insert-pair-alist)) |
| 816 | (error "Not before matching pair")) | 827 | (error "Not before matching pair")) |
| 828 | (when (and (numberp delete-pair-blink-delay) | ||
| 829 | (> delete-pair-blink-delay 0)) | ||
| 830 | (sit-for delete-pair-blink-delay)) | ||
| 817 | (delete-char -1))) | 831 | (delete-char -1))) |
| 818 | (delete-char 1)))) | 832 | (delete-char 1)))) |
| 819 | 833 | ||
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 9264a811ced..0ee2e58d528 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el | |||
| @@ -2129,8 +2129,7 @@ Otherwise return nil." | |||
| 2129 | (when str | 2129 | (when str |
| 2130 | (when (string-match "\\`[ \t]*[$]Revision:[ \t]+" str) | 2130 | (when (string-match "\\`[ \t]*[$]Revision:[ \t]+" str) |
| 2131 | (setq str (substring str (match-end 0)))) | 2131 | (setq str (substring str (match-end 0)))) |
| 2132 | (ignore-errors | 2132 | (if (version-to-list str) str))) |
| 2133 | (if (version-to-list str) str)))) | ||
| 2134 | 2133 | ||
| 2135 | (declare-function lm-homepage "lisp-mnt" (&optional file)) | 2134 | (declare-function lm-homepage "lisp-mnt" (&optional file)) |
| 2136 | 2135 | ||
| @@ -2731,7 +2730,9 @@ either a full name or nil, and EMAIL is a valid email address." | |||
| 2731 | (define-key map "(" #'package-menu-toggle-hiding) | 2730 | (define-key map "(" #'package-menu-toggle-hiding) |
| 2732 | (define-key map (kbd "/ /") 'package-menu-clear-filter) | 2731 | (define-key map (kbd "/ /") 'package-menu-clear-filter) |
| 2733 | (define-key map (kbd "/ a") 'package-menu-filter-by-archive) | 2732 | (define-key map (kbd "/ a") 'package-menu-filter-by-archive) |
| 2733 | (define-key map (kbd "/ d") 'package-menu-filter-by-description) | ||
| 2734 | (define-key map (kbd "/ k") 'package-menu-filter-by-keyword) | 2734 | (define-key map (kbd "/ k") 'package-menu-filter-by-keyword) |
| 2735 | (define-key map (kbd "/ N") 'package-menu-filter-by-name-or-description) | ||
| 2735 | (define-key map (kbd "/ n") 'package-menu-filter-by-name) | 2736 | (define-key map (kbd "/ n") 'package-menu-filter-by-name) |
| 2736 | (define-key map (kbd "/ s") 'package-menu-filter-by-status) | 2737 | (define-key map (kbd "/ s") 'package-menu-filter-by-status) |
| 2737 | (define-key map (kbd "/ v") 'package-menu-filter-by-version) | 2738 | (define-key map (kbd "/ v") 'package-menu-filter-by-version) |
| @@ -2763,8 +2764,11 @@ either a full name or nil, and EMAIL is a valid email address." | |||
| 2763 | "--" | 2764 | "--" |
| 2764 | ("Filter Packages" | 2765 | ("Filter Packages" |
| 2765 | ["Filter by Archive" package-menu-filter-by-archive :help "Filter packages by archive"] | 2766 | ["Filter by Archive" package-menu-filter-by-archive :help "Filter packages by archive"] |
| 2767 | ["Filter by Description" package-menu-filter-by-description :help "Filter packages by description"] | ||
| 2766 | ["Filter by Keyword" package-menu-filter-by-keyword :help "Filter packages by keyword"] | 2768 | ["Filter by Keyword" package-menu-filter-by-keyword :help "Filter packages by keyword"] |
| 2767 | ["Filter by Name" package-menu-filter-by-name :help "Filter packages by name"] | 2769 | ["Filter by Name" package-menu-filter-by-name :help "Filter packages by name"] |
| 2770 | ["Filter by Name or Description" package-menu-filter-by-name-or-description | ||
| 2771 | :help "Filter packages by name or description"] | ||
| 2768 | ["Filter by Status" package-menu-filter-by-status :help "Filter packages by status"] | 2772 | ["Filter by Status" package-menu-filter-by-status :help "Filter packages by status"] |
| 2769 | ["Filter by Version" package-menu-filter-by-version :help "Filter packages by version"] | 2773 | ["Filter by Version" package-menu-filter-by-version :help "Filter packages by version"] |
| 2770 | ["Filter Marked" package-menu-filter-marked :help "Filter packages marked for upgrade"] | 2774 | ["Filter Marked" package-menu-filter-marked :help "Filter packages marked for upgrade"] |
| @@ -3792,6 +3796,23 @@ packages." | |||
| 3792 | (string-join archive ",") | 3796 | (string-join archive ",") |
| 3793 | archive))))) | 3797 | archive))))) |
| 3794 | 3798 | ||
| 3799 | (defun package-menu-filter-by-description (description) | ||
| 3800 | "Filter the \"*Packages*\" buffer by DESCRIPTION regexp. | ||
| 3801 | Display only packages with a description that matches regexp | ||
| 3802 | DESCRIPTION. | ||
| 3803 | |||
| 3804 | When called interactively, prompt for DESCRIPTION. | ||
| 3805 | |||
| 3806 | If DESCRIPTION is nil or the empty string, show all packages." | ||
| 3807 | (interactive (list (read-regexp "Filter by description (regexp)"))) | ||
| 3808 | (package--ensure-package-menu-mode) | ||
| 3809 | (if (or (not description) (string-empty-p description)) | ||
| 3810 | (package-menu--generate t t) | ||
| 3811 | (package-menu--filter-by (lambda (pkg-desc) | ||
| 3812 | (string-match description | ||
| 3813 | (package-desc-summary pkg-desc))) | ||
| 3814 | (format "desc:%s" description)))) | ||
| 3815 | |||
| 3795 | (defun package-menu-filter-by-keyword (keyword) | 3816 | (defun package-menu-filter-by-keyword (keyword) |
| 3796 | "Filter the \"*Packages*\" buffer by KEYWORD. | 3817 | "Filter the \"*Packages*\" buffer by KEYWORD. |
| 3797 | Display only packages with specified KEYWORD. | 3818 | Display only packages with specified KEYWORD. |
| @@ -3817,6 +3838,27 @@ packages." | |||
| 3817 | (define-obsolete-function-alias | 3838 | (define-obsolete-function-alias |
| 3818 | 'package-menu-filter #'package-menu-filter-by-keyword "27.1") | 3839 | 'package-menu-filter #'package-menu-filter-by-keyword "27.1") |
| 3819 | 3840 | ||
| 3841 | (defun package-menu-filter-by-name-or-description (name-or-description) | ||
| 3842 | "Filter the \"*Packages*\" buffer by NAME-OR-DESCRIPTION regexp. | ||
| 3843 | Display only packages with a name-or-description that matches regexp | ||
| 3844 | NAME-OR-DESCRIPTION. | ||
| 3845 | |||
| 3846 | When called interactively, prompt for NAME-OR-DESCRIPTION. | ||
| 3847 | |||
| 3848 | If NAME-OR-DESCRIPTION is nil or the empty string, show all | ||
| 3849 | packages." | ||
| 3850 | (interactive (list (read-regexp "Filter by name or description (regexp)"))) | ||
| 3851 | (package--ensure-package-menu-mode) | ||
| 3852 | (if (or (not name-or-description) (string-empty-p name-or-description)) | ||
| 3853 | (package-menu--generate t t) | ||
| 3854 | (package-menu--filter-by (lambda (pkg-desc) | ||
| 3855 | (or (string-match name-or-description | ||
| 3856 | (package-desc-summary pkg-desc)) | ||
| 3857 | (string-match name-or-description | ||
| 3858 | (symbol-name | ||
| 3859 | (package-desc-name pkg-desc))))) | ||
| 3860 | (format "name-or-desc:%s" name-or-description)))) | ||
| 3861 | |||
| 3820 | (defun package-menu-filter-by-name (name) | 3862 | (defun package-menu-filter-by-name (name) |
| 3821 | "Filter the \"*Packages*\" buffer by NAME regexp. | 3863 | "Filter the \"*Packages*\" buffer by NAME regexp. |
| 3822 | Display only packages with name that matches regexp NAME. | 3864 | Display only packages with name that matches regexp NAME. |
diff --git a/lisp/emacs-lisp/pp.el b/lisp/emacs-lisp/pp.el index eb2ee94be3b..458f803ffe3 100644 --- a/lisp/emacs-lisp/pp.el +++ b/lisp/emacs-lisp/pp.el | |||
| @@ -94,27 +94,25 @@ after OUT-BUFFER-NAME." | |||
| 94 | ;; This function either decides not to display it at all | 94 | ;; This function either decides not to display it at all |
| 95 | ;; or displays it in the usual way. | 95 | ;; or displays it in the usual way. |
| 96 | (temp-buffer-show-function | 96 | (temp-buffer-show-function |
| 97 | (function | 97 | (lambda (buf) |
| 98 | (lambda (buf) | 98 | (with-current-buffer buf |
| 99 | (with-current-buffer buf | 99 | (goto-char (point-min)) |
| 100 | (goto-char (point-min)) | 100 | (end-of-line 1) |
| 101 | (end-of-line 1) | 101 | (if (or (< (1+ (point)) (point-max)) |
| 102 | (if (or (< (1+ (point)) (point-max)) | 102 | (>= (- (point) (point-min)) (frame-width))) |
| 103 | (>= (- (point) (point-min)) (frame-width))) | 103 | (let ((temp-buffer-show-function old-show-function) |
| 104 | (let ((temp-buffer-show-function old-show-function) | 104 | (old-selected (selected-window)) |
| 105 | (old-selected (selected-window)) | 105 | (window (display-buffer buf))) |
| 106 | (window (display-buffer buf))) | 106 | (goto-char (point-min)) ; expected by some hooks ... |
| 107 | (goto-char (point-min)) ; expected by some hooks ... | 107 | (make-frame-visible (window-frame window)) |
| 108 | (make-frame-visible (window-frame window)) | 108 | (unwind-protect |
| 109 | (unwind-protect | 109 | (progn |
| 110 | (progn | 110 | (select-window window) |
| 111 | (select-window window) | 111 | (run-hooks 'temp-buffer-show-hook)) |
| 112 | (run-hooks 'temp-buffer-show-hook)) | 112 | (when (window-live-p old-selected) |
| 113 | (when (window-live-p old-selected) | 113 | (select-window old-selected)) |
| 114 | (select-window old-selected)) | 114 | (message "See buffer %s." out-buffer-name))) |
| 115 | (message "See buffer %s." out-buffer-name))) | 115 | (message "%s" (buffer-substring (point-min) (point)))))))) |
| 116 | (message "%s" (buffer-substring (point-min) (point))) | ||
| 117 | )))))) | ||
| 118 | (with-output-to-temp-buffer out-buffer-name | 116 | (with-output-to-temp-buffer out-buffer-name |
| 119 | (pp expression) | 117 | (pp expression) |
| 120 | (with-current-buffer standard-output | 118 | (with-current-buffer standard-output |
diff --git a/lisp/emacs-lisp/regi.el b/lisp/emacs-lisp/regi.el index 11b28b72cf3..2e6e2b75d6a 100644 --- a/lisp/emacs-lisp/regi.el +++ b/lisp/emacs-lisp/regi.el | |||
| @@ -163,18 +163,15 @@ useful information: | |||
| 163 | ;; let's find the special tags and remove them from the working | 163 | ;; let's find the special tags and remove them from the working |
| 164 | ;; frame. note that only the last special tag is used. | 164 | ;; frame. note that only the last special tag is used. |
| 165 | (mapc | 165 | (mapc |
| 166 | (function | 166 | (lambda (entry) |
| 167 | (lambda (entry) | 167 | (let ((pred (car entry)) |
| 168 | (let ((pred (car entry)) | 168 | (func (car (cdr entry)))) |
| 169 | (func (car (cdr entry)))) | 169 | (cond |
| 170 | (cond | 170 | ((eq pred 'begin) (setq begin-tag func)) |
| 171 | ((eq pred 'begin) (setq begin-tag func)) | 171 | ((eq pred 'end) (setq end-tag func)) |
| 172 | ((eq pred 'end) (setq end-tag func)) | 172 | ((eq pred 'every) (setq every-tag func)) |
| 173 | ((eq pred 'every) (setq every-tag func)) | 173 | (t |
| 174 | (t | 174 | (setq working-frame (append working-frame (list entry))))))) |
| 175 | (setq working-frame (append working-frame (list entry)))) | ||
| 176 | ) ; end-cond | ||
| 177 | ))) | ||
| 178 | frame) ; end-mapcar | 175 | frame) ; end-mapcar |
| 179 | 176 | ||
| 180 | ;; execute the begin entry | 177 | ;; execute the begin entry |
diff --git a/lisp/emulation/edt.el b/lisp/emulation/edt.el index e70b44658d5..b29ad7702ef 100644 --- a/lisp/emulation/edt.el +++ b/lisp/emulation/edt.el | |||
| @@ -2161,8 +2161,7 @@ Argument KEY is the name of a key. It can be a standard key or a function key. | |||
| 2161 | Argument BINDING is the Emacs function to be bound to <KEY>." | 2161 | Argument BINDING is the Emacs function to be bound to <KEY>." |
| 2162 | (define-key edt-user-global-map key binding)) | 2162 | (define-key edt-user-global-map key binding)) |
| 2163 | 2163 | ||
| 2164 | ;; For backward compatibility to existing edt-user.el files. | 2164 | (define-obsolete-function-alias 'edt-bind-standard-key #'edt-bind-key "28.1") |
| 2165 | (fset 'edt-bind-standard-key (symbol-function 'edt-bind-key)) | ||
| 2166 | 2165 | ||
| 2167 | (defun edt-bind-gold-key (key gold-binding) | 2166 | (defun edt-bind-gold-key (key gold-binding) |
| 2168 | "Binds <GOLD> standard key sequences to custom bindings in the EDT Emulator. | 2167 | "Binds <GOLD> standard key sequences to custom bindings in the EDT Emulator. |
diff --git a/lisp/emulation/viper-util.el b/lisp/emulation/viper-util.el index 83e45e1cd0c..9da493d74ba 100644 --- a/lisp/emulation/viper-util.el +++ b/lisp/emulation/viper-util.el | |||
| @@ -249,15 +249,7 @@ Otherwise return the normal value." | |||
| 249 | (goto-char cur-pos) | 249 | (goto-char cur-pos) |
| 250 | result)) | 250 | result)) |
| 251 | 251 | ||
| 252 | ;; Emacs used to count each multibyte character as several positions in the buffer, | ||
| 253 | ;; so we had to use Emacs's chars-in-region to count characters. Since 20.3, | ||
| 254 | ;; Emacs counts multibyte characters as 1 position. XEmacs has always been | ||
| 255 | ;; counting each char as just one pos. So, now we can simply subtract beg from | ||
| 256 | ;; end to determine the number of characters in a region. | ||
| 257 | (defun viper-chars-in-region (beg end &optional preserve-sign) | 252 | (defun viper-chars-in-region (beg end &optional preserve-sign) |
| 258 | ;;(let ((count (abs (if (fboundp 'chars-in-region) | ||
| 259 | ;; (chars-in-region beg end) | ||
| 260 | ;; (- end beg))))) | ||
| 261 | (let ((count (abs (- end beg)))) | 253 | (let ((count (abs (- end beg)))) |
| 262 | (if (and (< end beg) preserve-sign) | 254 | (if (and (< end beg) preserve-sign) |
| 263 | (- count) | 255 | (- count) |
diff --git a/lisp/epa.el b/lisp/epa.el index 25e055c201f..d6c7946c939 100644 --- a/lisp/epa.el +++ b/lisp/epa.el | |||
| @@ -24,7 +24,6 @@ | |||
| 24 | ;;; Dependencies | 24 | ;;; Dependencies |
| 25 | 25 | ||
| 26 | (require 'epg) | 26 | (require 'epg) |
| 27 | (require 'font-lock) | ||
| 28 | (eval-when-compile (require 'subr-x)) | 27 | (eval-when-compile (require 'subr-x)) |
| 29 | (require 'derived) | 28 | (require 'derived) |
| 30 | 29 | ||
| @@ -1071,9 +1070,7 @@ If no one is selected, default secret key is used. " | |||
| 1071 | (list 'epa-coding-system-used | 1070 | (list 'epa-coding-system-used |
| 1072 | epa-last-coding-system-specified | 1071 | epa-last-coding-system-specified |
| 1073 | 'front-sticky nil | 1072 | 'front-sticky nil |
| 1074 | 'rear-nonsticky t | 1073 | 'rear-nonsticky t))))) |
| 1075 | 'start-open t | ||
| 1076 | 'end-open t))))) | ||
| 1077 | 1074 | ||
| 1078 | (define-obsolete-function-alias 'epa--derived-mode-p 'derived-mode-p "28.1") | 1075 | (define-obsolete-function-alias 'epa--derived-mode-p 'derived-mode-p "28.1") |
| 1079 | 1076 | ||
| @@ -1148,9 +1145,7 @@ If no one is selected, symmetric encryption will be performed. ") | |||
| 1148 | (list 'epa-coding-system-used | 1145 | (list 'epa-coding-system-used |
| 1149 | epa-last-coding-system-specified | 1146 | epa-last-coding-system-specified |
| 1150 | 'front-sticky nil | 1147 | 'front-sticky nil |
| 1151 | 'rear-nonsticky t | 1148 | 'rear-nonsticky t))))) |
| 1152 | 'start-open t | ||
| 1153 | 'end-open t))))) | ||
| 1154 | 1149 | ||
| 1155 | ;;;; Key Management | 1150 | ;;;; Key Management |
| 1156 | 1151 | ||
diff --git a/lisp/erc/erc-log.el b/lisp/erc/erc-log.el index de0a16ea3f0..7eddb5f60f1 100644 --- a/lisp/erc/erc-log.el +++ b/lisp/erc/erc-log.el | |||
| @@ -414,8 +414,7 @@ You can save every individual message by putting this function on | |||
| 414 | (or buffer (setq buffer (current-buffer))) | 414 | (or buffer (setq buffer (current-buffer))) |
| 415 | (when (erc-logging-enabled buffer) | 415 | (when (erc-logging-enabled buffer) |
| 416 | (let ((file (erc-current-logfile buffer)) | 416 | (let ((file (erc-current-logfile buffer)) |
| 417 | (coding-system erc-log-file-coding-system) | 417 | (coding-system erc-log-file-coding-system)) |
| 418 | (inhibit-clash-detection t)) ; needed for XEmacs | ||
| 419 | (save-excursion | 418 | (save-excursion |
| 420 | (with-current-buffer buffer | 419 | (with-current-buffer buffer |
| 421 | (save-restriction | 420 | (save-restriction |
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index e35ae0cfd87..94ea0de7ee7 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el | |||
| @@ -58,7 +58,6 @@ | |||
| 58 | (load "erc-loaddefs" nil t) | 58 | (load "erc-loaddefs" nil t) |
| 59 | 59 | ||
| 60 | (require 'cl-lib) | 60 | (require 'cl-lib) |
| 61 | (require 'font-lock) | ||
| 62 | (require 'format-spec) | 61 | (require 'format-spec) |
| 63 | (require 'pp) | 62 | (require 'pp) |
| 64 | (require 'thingatpt) | 63 | (require 'thingatpt) |
| @@ -4015,8 +4014,7 @@ If FACE is non-nil, it will be used to propertize the prompt. If it is nil, | |||
| 4015 | ;; of the prompt, but stuff typed in front of the prompt | 4014 | ;; of the prompt, but stuff typed in front of the prompt |
| 4016 | ;; shall remain part of the prompt. | 4015 | ;; shall remain part of the prompt. |
| 4017 | (setq prompt (propertize prompt | 4016 | (setq prompt (propertize prompt |
| 4018 | 'start-open t ; XEmacs | 4017 | 'rear-nonsticky t |
| 4019 | 'rear-nonsticky t ; Emacs | ||
| 4020 | 'erc-prompt t | 4018 | 'erc-prompt t |
| 4021 | 'field t | 4019 | 'field t |
| 4022 | 'front-sticky t | 4020 | 'front-sticky t |
diff --git a/lisp/eshell/em-basic.el b/lisp/eshell/em-basic.el index 6cfc89cce62..e54eab50fc9 100644 --- a/lisp/eshell/em-basic.el +++ b/lisp/eshell/em-basic.el | |||
| @@ -90,11 +90,10 @@ or `eshell-printn' for display." | |||
| 90 | (car args)) | 90 | (car args)) |
| 91 | (t | 91 | (t |
| 92 | (mapcar | 92 | (mapcar |
| 93 | (function | 93 | (lambda (arg) |
| 94 | (lambda (arg) | 94 | (if (stringp arg) |
| 95 | (if (stringp arg) | 95 | (set-text-properties 0 (length arg) nil arg)) |
| 96 | (set-text-properties 0 (length arg) nil arg)) | 96 | arg) |
| 97 | arg)) | ||
| 98 | args))))) | 97 | args))))) |
| 99 | (if output-newline | 98 | (if output-newline |
| 100 | (cond | 99 | (cond |
diff --git a/lisp/eshell/em-cmpl.el b/lisp/eshell/em-cmpl.el index 8a444c91001..53a0cda354e 100644 --- a/lisp/eshell/em-cmpl.el +++ b/lisp/eshell/em-cmpl.el | |||
| @@ -210,9 +210,8 @@ to writing a completion function." | |||
| 210 | :group 'eshell-cmpl) | 210 | :group 'eshell-cmpl) |
| 211 | 211 | ||
| 212 | (defcustom eshell-command-completion-function | 212 | (defcustom eshell-command-completion-function |
| 213 | (function | 213 | (lambda () |
| 214 | (lambda () | 214 | (pcomplete-here (eshell-complete-commands-list))) |
| 215 | (pcomplete-here (eshell-complete-commands-list)))) | ||
| 216 | (eshell-cmpl--custom-variable-docstring 'pcomplete-command-completion-function) | 215 | (eshell-cmpl--custom-variable-docstring 'pcomplete-command-completion-function) |
| 217 | :type (get 'pcomplete-command-completion-function 'custom-type) | 216 | :type (get 'pcomplete-command-completion-function 'custom-type) |
| 218 | :group 'eshell-cmpl) | 217 | :group 'eshell-cmpl) |
| @@ -224,12 +223,11 @@ to writing a completion function." | |||
| 224 | :group 'eshell-cmpl) | 223 | :group 'eshell-cmpl) |
| 225 | 224 | ||
| 226 | (defcustom eshell-default-completion-function | 225 | (defcustom eshell-default-completion-function |
| 227 | (function | 226 | (lambda () |
| 228 | (lambda () | 227 | (while (pcomplete-here |
| 229 | (while (pcomplete-here | 228 | (pcomplete-dirs-or-entries |
| 230 | (pcomplete-dirs-or-entries | 229 | (cdr (assoc (funcall eshell-cmpl-command-name-function) |
| 231 | (cdr (assoc (funcall eshell-cmpl-command-name-function) | 230 | eshell-command-completions-alist)))))) |
| 232 | eshell-command-completions-alist))))))) | ||
| 233 | (eshell-cmpl--custom-variable-docstring 'pcomplete-default-completion-function) | 231 | (eshell-cmpl--custom-variable-docstring 'pcomplete-default-completion-function) |
| 234 | :type (get 'pcomplete-default-completion-function 'custom-type) | 232 | :type (get 'pcomplete-default-completion-function 'custom-type) |
| 235 | :group 'eshell-cmpl) | 233 | :group 'eshell-cmpl) |
| @@ -308,10 +306,9 @@ to writing a completion function." | |||
| 308 | ;; load-hooks for any other extension modules have been run, which | 306 | ;; load-hooks for any other extension modules have been run, which |
| 309 | ;; is true at the time `eshell-mode-hook' is run | 307 | ;; is true at the time `eshell-mode-hook' is run |
| 310 | (add-hook 'eshell-mode-hook | 308 | (add-hook 'eshell-mode-hook |
| 311 | (function | 309 | (lambda () |
| 312 | (lambda () | 310 | (set (make-local-variable 'comint-file-name-quote-list) |
| 313 | (set (make-local-variable 'comint-file-name-quote-list) | 311 | eshell-special-chars-outside-quoting)) |
| 314 | eshell-special-chars-outside-quoting))) | ||
| 315 | nil t) | 312 | nil t) |
| 316 | (add-hook 'pcomplete-quote-arg-hook #'eshell-quote-backslash nil t) | 313 | (add-hook 'pcomplete-quote-arg-hook #'eshell-quote-backslash nil t) |
| 317 | (add-hook 'completion-at-point-functions | 314 | (add-hook 'completion-at-point-functions |
| @@ -391,19 +388,18 @@ to writing a completion function." | |||
| 391 | (nconc args (list "")) | 388 | (nconc args (list "")) |
| 392 | (nconc posns (list (point)))) | 389 | (nconc posns (list (point)))) |
| 393 | (cons (mapcar | 390 | (cons (mapcar |
| 394 | (function | 391 | (lambda (arg) |
| 395 | (lambda (arg) | 392 | (let ((val |
| 396 | (let ((val | 393 | (if (listp arg) |
| 397 | (if (listp arg) | 394 | (let ((result |
| 398 | (let ((result | 395 | (eshell-do-eval |
| 399 | (eshell-do-eval | 396 | (list 'eshell-commands arg) t))) |
| 400 | (list 'eshell-commands arg) t))) | 397 | (cl-assert (eq (car result) 'quote)) |
| 401 | (cl-assert (eq (car result) 'quote)) | 398 | (cadr result)) |
| 402 | (cadr result)) | 399 | arg))) |
| 403 | arg))) | 400 | (if (numberp val) |
| 404 | (if (numberp val) | 401 | (setq val (number-to-string val))) |
| 405 | (setq val (number-to-string val))) | 402 | (or val ""))) |
| 406 | (or val "")))) | ||
| 407 | args) | 403 | args) |
| 408 | posns))) | 404 | posns))) |
| 409 | 405 | ||
| @@ -454,9 +450,8 @@ to writing a completion function." | |||
| 454 | (eshell-alias-completions filename)) | 450 | (eshell-alias-completions filename)) |
| 455 | (eshell-winnow-list | 451 | (eshell-winnow-list |
| 456 | (mapcar | 452 | (mapcar |
| 457 | (function | 453 | (lambda (name) |
| 458 | (lambda (name) | 454 | (substring name 7)) |
| 459 | (substring name 7))) | ||
| 460 | (all-completions (concat "eshell/" filename) | 455 | (all-completions (concat "eshell/" filename) |
| 461 | obarray #'functionp)) | 456 | obarray #'functionp)) |
| 462 | nil '(eshell-find-alias-function)) | 457 | nil '(eshell-find-alias-function)) |
diff --git a/lisp/eshell/em-dirs.el b/lisp/eshell/em-dirs.el index 51df6fa1d52..b4ed3794add 100644 --- a/lisp/eshell/em-dirs.el +++ b/lisp/eshell/em-dirs.el | |||
| @@ -289,9 +289,8 @@ Thus, this does not include the current directory.") | |||
| 289 | (eshell-read-user-names) | 289 | (eshell-read-user-names) |
| 290 | (pcomplete-uniquify-list | 290 | (pcomplete-uniquify-list |
| 291 | (mapcar | 291 | (mapcar |
| 292 | (function | 292 | (lambda (user) |
| 293 | (lambda (user) | 293 | (file-name-as-directory (cdr user))) |
| 294 | (file-name-as-directory (cdr user)))) | ||
| 295 | eshell-user-names))))))) | 294 | eshell-user-names))))))) |
| 296 | 295 | ||
| 297 | (defun eshell/pwd (&rest _args) | 296 | (defun eshell/pwd (&rest _args) |
diff --git a/lisp/eshell/em-hist.el b/lisp/eshell/em-hist.el index bdc21c916c6..c27e4503767 100644 --- a/lisp/eshell/em-hist.el +++ b/lisp/eshell/em-hist.el | |||
| @@ -79,9 +79,8 @@ | |||
| 79 | 79 | ||
| 80 | (defcustom eshell-hist-unload-hook | 80 | (defcustom eshell-hist-unload-hook |
| 81 | (list | 81 | (list |
| 82 | (function | 82 | (lambda () |
| 83 | (lambda () | 83 | (remove-hook 'kill-emacs-hook 'eshell-save-some-history))) |
| 84 | (remove-hook 'kill-emacs-hook 'eshell-save-some-history)))) | ||
| 85 | "A hook that gets run when `eshell-hist' is unloaded." | 84 | "A hook that gets run when `eshell-hist' is unloaded." |
| 86 | :type 'hook) | 85 | :type 'hook) |
| 87 | 86 | ||
| @@ -250,16 +249,14 @@ Returns nil if INPUT is prepended by blank space, otherwise non-nil." | |||
| 250 | (set (make-local-variable 'search-invisible) t) | 249 | (set (make-local-variable 'search-invisible) t) |
| 251 | (set (make-local-variable 'search-exit-option) t) | 250 | (set (make-local-variable 'search-exit-option) t) |
| 252 | (add-hook 'isearch-mode-hook | 251 | (add-hook 'isearch-mode-hook |
| 253 | (function | 252 | (lambda () |
| 254 | (lambda () | 253 | (if (>= (point) eshell-last-output-end) |
| 255 | (if (>= (point) eshell-last-output-end) | 254 | (setq overriding-terminal-local-map |
| 256 | (setq overriding-terminal-local-map | 255 | eshell-isearch-map))) |
| 257 | eshell-isearch-map)))) | ||
| 258 | nil t) | 256 | nil t) |
| 259 | (add-hook 'isearch-mode-end-hook | 257 | (add-hook 'isearch-mode-end-hook |
| 260 | (function | 258 | (lambda () |
| 261 | (lambda () | 259 | (setq overriding-terminal-local-map nil)) |
| 262 | (setq overriding-terminal-local-map nil))) | ||
| 263 | nil t)) | 260 | nil t)) |
| 264 | (eshell-hist-mode)) | 261 | (eshell-hist-mode)) |
| 265 | 262 | ||
diff --git a/lisp/eshell/em-ls.el b/lisp/eshell/em-ls.el index c1a022ee521..6b306f77874 100644 --- a/lisp/eshell/em-ls.el +++ b/lisp/eshell/em-ls.el | |||
| @@ -270,8 +270,7 @@ instead." | |||
| 270 | eshell-current-subjob-p | 270 | eshell-current-subjob-p |
| 271 | font-lock-mode) | 271 | font-lock-mode) |
| 272 | ;; use the fancy highlighting in `eshell-ls' rather than font-lock | 272 | ;; use the fancy highlighting in `eshell-ls' rather than font-lock |
| 273 | (when (and eshell-ls-use-colors | 273 | (when eshell-ls-use-colors |
| 274 | (featurep 'font-lock)) | ||
| 275 | (font-lock-mode -1) | 274 | (font-lock-mode -1) |
| 276 | (setq font-lock-defaults nil) | 275 | (setq font-lock-defaults nil) |
| 277 | (if (boundp 'font-lock-buffers) | 276 | (if (boundp 'font-lock-buffers) |
| @@ -631,38 +630,37 @@ In Eshell's implementation of ls, ENTRIES is always reversed." | |||
| 631 | (if (eq sort-method 'unsorted) | 630 | (if (eq sort-method 'unsorted) |
| 632 | (nreverse entries) | 631 | (nreverse entries) |
| 633 | (sort entries | 632 | (sort entries |
| 634 | (function | 633 | (lambda (l r) |
| 635 | (lambda (l r) | 634 | (let ((result |
| 636 | (let ((result | 635 | (cond |
| 637 | (cond | 636 | ((eq sort-method 'by-atime) |
| 638 | ((eq sort-method 'by-atime) | 637 | (eshell-ls-compare-entries l r 4 'time-less-p)) |
| 639 | (eshell-ls-compare-entries l r 4 'time-less-p)) | 638 | ((eq sort-method 'by-mtime) |
| 640 | ((eq sort-method 'by-mtime) | 639 | (eshell-ls-compare-entries l r 5 'time-less-p)) |
| 641 | (eshell-ls-compare-entries l r 5 'time-less-p)) | 640 | ((eq sort-method 'by-ctime) |
| 642 | ((eq sort-method 'by-ctime) | 641 | (eshell-ls-compare-entries l r 6 'time-less-p)) |
| 643 | (eshell-ls-compare-entries l r 6 'time-less-p)) | 642 | ((eq sort-method 'by-size) |
| 644 | ((eq sort-method 'by-size) | 643 | (eshell-ls-compare-entries l r 7 '<)) |
| 645 | (eshell-ls-compare-entries l r 7 '<)) | 644 | ((eq sort-method 'by-extension) |
| 646 | ((eq sort-method 'by-extension) | 645 | (let ((lx (file-name-extension |
| 647 | (let ((lx (file-name-extension | 646 | (directory-file-name (car l)))) |
| 648 | (directory-file-name (car l)))) | 647 | (rx (file-name-extension |
| 649 | (rx (file-name-extension | 648 | (directory-file-name (car r))))) |
| 650 | (directory-file-name (car r))))) | 649 | (cond |
| 651 | (cond | 650 | ((or (and (not lx) (not rx)) |
| 652 | ((or (and (not lx) (not rx)) | 651 | (equal lx rx)) |
| 653 | (equal lx rx)) | 652 | (string-lessp (directory-file-name (car l)) |
| 654 | (string-lessp (directory-file-name (car l)) | 653 | (directory-file-name (car r)))) |
| 655 | (directory-file-name (car r)))) | 654 | ((not lx) t) |
| 656 | ((not lx) t) | 655 | ((not rx) nil) |
| 657 | ((not rx) nil) | 656 | (t |
| 658 | (t | 657 | (string-lessp lx rx))))) |
| 659 | (string-lessp lx rx))))) | 658 | (t |
| 660 | (t | 659 | (string-lessp (directory-file-name (car l)) |
| 661 | (string-lessp (directory-file-name (car l)) | 660 | (directory-file-name (car r))))))) |
| 662 | (directory-file-name (car r))))))) | 661 | (if reverse-list |
| 663 | (if reverse-list | 662 | (not result) |
| 664 | (not result) | 663 | result)))))) |
| 665 | result))))))) | ||
| 666 | 664 | ||
| 667 | (defun eshell-ls-files (files &optional size-width copy-fileinfo) | 665 | (defun eshell-ls-files (files &optional size-width copy-fileinfo) |
| 668 | "Output a list of FILES. | 666 | "Output a list of FILES. |
| @@ -799,9 +797,8 @@ to use, and each member of which is the width of that column | |||
| 799 | (width 0) | 797 | (width 0) |
| 800 | (widths | 798 | (widths |
| 801 | (mapcar | 799 | (mapcar |
| 802 | (function | 800 | (lambda (file) |
| 803 | (lambda (file) | 801 | (+ 2 (length (car file)))) |
| 804 | (+ 2 (length (car file))))) | ||
| 805 | files)) | 802 | files)) |
| 806 | ;; must account for the added space... | 803 | ;; must account for the added space... |
| 807 | (max-width (+ (window-width) 2)) | 804 | (max-width (+ (window-width) 2)) |
| @@ -846,9 +843,8 @@ to use, and each member of which is the width of that column | |||
| 846 | (width 0) | 843 | (width 0) |
| 847 | (widths | 844 | (widths |
| 848 | (mapcar | 845 | (mapcar |
| 849 | (function | 846 | (lambda (file) |
| 850 | (lambda (file) | 847 | (+ 2 (length (car file)))) |
| 851 | (+ 2 (length (car file))))) | ||
| 852 | files)) | 848 | files)) |
| 853 | (max-width (+ (window-width) 2)) | 849 | (max-width (+ (window-width) 2)) |
| 854 | col-widths | 850 | col-widths |
diff --git a/lisp/eshell/em-pred.el b/lisp/eshell/em-pred.el index 59139da10db..7b9503917c4 100644 --- a/lisp/eshell/em-pred.el +++ b/lisp/eshell/em-pred.el | |||
| @@ -116,10 +116,9 @@ The format of each entry is | |||
| 116 | (defcustom eshell-modifier-alist | 116 | (defcustom eshell-modifier-alist |
| 117 | '((?E . #'(lambda (lst) | 117 | '((?E . #'(lambda (lst) |
| 118 | (mapcar | 118 | (mapcar |
| 119 | (function | 119 | (lambda (str) |
| 120 | (lambda (str) | 120 | (eshell-stringify |
| 121 | (eshell-stringify | 121 | (car (eshell-parse-argument str)))) |
| 122 | (car (eshell-parse-argument str))))) | ||
| 123 | lst))) | 122 | lst))) |
| 124 | (?L . #'(lambda (lst) (mapcar 'downcase lst))) | 123 | (?L . #'(lambda (lst) (mapcar 'downcase lst))) |
| 125 | (?U . #'(lambda (lst) (mapcar 'upcase lst))) | 124 | (?U . #'(lambda (lst) (mapcar 'upcase lst))) |
| @@ -240,16 +239,14 @@ EXAMPLES: | |||
| 240 | (defun eshell-display-predicate-help () | 239 | (defun eshell-display-predicate-help () |
| 241 | (interactive) | 240 | (interactive) |
| 242 | (with-electric-help | 241 | (with-electric-help |
| 243 | (function | 242 | (lambda () |
| 244 | (lambda () | 243 | (insert eshell-predicate-help-string)))) |
| 245 | (insert eshell-predicate-help-string))))) | ||
| 246 | 244 | ||
| 247 | (defun eshell-display-modifier-help () | 245 | (defun eshell-display-modifier-help () |
| 248 | (interactive) | 246 | (interactive) |
| 249 | (with-electric-help | 247 | (with-electric-help |
| 250 | (function | 248 | (lambda () |
| 251 | (lambda () | 249 | (insert eshell-modifier-help-string)))) |
| 252 | (insert eshell-modifier-help-string))))) | ||
| 253 | 250 | ||
| 254 | (define-minor-mode eshell-pred-mode | 251 | (define-minor-mode eshell-pred-mode |
| 255 | "Minor mode for the eshell-pred module. | 252 | "Minor mode for the eshell-pred module. |
| @@ -544,20 +541,20 @@ that `ls -l' will show in the first column of its display." | |||
| 544 | (if repeat | 541 | (if repeat |
| 545 | `(lambda (lst) | 542 | `(lambda (lst) |
| 546 | (mapcar | 543 | (mapcar |
| 547 | (function | 544 | (lambda (str) |
| 548 | (lambda (str) | 545 | (let ((i 0)) |
| 549 | (let ((i 0)) | 546 | (while (setq i (string-match ,match str i)) |
| 550 | (while (setq i (string-match ,match str i)) | 547 | (setq str (replace-match ,replace t nil str)))) |
| 551 | (setq str (replace-match ,replace t nil str)))) | 548 | str) |
| 552 | str)) lst)) | 549 | lst)) |
| 553 | `(lambda (lst) | 550 | `(lambda (lst) |
| 554 | (mapcar | 551 | (mapcar |
| 555 | (function | 552 | (lambda (str) |
| 556 | (lambda (str) | 553 | (if (string-match ,match str) |
| 557 | (if (string-match ,match str) | 554 | (setq str (replace-match ,replace t nil str)) |
| 558 | (setq str (replace-match ,replace t nil str)) | 555 | (error (concat str ": substitution failed"))) |
| 559 | (error (concat str ": substitution failed"))) | 556 | str) |
| 560 | str)) lst))))) | 557 | lst))))) |
| 561 | 558 | ||
| 562 | (defun eshell-include-members (&optional invert-p) | 559 | (defun eshell-include-members (&optional invert-p) |
| 563 | "Include only lisp members matching a regexp." | 560 | "Include only lisp members matching a regexp." |
| @@ -598,9 +595,8 @@ that `ls -l' will show in the first column of its display." | |||
| 598 | (goto-char (1+ end))) | 595 | (goto-char (1+ end))) |
| 599 | `(lambda (lst) | 596 | `(lambda (lst) |
| 600 | (mapcar | 597 | (mapcar |
| 601 | (function | 598 | (lambda (str) |
| 602 | (lambda (str) | 599 | (split-string str ,sep)) lst)))) |
| 603 | (split-string str ,sep))) lst)))) | ||
| 604 | 600 | ||
| 605 | (provide 'em-pred) | 601 | (provide 'em-pred) |
| 606 | 602 | ||
diff --git a/lisp/eshell/em-prompt.el b/lisp/eshell/em-prompt.el index 9ae5ae12816..dcee1e7a981 100644 --- a/lisp/eshell/em-prompt.el +++ b/lisp/eshell/em-prompt.el | |||
| @@ -48,10 +48,9 @@ as is common with most shells." | |||
| 48 | (autoload 'eshell/pwd "em-dirs") | 48 | (autoload 'eshell/pwd "em-dirs") |
| 49 | 49 | ||
| 50 | (defcustom eshell-prompt-function | 50 | (defcustom eshell-prompt-function |
| 51 | (function | 51 | (lambda () |
| 52 | (lambda () | 52 | (concat (abbreviate-file-name (eshell/pwd)) |
| 53 | (concat (abbreviate-file-name (eshell/pwd)) | 53 | (if (= (user-uid) 0) " # " " $ "))) |
| 54 | (if (= (user-uid) 0) " # " " $ ")))) | ||
| 55 | "A function that returns the Eshell prompt string. | 54 | "A function that returns the Eshell prompt string. |
| 56 | Make sure to update `eshell-prompt-regexp' so that it will match your | 55 | Make sure to update `eshell-prompt-regexp' so that it will match your |
| 57 | prompt." | 56 | prompt." |
diff --git a/lisp/eshell/em-smart.el b/lisp/eshell/em-smart.el index f173c8db9c1..a28bb1d6415 100644 --- a/lisp/eshell/em-smart.el +++ b/lisp/eshell/em-smart.el | |||
| @@ -94,10 +94,9 @@ it to get a real sense of how it works." | |||
| 94 | 94 | ||
| 95 | (defcustom eshell-smart-unload-hook | 95 | (defcustom eshell-smart-unload-hook |
| 96 | (list | 96 | (list |
| 97 | (function | 97 | (lambda () |
| 98 | (lambda () | 98 | (remove-hook 'window-configuration-change-hook |
| 99 | (remove-hook 'window-configuration-change-hook | 99 | 'eshell-refresh-windows))) |
| 100 | 'eshell-refresh-windows)))) | ||
| 101 | "A hook that gets run when `eshell-smart' is unloaded." | 100 | "A hook that gets run when `eshell-smart' is unloaded." |
| 102 | :type 'hook | 101 | :type 'hook |
| 103 | :group 'eshell-smart) | 102 | :group 'eshell-smart) |
| @@ -186,9 +185,8 @@ The options are `begin', `after' or `end'." | |||
| 186 | 185 | ||
| 187 | (make-local-variable 'eshell-smart-command-done) | 186 | (make-local-variable 'eshell-smart-command-done) |
| 188 | (add-hook 'eshell-post-command-hook | 187 | (add-hook 'eshell-post-command-hook |
| 189 | (function | 188 | (lambda () |
| 190 | (lambda () | 189 | (setq eshell-smart-command-done t)) |
| 191 | (setq eshell-smart-command-done t))) | ||
| 192 | t t) | 190 | t t) |
| 193 | 191 | ||
| 194 | (unless (eq eshell-review-quick-commands t) | 192 | (unless (eq eshell-review-quick-commands t) |
| @@ -208,13 +206,12 @@ The options are `begin', `after' or `end'." | |||
| 208 | "Refresh all visible Eshell buffers." | 206 | "Refresh all visible Eshell buffers." |
| 209 | (let (affected) | 207 | (let (affected) |
| 210 | (walk-windows | 208 | (walk-windows |
| 211 | (function | 209 | (lambda (wind) |
| 212 | (lambda (wind) | 210 | (with-current-buffer (window-buffer wind) |
| 213 | (with-current-buffer (window-buffer wind) | 211 | (if eshell-mode |
| 214 | (if eshell-mode | 212 | (let (window-scroll-functions) ;;FIXME: Why? |
| 215 | (let (window-scroll-functions) ;;FIXME: Why? | 213 | (eshell-smart-scroll-window wind (window-start)) |
| 216 | (eshell-smart-scroll-window wind (window-start)) | 214 | (setq affected t))))) |
| 217 | (setq affected t)))))) | ||
| 218 | 0 frame) | 215 | 0 frame) |
| 219 | (if affected | 216 | (if affected |
| 220 | (let (window-scroll-functions) ;;FIXME: Why? | 217 | (let (window-scroll-functions) ;;FIXME: Why? |
diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el index 937b8bfa391..18818648bc4 100644 --- a/lisp/eshell/em-unix.el +++ b/lisp/eshell/em-unix.el | |||
| @@ -419,9 +419,8 @@ Remove the DIRECTORY(ies), if they are empty.") | |||
| 419 | (apply 'eshell-shuffle-files | 419 | (apply 'eshell-shuffle-files |
| 420 | command action | 420 | command action |
| 421 | (mapcar | 421 | (mapcar |
| 422 | (function | 422 | (lambda (file) |
| 423 | (lambda (file) | 423 | (concat source "/" file)) |
| 424 | (concat source "/" file))) | ||
| 425 | (directory-files source)) | 424 | (directory-files source)) |
| 426 | target func t args) | 425 | target func t args) |
| 427 | (when (eq func 'rename-file) | 426 | (when (eq func 'rename-file) |
diff --git a/lisp/eshell/esh-arg.el b/lisp/eshell/esh-arg.el index e7b07b4208d..aefda647689 100644 --- a/lisp/eshell/esh-arg.el +++ b/lisp/eshell/esh-arg.el | |||
| @@ -85,51 +85,48 @@ If POS is nil, the location of point is checked." | |||
| 85 | 'eshell-parse-special-reference | 85 | 'eshell-parse-special-reference |
| 86 | 86 | ||
| 87 | ;; numbers convert to numbers if they stand alone | 87 | ;; numbers convert to numbers if they stand alone |
| 88 | (function | 88 | (lambda () |
| 89 | (lambda () | 89 | (when (and (not eshell-current-argument) |
| 90 | (when (and (not eshell-current-argument) | 90 | (not eshell-current-quoted) |
| 91 | (not eshell-current-quoted) | 91 | (looking-at eshell-number-regexp) |
| 92 | (looking-at eshell-number-regexp) | 92 | (eshell-arg-delimiter (match-end 0))) |
| 93 | (eshell-arg-delimiter (match-end 0))) | 93 | (goto-char (match-end 0)) |
| 94 | (goto-char (match-end 0)) | 94 | (let ((str (match-string 0))) |
| 95 | (let ((str (match-string 0))) | 95 | (if (> (length str) 0) |
| 96 | (if (> (length str) 0) | 96 | (add-text-properties 0 (length str) '(number t) str)) |
| 97 | (add-text-properties 0 (length str) '(number t) str)) | 97 | str))) |
| 98 | str)))) | ||
| 99 | 98 | ||
| 100 | ;; parse any non-special characters, based on the current context | 99 | ;; parse any non-special characters, based on the current context |
| 101 | (function | 100 | (lambda () |
| 102 | (lambda () | 101 | (unless eshell-inside-quote-regexp |
| 103 | (unless eshell-inside-quote-regexp | 102 | (setq eshell-inside-quote-regexp |
| 104 | (setq eshell-inside-quote-regexp | 103 | (format "[^%s]+" |
| 105 | (format "[^%s]+" | 104 | (apply 'string eshell-special-chars-inside-quoting)))) |
| 106 | (apply 'string eshell-special-chars-inside-quoting)))) | 105 | (unless eshell-outside-quote-regexp |
| 107 | (unless eshell-outside-quote-regexp | 106 | (setq eshell-outside-quote-regexp |
| 108 | (setq eshell-outside-quote-regexp | 107 | (format "[^%s]+" |
| 109 | (format "[^%s]+" | 108 | (apply 'string eshell-special-chars-outside-quoting)))) |
| 110 | (apply 'string eshell-special-chars-outside-quoting)))) | 109 | (when (looking-at (if eshell-current-quoted |
| 111 | (when (looking-at (if eshell-current-quoted | 110 | eshell-inside-quote-regexp |
| 112 | eshell-inside-quote-regexp | 111 | eshell-outside-quote-regexp)) |
| 113 | eshell-outside-quote-regexp)) | 112 | (goto-char (match-end 0)) |
| 114 | (goto-char (match-end 0)) | 113 | (let ((str (match-string 0))) |
| 115 | (let ((str (match-string 0))) | 114 | (if str |
| 116 | (if str | 115 | (set-text-properties 0 (length str) nil str)) |
| 117 | (set-text-properties 0 (length str) nil str)) | 116 | str))) |
| 118 | str)))) | ||
| 119 | 117 | ||
| 120 | ;; whitespace or a comment is an argument delimiter | 118 | ;; whitespace or a comment is an argument delimiter |
| 121 | (function | 119 | (lambda () |
| 122 | (lambda () | 120 | (let (comment-p) |
| 123 | (let (comment-p) | 121 | (when (or (looking-at "[ \t]+") |
| 124 | (when (or (looking-at "[ \t]+") | 122 | (and (not eshell-current-argument) |
| 125 | (and (not eshell-current-argument) | 123 | (looking-at "#\\([^<'].*\\|$\\)") |
| 126 | (looking-at "#\\([^<'].*\\|$\\)") | 124 | (setq comment-p t))) |
| 127 | (setq comment-p t))) | 125 | (if comment-p |
| 128 | (if comment-p | 126 | (add-text-properties (match-beginning 0) (match-end 0) |
| 129 | (add-text-properties (match-beginning 0) (match-end 0) | 127 | '(comment t))) |
| 130 | '(comment t))) | 128 | (goto-char (match-end 0)) |
| 131 | (goto-char (match-end 0)) | 129 | (eshell-finish-arg)))) |
| 132 | (eshell-finish-arg))))) | ||
| 133 | 130 | ||
| 134 | ;; parse backslash and the character after | 131 | ;; parse backslash and the character after |
| 135 | 'eshell-parse-backslash | 132 | 'eshell-parse-backslash |
diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el index e0348ba5013..68b34837a23 100644 --- a/lisp/eshell/esh-cmd.el +++ b/lisp/eshell/esh-cmd.el | |||
| @@ -304,10 +304,9 @@ otherwise t.") | |||
| 304 | ;; situation can occur, for example, if a Lisp function results in | 304 | ;; situation can occur, for example, if a Lisp function results in |
| 305 | ;; `debug' being called, and the user then types \\[top-level] | 305 | ;; `debug' being called, and the user then types \\[top-level] |
| 306 | (add-hook 'eshell-post-command-hook | 306 | (add-hook 'eshell-post-command-hook |
| 307 | (function | 307 | (lambda () |
| 308 | (lambda () | 308 | (setq eshell-current-command nil |
| 309 | (setq eshell-current-command nil | 309 | eshell-last-async-proc nil)) |
| 310 | eshell-last-async-proc nil))) | ||
| 311 | nil t) | 310 | nil t) |
| 312 | 311 | ||
| 313 | (add-hook 'eshell-parse-argument-hook | 312 | (add-hook 'eshell-parse-argument-hook |
| @@ -355,18 +354,17 @@ hooks should be run before and after the command." | |||
| 355 | args)) | 354 | args)) |
| 356 | (commands | 355 | (commands |
| 357 | (mapcar | 356 | (mapcar |
| 358 | (function | 357 | (lambda (cmd) |
| 359 | (lambda (cmd) | 358 | (setq cmd |
| 360 | (setq cmd | 359 | (if (or (not (car eshell--sep-terms)) |
| 361 | (if (or (not (car eshell--sep-terms)) | 360 | (string= (car eshell--sep-terms) ";")) |
| 362 | (string= (car eshell--sep-terms) ";")) | 361 | (eshell-parse-pipeline cmd) |
| 363 | (eshell-parse-pipeline cmd) | 362 | `(eshell-do-subjob |
| 364 | `(eshell-do-subjob | 363 | (list ,(eshell-parse-pipeline cmd))))) |
| 365 | (list ,(eshell-parse-pipeline cmd))))) | 364 | (setq eshell--sep-terms (cdr eshell--sep-terms)) |
| 366 | (setq eshell--sep-terms (cdr eshell--sep-terms)) | 365 | (if eshell-in-pipeline-p |
| 367 | (if eshell-in-pipeline-p | 366 | cmd |
| 368 | cmd | 367 | `(eshell-trap-errors ,cmd))) |
| 369 | `(eshell-trap-errors ,cmd)))) | ||
| 370 | (eshell-separate-commands terms "[&;]" nil 'eshell--sep-terms)))) | 368 | (eshell-separate-commands terms "[&;]" nil 'eshell--sep-terms)))) |
| 371 | (let ((cmd commands)) | 369 | (let ((cmd commands)) |
| 372 | (while cmd | 370 | (while cmd |
| @@ -920,7 +918,7 @@ at the moment are: | |||
| 920 | (funcall pred name)) | 918 | (funcall pred name)) |
| 921 | (throw 'simple nil))) | 919 | (throw 'simple nil))) |
| 922 | t)) | 920 | t)) |
| 923 | (fboundp (intern-soft (concat "eshell/" name)))))) | 921 | (eshell-find-alias-function name)))) |
| 924 | 922 | ||
| 925 | (defun eshell-eval-command (command &optional input) | 923 | (defun eshell-eval-command (command &optional input) |
| 926 | "Evaluate the given COMMAND iteratively." | 924 | "Evaluate the given COMMAND iteratively." |
diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el index e0e86348bd8..a80c2fc60d9 100644 --- a/lisp/eshell/esh-mode.el +++ b/lisp/eshell/esh-mode.el | |||
| @@ -742,13 +742,12 @@ This function should be a pre-command hook." | |||
| 742 | (if (eq scroll 'this) | 742 | (if (eq scroll 'this) |
| 743 | (goto-char (point-max)) | 743 | (goto-char (point-max)) |
| 744 | (walk-windows | 744 | (walk-windows |
| 745 | (function | 745 | (lambda (window) |
| 746 | (lambda (window) | 746 | (when (and (eq (window-buffer window) current) |
| 747 | (when (and (eq (window-buffer window) current) | 747 | (or (eq scroll t) (eq scroll 'all))) |
| 748 | (or (eq scroll t) (eq scroll 'all))) | 748 | (select-window window) |
| 749 | (select-window window) | 749 | (goto-char (point-max)) |
| 750 | (goto-char (point-max)) | 750 | (select-window selected))) |
| 751 | (select-window selected)))) | ||
| 752 | nil t)))))) | 751 | nil t)))))) |
| 753 | 752 | ||
| 754 | ;;; jww (1999-10-23): this needs testing | 753 | ;;; jww (1999-10-23): this needs testing |
| @@ -764,29 +763,28 @@ This function should be in the list `eshell-output-filter-functions'." | |||
| 764 | (scroll eshell-scroll-to-bottom-on-output)) | 763 | (scroll eshell-scroll-to-bottom-on-output)) |
| 765 | (unwind-protect | 764 | (unwind-protect |
| 766 | (walk-windows | 765 | (walk-windows |
| 767 | (function | 766 | (lambda (window) |
| 768 | (lambda (window) | 767 | (if (eq (window-buffer window) current) |
| 769 | (if (eq (window-buffer window) current) | 768 | (progn |
| 770 | (progn | 769 | (select-window window) |
| 771 | (select-window window) | 770 | (if (and (< (point) eshell-last-output-end) |
| 772 | (if (and (< (point) eshell-last-output-end) | 771 | (or (eq scroll t) (eq scroll 'all) |
| 773 | (or (eq scroll t) (eq scroll 'all) | 772 | ;; Maybe user wants point to jump to end. |
| 774 | ;; Maybe user wants point to jump to end. | 773 | (and (eq scroll 'this) |
| 775 | (and (eq scroll 'this) | 774 | (eq selected window)) |
| 776 | (eq selected window)) | 775 | (and (eq scroll 'others) |
| 777 | (and (eq scroll 'others) | 776 | (not (eq selected window))) |
| 778 | (not (eq selected window))) | 777 | ;; If point was at the end, keep it at end. |
| 779 | ;; If point was at the end, keep it at end. | 778 | (>= (point) eshell-last-output-start))) |
| 780 | (>= (point) eshell-last-output-start))) | 779 | (goto-char eshell-last-output-end)) |
| 781 | (goto-char eshell-last-output-end)) | 780 | ;; Optionally scroll so that the text |
| 782 | ;; Optionally scroll so that the text | 781 | ;; ends at the bottom of the window. |
| 783 | ;; ends at the bottom of the window. | 782 | (if (and eshell-scroll-show-maximum-output |
| 784 | (if (and eshell-scroll-show-maximum-output | 783 | (>= (point) eshell-last-output-end)) |
| 785 | (>= (point) eshell-last-output-end)) | 784 | (save-excursion |
| 786 | (save-excursion | 785 | (goto-char (point-max)) |
| 787 | (goto-char (point-max)) | 786 | (recenter -1))) |
| 788 | (recenter -1))) | 787 | (select-window selected)))) |
| 789 | (select-window selected))))) | ||
| 790 | nil t) | 788 | nil t) |
| 791 | (set-buffer current)))) | 789 | (set-buffer current)))) |
| 792 | 790 | ||
diff --git a/lisp/eshell/esh-module.el b/lisp/eshell/esh-module.el index 45c4c9e13c0..10994ba3010 100644 --- a/lisp/eshell/esh-module.el +++ b/lisp/eshell/esh-module.el | |||
| @@ -65,16 +65,15 @@ Changes will only take effect in future Eshell buffers." | |||
| 65 | :type (append | 65 | :type (append |
| 66 | (list 'set ':tag "Supported modules") | 66 | (list 'set ':tag "Supported modules") |
| 67 | (mapcar | 67 | (mapcar |
| 68 | (function | 68 | (lambda (modname) |
| 69 | (lambda (modname) | 69 | (let ((modsym (intern modname))) |
| 70 | (let ((modsym (intern modname))) | 70 | (list 'const |
| 71 | (list 'const | 71 | ':tag (format "%s -- %s" modname |
| 72 | ':tag (format "%s -- %s" modname | 72 | (get modsym 'custom-tag)) |
| 73 | (get modsym 'custom-tag)) | 73 | ':link (caar (get modsym 'custom-links)) |
| 74 | ':link (caar (get modsym 'custom-links)) | 74 | ':doc (concat "\n" (get modsym 'group-documentation) |
| 75 | ':doc (concat "\n" (get modsym 'group-documentation) | 75 | "\n ") |
| 76 | "\n ") | 76 | modsym))) |
| 77 | modsym)))) | ||
| 78 | (sort (mapcar 'symbol-name | 77 | (sort (mapcar 'symbol-name |
| 79 | (eshell-subgroups 'eshell-module)) | 78 | (eshell-subgroups 'eshell-module)) |
| 80 | 'string-lessp)) | 79 | 'string-lessp)) |
diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el index db1b258c8f5..4a1001bf058 100644 --- a/lisp/eshell/esh-proc.el +++ b/lisp/eshell/esh-proc.el | |||
| @@ -215,9 +215,8 @@ and signal names." | |||
| 215 | The prompt will be set to PROMPT." | 215 | The prompt will be set to PROMPT." |
| 216 | (completing-read prompt | 216 | (completing-read prompt |
| 217 | (mapcar | 217 | (mapcar |
| 218 | (function | 218 | (lambda (proc) |
| 219 | (lambda (proc) | 219 | (cons (process-name proc) t)) |
| 220 | (cons (process-name proc) t))) | ||
| 221 | (process-list)) | 220 | (process-list)) |
| 222 | nil t)) | 221 | nil t)) |
| 223 | 222 | ||
| @@ -499,9 +498,8 @@ See the variable `eshell-kill-processes-on-exit'." | |||
| 499 | (let ((sigs eshell-kill-process-signals)) | 498 | (let ((sigs eshell-kill-process-signals)) |
| 500 | (while sigs | 499 | (while sigs |
| 501 | (eshell-process-interact | 500 | (eshell-process-interact |
| 502 | (function | 501 | (lambda (proc) |
| 503 | (lambda (proc) | 502 | (signal-process (process-id proc) (car sigs))) t query) |
| 504 | (signal-process (process-id proc) (car sigs)))) t query) | ||
| 505 | (setq query nil) | 503 | (setq query nil) |
| 506 | (if (not eshell-process-list) | 504 | (if (not eshell-process-list) |
| 507 | (setq sigs nil) | 505 | (setq sigs nil) |
diff --git a/lisp/eshell/esh-var.el b/lisp/eshell/esh-var.el index 7388279f157..f91fb89412e 100644 --- a/lisp/eshell/esh-var.el +++ b/lisp/eshell/esh-var.el | |||
| @@ -382,9 +382,8 @@ This function is explicit for adding to `eshell-parse-argument-hook'." | |||
| 382 | 382 | ||
| 383 | (defun eshell-envvar-names (&optional environment) | 383 | (defun eshell-envvar-names (&optional environment) |
| 384 | "Return a list of currently visible environment variable names." | 384 | "Return a list of currently visible environment variable names." |
| 385 | (mapcar (function | 385 | (mapcar (lambda (x) |
| 386 | (lambda (x) | 386 | (substring x 0 (string-match "=" x))) |
| 387 | (substring x 0 (string-match "=" x)))) | ||
| 388 | (or environment process-environment))) | 387 | (or environment process-environment))) |
| 389 | 388 | ||
| 390 | (defun eshell-environment-variables () | 389 | (defun eshell-environment-variables () |
| @@ -618,14 +617,13 @@ For example, to retrieve the second element of a user's record in | |||
| 618 | (sort | 617 | (sort |
| 619 | (append | 618 | (append |
| 620 | (mapcar | 619 | (mapcar |
| 621 | (function | 620 | (lambda (varname) |
| 622 | (lambda (varname) | 621 | (let ((value (eshell-get-variable varname))) |
| 623 | (let ((value (eshell-get-variable varname))) | 622 | (if (and value |
| 624 | (if (and value | 623 | (stringp value) |
| 625 | (stringp value) | 624 | (file-directory-p value)) |
| 626 | (file-directory-p value)) | 625 | (concat varname "/") |
| 627 | (concat varname "/") | 626 | varname))) |
| 628 | varname)))) | ||
| 629 | (eshell-envvar-names (eshell-environment-variables))) | 627 | (eshell-envvar-names (eshell-environment-variables))) |
| 630 | (all-completions argname obarray 'boundp) | 628 | (all-completions argname obarray 'boundp) |
| 631 | completions) | 629 | completions) |
diff --git a/lisp/ffap.el b/lisp/ffap.el index bf035886006..d4bddd0574f 100644 --- a/lisp/ffap.el +++ b/lisp/ffap.el | |||
| @@ -301,15 +301,14 @@ disable ffap most of the time." | |||
| 301 | :version "20.3") | 301 | :version "20.3") |
| 302 | 302 | ||
| 303 | 303 | ||
| 304 | ;;; Compatibility: | 304 | ;;; Obsolete: |
| 305 | ;; | ||
| 306 | ;; This version of ffap supports only the Emacs it is distributed in. | ||
| 307 | ;; See the ftp site for a more general version. The following | ||
| 308 | ;; functions are necessary "leftovers" from the more general version. | ||
| 309 | 305 | ||
| 310 | (defun ffap-mouse-event () ; current mouse event, or nil | 306 | (defun ffap-mouse-event () ; current mouse event, or nil |
| 307 | (declare (obsolete nil "28.1")) | ||
| 311 | (and (listp last-nonmenu-event) last-nonmenu-event)) | 308 | (and (listp last-nonmenu-event) last-nonmenu-event)) |
| 309 | |||
| 312 | (defun ffap-event-buffer (event) | 310 | (defun ffap-event-buffer (event) |
| 311 | (declare (obsolete nil "28.1")) | ||
| 313 | (window-buffer (car (event-start event)))) | 312 | (window-buffer (car (event-start event)))) |
| 314 | 313 | ||
| 315 | 314 | ||
| @@ -690,14 +689,13 @@ Optional DEPTH limits search depth." | |||
| 690 | (setq depth (1- depth)) | 689 | (setq depth (1- depth)) |
| 691 | (cons dir | 690 | (cons dir |
| 692 | (and (not (eq depth -1)) | 691 | (and (not (eq depth -1)) |
| 693 | (apply 'nconc | 692 | (apply #'nconc |
| 694 | (mapcar | 693 | (mapcar |
| 695 | (function | 694 | (lambda (d) |
| 696 | (lambda (d) | 695 | (cond |
| 697 | (cond | 696 | ((not (file-directory-p d)) nil) |
| 698 | ((not (file-directory-p d)) nil) | 697 | ((file-symlink-p d) (list d)) |
| 699 | ((file-symlink-p d) (list d)) | 698 | (t (ffap-all-subdirs-loop d depth)))) |
| 700 | (t (ffap-all-subdirs-loop d depth))))) | ||
| 701 | (directory-files dir t "\\`[^.]") | 699 | (directory-files dir t "\\`[^.]") |
| 702 | ))))) | 700 | ))))) |
| 703 | 701 | ||
| @@ -710,13 +708,12 @@ Set to 0 to avoid all searching, or nil for no limit.") | |||
| 710 | The subdirs begin with the original directory, and the depth of the | 708 | The subdirs begin with the original directory, and the depth of the |
| 711 | search is bounded by `ffap-kpathsea-depth'. This is intended to mimic | 709 | search is bounded by `ffap-kpathsea-depth'. This is intended to mimic |
| 712 | kpathsea, a library used by some versions of TeX." | 710 | kpathsea, a library used by some versions of TeX." |
| 713 | (apply 'nconc | 711 | (apply #'nconc |
| 714 | (mapcar | 712 | (mapcar |
| 715 | (function | 713 | (lambda (dir) |
| 716 | (lambda (dir) | 714 | (if (string-match "[^/]//\\'" dir) |
| 717 | (if (string-match "[^/]//\\'" dir) | 715 | (ffap-all-subdirs (substring dir 0 -2) ffap-kpathsea-depth) |
| 718 | (ffap-all-subdirs (substring dir 0 -2) ffap-kpathsea-depth) | 716 | (list dir))) |
| 719 | (list dir)))) | ||
| 720 | path))) | 717 | path))) |
| 721 | 718 | ||
| 722 | (defun ffap-locate-file (file nosuffix path) | 719 | (defun ffap-locate-file (file nosuffix path) |
| @@ -1738,7 +1735,9 @@ Function CONT is applied to the entry chosen by the user." | |||
| 1738 | (let (choice) | 1735 | (let (choice) |
| 1739 | (cond | 1736 | (cond |
| 1740 | ;; Emacs mouse: | 1737 | ;; Emacs mouse: |
| 1741 | ((and (fboundp 'x-popup-menu) (ffap-mouse-event)) | 1738 | ((and (fboundp 'x-popup-menu) |
| 1739 | (listp last-nonmenu-event) | ||
| 1740 | last-nonmenu-event) | ||
| 1742 | (setq choice | 1741 | (setq choice |
| 1743 | (x-popup-menu | 1742 | (x-popup-menu |
| 1744 | t | 1743 | t |
| @@ -1793,8 +1792,7 @@ Applies `ffap-menu-text-plist' text properties at all matches." | |||
| 1793 | ;; Remove duplicates. | 1792 | ;; Remove duplicates. |
| 1794 | (setq ffap-menu-alist ; sort by item | 1793 | (setq ffap-menu-alist ; sort by item |
| 1795 | (sort ffap-menu-alist | 1794 | (sort ffap-menu-alist |
| 1796 | (function | 1795 | (lambda (a b) (string-lessp (car a) (car b))))) |
| 1797 | (lambda (a b) (string-lessp (car a) (car b)))))) | ||
| 1798 | (let ((ptr ffap-menu-alist)) ; remove duplicates | 1796 | (let ((ptr ffap-menu-alist)) ; remove duplicates |
| 1799 | (while (cdr ptr) | 1797 | (while (cdr ptr) |
| 1800 | (if (equal (car (car ptr)) (car (car (cdr ptr)))) | 1798 | (if (equal (car (car ptr)) (car (car (cdr ptr)))) |
| @@ -1802,8 +1800,7 @@ Applies `ffap-menu-text-plist' text properties at all matches." | |||
| 1802 | (setq ptr (cdr ptr))))) | 1800 | (setq ptr (cdr ptr))))) |
| 1803 | (setq ffap-menu-alist ; sort by position | 1801 | (setq ffap-menu-alist ; sort by position |
| 1804 | (sort ffap-menu-alist | 1802 | (sort ffap-menu-alist |
| 1805 | (function | 1803 | (lambda (a b) (< (cdr a) (cdr b)))))) |
| 1806 | (lambda (a b) (< (cdr a) (cdr b))))))) | ||
| 1807 | 1804 | ||
| 1808 | 1805 | ||
| 1809 | ;;; Mouse Support (`ffap-at-mouse'): | 1806 | ;;; Mouse Support (`ffap-at-mouse'): |
| @@ -1833,7 +1830,7 @@ Return value: | |||
| 1833 | (ffap-guesser)))) | 1830 | (ffap-guesser)))) |
| 1834 | (cond | 1831 | (cond |
| 1835 | (guess | 1832 | (guess |
| 1836 | (set-buffer (ffap-event-buffer e)) | 1833 | (set-buffer (window-buffer (car (event-start e)))) |
| 1837 | (ffap-highlight) | 1834 | (ffap-highlight) |
| 1838 | (unwind-protect | 1835 | (unwind-protect |
| 1839 | (progn | 1836 | (progn |
diff --git a/lisp/files-x.el b/lisp/files-x.el index 911e7ba9e3d..620a2e23f56 100644 --- a/lisp/files-x.el +++ b/lisp/files-x.el | |||
| @@ -730,6 +730,16 @@ Execute BODY, and unwind connection-local variables." | |||
| 730 | ;; No connection-local variables to apply. | 730 | ;; No connection-local variables to apply. |
| 731 | ,@body)) | 731 | ,@body)) |
| 732 | 732 | ||
| 733 | ;;;###autoload | ||
| 734 | (defun path-separator () | ||
| 735 | "The connection-local value of `path-separator'." | ||
| 736 | (with-connection-local-variables path-separator)) | ||
| 737 | |||
| 738 | ;;;###autoload | ||
| 739 | (defun null-device () | ||
| 740 | "The connection-local value of `null-device'." | ||
| 741 | (with-connection-local-variables null-device)) | ||
| 742 | |||
| 733 | 743 | ||
| 734 | 744 | ||
| 735 | (provide 'files-x) | 745 | (provide 'files-x) |
diff --git a/lisp/files.el b/lisp/files.el index 92c9a63ef18..777725903fa 100644 --- a/lisp/files.el +++ b/lisp/files.el | |||
| @@ -2315,53 +2315,52 @@ the various files." | |||
| 2315 | ;; hexl-mode or image-mode. | 2315 | ;; hexl-mode or image-mode. |
| 2316 | (memq major-mode '(hexl-mode image-mode))) | 2316 | (memq major-mode '(hexl-mode image-mode))) |
| 2317 | (if (buffer-modified-p) | 2317 | (if (buffer-modified-p) |
| 2318 | (if (y-or-n-p | 2318 | (if (let ((help-form |
| 2319 | (format | 2319 | (format-message |
| 2320 | (if rawfile | 2320 | (if rawfile "\ |
| 2321 | "The file %s is already visited normally, | 2321 | The file %s is already visited normally, |
| 2322 | and you have edited the buffer. Now you have asked to visit it literally, | 2322 | and you have edited the buffer. Now you have asked to visit it literally, |
| 2323 | meaning no coding system handling, format conversion, or local variables. | 2323 | meaning no coding system handling, format conversion, or local variables. |
| 2324 | Emacs can visit a file in only one way at a time. | 2324 | Emacs can visit a file in only one way at a time." |
| 2325 | 2325 | "\ | |
| 2326 | Do you want to save the file, and visit it literally instead? " | 2326 | The file %s is already visited literally, |
| 2327 | "The file %s is already visited literally, | ||
| 2328 | meaning no coding system handling, format conversion, or local variables. | 2327 | meaning no coding system handling, format conversion, or local variables. |
| 2329 | You have edited the buffer. Now you have asked to visit the file normally, | 2328 | You have edited the buffer. Now you have asked to visit the file normally, |
| 2330 | but Emacs can visit a file in only one way at a time. | 2329 | but Emacs can visit a file in only one way at a time.") |
| 2331 | 2330 | (file-name-nondirectory filename)))) | |
| 2332 | Do you want to save the file, and visit it normally instead? ") | 2331 | (y-or-n-p |
| 2333 | (file-name-nondirectory filename))) | 2332 | (if rawfile "\ |
| 2333 | Do you want to save the file, and visit it literally instead? " "\ | ||
| 2334 | Do you want to save the file, and visit it normally instead? "))) | ||
| 2334 | (progn | 2335 | (progn |
| 2335 | (save-buffer) | 2336 | (save-buffer) |
| 2336 | (find-file-noselect-1 buf filename nowarn | 2337 | (find-file-noselect-1 buf filename nowarn |
| 2337 | rawfile truename number)) | 2338 | rawfile truename number)) |
| 2338 | (if (y-or-n-p | 2339 | (if (y-or-n-p |
| 2339 | (format | 2340 | (if rawfile "\ |
| 2340 | (if rawfile | 2341 | Do you want to discard your changes, and visit the file literally now? " "\ |
| 2341 | "\ | 2342 | Do you want to discard your changes, and visit the file normally now? ")) |
| 2342 | Do you want to discard your changes, and visit the file literally now? " | ||
| 2343 | "\ | ||
| 2344 | Do you want to discard your changes, and visit the file normally now? "))) | ||
| 2345 | (find-file-noselect-1 buf filename nowarn | 2343 | (find-file-noselect-1 buf filename nowarn |
| 2346 | rawfile truename number) | 2344 | rawfile truename number) |
| 2347 | (error (if rawfile "File already visited non-literally" | 2345 | (error (if rawfile "File already visited non-literally" |
| 2348 | "File already visited literally")))) | 2346 | "File already visited literally")))) |
| 2349 | (if (y-or-n-p | 2347 | (if (let ((help-form |
| 2350 | (format | 2348 | (format-message |
| 2351 | (if rawfile | 2349 | (if rawfile "\ |
| 2352 | "The file %s is already visited normally. | 2350 | The file %s is already visited normally. |
| 2353 | You have asked to visit it literally, | 2351 | You have asked to visit it literally, |
| 2354 | meaning no coding system decoding, format conversion, or local variables. | 2352 | meaning no coding system decoding, format conversion, or local variables. |
| 2355 | But Emacs can visit a file in only one way at a time. | 2353 | But Emacs can visit a file in only one way at a time." |
| 2356 | 2354 | "\ | |
| 2357 | Do you want to revisit the file literally now? " | 2355 | The file %s is already visited literally, |
| 2358 | "The file %s is already visited literally, | ||
| 2359 | meaning no coding system decoding, format conversion, or local variables. | 2356 | meaning no coding system decoding, format conversion, or local variables. |
| 2360 | You have asked to visit it normally, | 2357 | You have asked to visit it normally, |
| 2361 | but Emacs can visit a file in only one way at a time. | 2358 | but Emacs can visit a file in only one way at a time.") |
| 2362 | 2359 | (file-name-nondirectory filename)))) | |
| 2363 | Do you want to revisit the file normally now? ") | 2360 | (y-or-n-p |
| 2364 | (file-name-nondirectory filename))) | 2361 | (if rawfile "\ |
| 2362 | Do you want to revisit the file literally now? " "\ | ||
| 2363 | Do you want to revisit the file normally now? "))) | ||
| 2365 | (find-file-noselect-1 buf filename nowarn | 2364 | (find-file-noselect-1 buf filename nowarn |
| 2366 | rawfile truename number) | 2365 | rawfile truename number) |
| 2367 | (error (if rawfile "File already visited non-literally" | 2366 | (error (if rawfile "File already visited non-literally" |
| @@ -7375,9 +7374,9 @@ if any returns nil. If `confirm-kill-emacs' is non-nil, calls it." | |||
| 7375 | (save-some-buffers arg t) | 7374 | (save-some-buffers arg t) |
| 7376 | (let ((confirm confirm-kill-emacs)) | 7375 | (let ((confirm confirm-kill-emacs)) |
| 7377 | (and | 7376 | (and |
| 7378 | (or (not (memq t (mapcar (function | 7377 | (or (not (memq t (mapcar (lambda (buf) |
| 7379 | (lambda (buf) (and (buffer-file-name buf) | 7378 | (and (buffer-file-name buf) |
| 7380 | (buffer-modified-p buf)))) | 7379 | (buffer-modified-p buf))) |
| 7381 | (buffer-list)))) | 7380 | (buffer-list)))) |
| 7382 | (progn (setq confirm nil) | 7381 | (progn (setq confirm nil) |
| 7383 | (yes-or-no-p "Modified buffers exist; exit anyway? "))) | 7382 | (yes-or-no-p "Modified buffers exist; exit anyway? "))) |
diff --git a/lisp/filesets.el b/lisp/filesets.el index 2cad2023b85..c7ec3f77f43 100644 --- a/lisp/filesets.el +++ b/lisp/filesets.el | |||
| @@ -89,6 +89,7 @@ | |||
| 89 | ;;; Code: | 89 | ;;; Code: |
| 90 | 90 | ||
| 91 | (eval-when-compile (require 'cl-lib)) | 91 | (eval-when-compile (require 'cl-lib)) |
| 92 | (require 'easymenu) | ||
| 92 | 93 | ||
| 93 | ;;; Some variables | 94 | ;;; Some variables |
| 94 | 95 | ||
| @@ -308,7 +309,7 @@ SYM to VAL and return t. If INIT-FLAG is non-nil, set with | |||
| 308 | 309 | ||
| 309 | (defcustom filesets-menu-path '("File") ; cf recentf-menu-path | 310 | (defcustom filesets-menu-path '("File") ; cf recentf-menu-path |
| 310 | "The menu under which the filesets menu should be inserted. | 311 | "The menu under which the filesets menu should be inserted. |
| 311 | See `add-submenu' for documentation." | 312 | See `easy-menu-add-item' for documentation." |
| 312 | :set (function filesets-set-default) | 313 | :set (function filesets-set-default) |
| 313 | :type '(choice (const :tag "Top Level" nil) | 314 | :type '(choice (const :tag "Top Level" nil) |
| 314 | (sexp :tag "Menu Path")) | 315 | (sexp :tag "Menu Path")) |
| @@ -317,7 +318,7 @@ See `add-submenu' for documentation." | |||
| 317 | 318 | ||
| 318 | (defcustom filesets-menu-before "Open File..." ; cf recentf-menu-before | 319 | (defcustom filesets-menu-before "Open File..." ; cf recentf-menu-before |
| 319 | "The name of a menu before which this menu should be added. | 320 | "The name of a menu before which this menu should be added. |
| 320 | See `add-submenu' for documentation." | 321 | See `easy-menu-add-item' for documentation." |
| 321 | :set (function filesets-set-default) | 322 | :set (function filesets-set-default) |
| 322 | :type '(choice (string :tag "Name") | 323 | :type '(choice (string :tag "Name") |
| 323 | (const :tag "Last" nil)) | 324 | (const :tag "Last" nil)) |
| @@ -326,7 +327,7 @@ See `add-submenu' for documentation." | |||
| 326 | 327 | ||
| 327 | (defcustom filesets-menu-in-menu nil | 328 | (defcustom filesets-menu-in-menu nil |
| 328 | "Use that instead of `current-menubar' as the menu to change. | 329 | "Use that instead of `current-menubar' as the menu to change. |
| 329 | See `add-submenu' for documentation." | 330 | See `easy-menu-add-item' for documentation." |
| 330 | :set (function filesets-set-default) | 331 | :set (function filesets-set-default) |
| 331 | :type 'sexp | 332 | :type 'sexp |
| 332 | :group 'filesets) | 333 | :group 'filesets) |
| @@ -1075,18 +1076,6 @@ defined in `filesets-ingroup-patterns'." | |||
| 1075 | :type 'integer | 1076 | :type 'integer |
| 1076 | :group 'filesets) | 1077 | :group 'filesets) |
| 1077 | 1078 | ||
| 1078 | ;;; Emacs compatibility | ||
| 1079 | (eval-and-compile | ||
| 1080 | (if (featurep 'xemacs) | ||
| 1081 | (fset 'filesets-error 'error) | ||
| 1082 | |||
| 1083 | (require 'easymenu) | ||
| 1084 | |||
| 1085 | (defun filesets-error (_class &rest args) | ||
| 1086 | "`error' wrapper." | ||
| 1087 | (error "%s" (mapconcat 'identity args " "))) | ||
| 1088 | |||
| 1089 | )) | ||
| 1090 | 1079 | ||
| 1091 | (defun filesets-filter-dir-names (lst &optional negative) | 1080 | (defun filesets-filter-dir-names (lst &optional negative) |
| 1092 | "Remove non-directory names from a list of strings. | 1081 | "Remove non-directory names from a list of strings. |
| @@ -1160,7 +1149,7 @@ Return full path if FULL-FLAG is non-nil." | |||
| 1160 | (filesets-message 1 "Filesets: %S doesn't exist" dir) | 1149 | (filesets-message 1 "Filesets: %S doesn't exist" dir) |
| 1161 | nil) | 1150 | nil) |
| 1162 | (t | 1151 | (t |
| 1163 | (filesets-error 'error "Filesets: " dir " does not exist")))) | 1152 | (error "Filesets: %s does not exist" dir)))) |
| 1164 | 1153 | ||
| 1165 | (defun filesets-quote (txt) | 1154 | (defun filesets-quote (txt) |
| 1166 | "Return TXT in quotes." | 1155 | "Return TXT in quotes." |
| @@ -1172,7 +1161,7 @@ Return full path if FULL-FLAG is non-nil." | |||
| 1172 | (p (point))) | 1161 | (p (point))) |
| 1173 | (if m | 1162 | (if m |
| 1174 | (buffer-substring (min m p) (max m p)) | 1163 | (buffer-substring (min m p) (max m p)) |
| 1175 | (filesets-error 'error "No selection.")))) | 1164 | (error "No selection")))) |
| 1176 | 1165 | ||
| 1177 | (defun filesets-get-quoted-selection () | 1166 | (defun filesets-get-quoted-selection () |
| 1178 | "Return the currently selected text in quotes." | 1167 | "Return the currently selected text in quotes." |
| @@ -1357,8 +1346,7 @@ Use the viewer defined in EV-ENTRY (a valid element of | |||
| 1357 | (goto-char (point-min))) | 1346 | (goto-char (point-min))) |
| 1358 | (when oh | 1347 | (when oh |
| 1359 | (run-hooks 'oh)))) | 1348 | (run-hooks 'oh)))) |
| 1360 | (filesets-error 'error | 1349 | (error "Filesets: general error when spawning external viewer")))) |
| 1361 | "Filesets: general error when spawning external viewer")))) | ||
| 1362 | 1350 | ||
| 1363 | (defun filesets-find-file (file) | 1351 | (defun filesets-find-file (file) |
| 1364 | "Call `find-file' after a possible delay (see `filesets-find-file-delay'). | 1352 | "Call `find-file' after a possible delay (see `filesets-find-file-delay'). |
| @@ -1741,8 +1729,7 @@ Assume MODE (see `filesets-entry-mode'), if provided." | |||
| 1741 | ;;(filesets-message 3 "Filesets: scanning %s" dirpatt) | 1729 | ;;(filesets-message 3 "Filesets: scanning %s" dirpatt) |
| 1742 | (filesets-directory-files dir patt ':files t)) | 1730 | (filesets-directory-files dir patt ':files t)) |
| 1743 | ;; (message "Filesets: malformed entry: %s" entry))))))) | 1731 | ;; (message "Filesets: malformed entry: %s" entry))))))) |
| 1744 | (filesets-error 'error "Filesets: malformed entry: " | 1732 | (error "Filesets: malformed entry: %s" entry))))))) |
| 1745 | entry))))))) | ||
| 1746 | (filesets-filter-list fl | 1733 | (filesets-filter-list fl |
| 1747 | (lambda (file) | 1734 | (lambda (file) |
| 1748 | (not (filesets-filetype-property file event)))))) | 1735 | (not (filesets-filetype-property file event)))))) |
| @@ -1768,7 +1755,7 @@ Use LOOKUP-NAME for searching additional data if provided." | |||
| 1768 | (dolist (this files nil) | 1755 | (dolist (this files nil) |
| 1769 | (filesets-file-open open-function this)) | 1756 | (filesets-file-open open-function this)) |
| 1770 | (message "Filesets: canceled"))) | 1757 | (message "Filesets: canceled"))) |
| 1771 | (filesets-error 'error "Filesets: Unknown fileset: " name)))) | 1758 | (error "Filesets: Unknown fileset: %s" name)))) |
| 1772 | 1759 | ||
| 1773 | (defun filesets-close (&optional mode name lookup-name) | 1760 | (defun filesets-close (&optional mode name lookup-name) |
| 1774 | "Close all buffers belonging to the fileset called NAME. | 1761 | "Close all buffers belonging to the fileset called NAME. |
| @@ -1789,7 +1776,7 @@ Use LOOKUP-NAME for deducing the save-function, if provided." | |||
| 1789 | (if buffer | 1776 | (if buffer |
| 1790 | (filesets-file-close save-function buffer))))) | 1777 | (filesets-file-close save-function buffer))))) |
| 1791 | ; (message "Filesets: Unknown fileset: `%s'" name)))) | 1778 | ; (message "Filesets: Unknown fileset: `%s'" name)))) |
| 1792 | (filesets-error 'error "Filesets: Unknown fileset: " name)))) | 1779 | (error "Filesets: Unknown fileset: %s" name)))) |
| 1793 | 1780 | ||
| 1794 | (defun filesets-add-buffer (&optional name buffer) | 1781 | (defun filesets-add-buffer (&optional name buffer) |
| 1795 | "Add BUFFER (or current buffer) to the fileset called NAME. | 1782 | "Add BUFFER (or current buffer) to the fileset called NAME. |
| @@ -1997,7 +1984,7 @@ LOOKUP-NAME is used as lookup name for retrieving fileset specific settings." | |||
| 1997 | `(["Rebuild this submenu" | 1984 | `(["Rebuild this submenu" |
| 1998 | (filesets-rebuild-this-submenu ',lookup-name)])))) | 1985 | (filesets-rebuild-this-submenu ',lookup-name)])))) |
| 1999 | (_ | 1986 | (_ |
| 2000 | (filesets-error 'error "Filesets: malformed definition of " something)))) | 1987 | (error "Filesets: malformed definition of %s" something)))) |
| 2001 | 1988 | ||
| 2002 | (defun filesets-ingroup-get-data (master pos &optional fun) | 1989 | (defun filesets-ingroup-get-data (master pos &optional fun) |
| 2003 | "Access to `filesets-ingroup-patterns'. Extract data section." | 1990 | "Access to `filesets-ingroup-patterns'. Extract data section." |
| @@ -2070,8 +2057,7 @@ LOOKUP-NAME is used as lookup name for retrieving fileset specific settings." | |||
| 2070 | (lst nil)) | 2057 | (lst nil)) |
| 2071 | (cond | 2058 | (cond |
| 2072 | ((not this-patt) | 2059 | ((not this-patt) |
| 2073 | (filesets-error 'error "Filesets: malformed :ingroup definition " | 2060 | (error "Filesets: malformed :ingroup definition %s" this-def)) |
| 2074 | this-def)) | ||
| 2075 | ((< this-sd 0) | 2061 | ((< this-sd 0) |
| 2076 | nil) | 2062 | nil) |
| 2077 | (t | 2063 | (t |
| @@ -2174,7 +2160,7 @@ FS is a fileset's name. FLIST is a list returned by | |||
| 2174 | (progn | 2160 | (progn |
| 2175 | (message "Filesets: can't parse %s" master) | 2161 | (message "Filesets: can't parse %s" master) |
| 2176 | nil) | 2162 | nil) |
| 2177 | (filesets-error 'error "Filesets: can't parse " master)))) | 2163 | (error "Filesets: can't parse %s" master)))) |
| 2178 | 2164 | ||
| 2179 | (defun filesets-build-dir-submenu-now (level depth entry lookup-name dir patt fd | 2165 | (defun filesets-build-dir-submenu-now (level depth entry lookup-name dir patt fd |
| 2180 | &optional rebuild-flag) | 2166 | &optional rebuild-flag) |
| @@ -2349,21 +2335,20 @@ bottom up, set `filesets-submenus' to nil, first.)" | |||
| 2349 | (filesets-menu-cache-file-save-maybe))) | 2335 | (filesets-menu-cache-file-save-maybe))) |
| 2350 | (let ((cb (current-buffer))) | 2336 | (let ((cb (current-buffer))) |
| 2351 | (when (not (member cb filesets-updated-buffers)) | 2337 | (when (not (member cb filesets-updated-buffers)) |
| 2352 | (add-submenu | 2338 | (easy-menu-add-item (or filesets-menu-in-menu (current-global-map)) |
| 2353 | filesets-menu-path | 2339 | (cons "menu-bar" filesets-menu-path) |
| 2354 | `(,filesets-menu-name | 2340 | `(,filesets-menu-name |
| 2355 | ("# Filesets" | 2341 | ("# Filesets" |
| 2356 | ["Edit Filesets" filesets-edit] | 2342 | ["Edit Filesets" filesets-edit] |
| 2357 | ["Save Filesets" filesets-save-config] | 2343 | ["Save Filesets" filesets-save-config] |
| 2358 | ["Save Menu Cache" filesets-menu-cache-file-save] | 2344 | ["Save Menu Cache" filesets-menu-cache-file-save] |
| 2359 | ["Rebuild Menu" filesets-build-menu] | 2345 | ["Rebuild Menu" filesets-build-menu] |
| 2360 | ["Customize" filesets-customize] | 2346 | ["Customize" filesets-customize] |
| 2361 | ["About" filesets-info]) | 2347 | ["About" filesets-info]) |
| 2362 | ,(filesets-get-cmd-menu) | 2348 | ,(filesets-get-cmd-menu) |
| 2363 | "---" | 2349 | "---" |
| 2364 | ,@filesets-menu-cache) | 2350 | ,@filesets-menu-cache) |
| 2365 | filesets-menu-before | 2351 | filesets-menu-before) |
| 2366 | filesets-menu-in-menu) | ||
| 2367 | (setq filesets-updated-buffers | 2352 | (setq filesets-updated-buffers |
| 2368 | (cons cb filesets-updated-buffers)) | 2353 | (cons cb filesets-updated-buffers)) |
| 2369 | ;; This wipes out other messages in the echo area. | 2354 | ;; This wipes out other messages in the echo area. |
| @@ -2474,7 +2459,7 @@ We apologize for the inconvenience."))) | |||
| 2474 | (insert msg) | 2459 | (insert msg) |
| 2475 | (when (y-or-n-p (format "Edit startup (%s) file now? " cf)) | 2460 | (when (y-or-n-p (format "Edit startup (%s) file now? " cf)) |
| 2476 | (find-file-other-window cf)) | 2461 | (find-file-other-window cf)) |
| 2477 | (filesets-error 'error msg)))) | 2462 | (error msg)))) |
| 2478 | 2463 | ||
| 2479 | (defun filesets-update (cached-version) | 2464 | (defun filesets-update (cached-version) |
| 2480 | "Do some cleanup after updating filesets.el." | 2465 | "Do some cleanup after updating filesets.el." |
| @@ -2510,8 +2495,7 @@ We apologize for the inconvenience."))) | |||
| 2510 | (defun filesets-init () | 2495 | (defun filesets-init () |
| 2511 | "Filesets initialization. | 2496 | "Filesets initialization. |
| 2512 | Set up hooks, load the cache file -- if existing -- and build the menu." | 2497 | Set up hooks, load the cache file -- if existing -- and build the menu." |
| 2513 | (add-hook (if (featurep 'xemacs) 'activate-menubar-hook 'menu-bar-update-hook) | 2498 | (add-hook 'menu-bar-update-hook #'filesets-build-menu-maybe) |
| 2514 | (function filesets-build-menu-maybe)) | ||
| 2515 | (add-hook 'kill-buffer-hook (function filesets-remove-from-ubl)) | 2499 | (add-hook 'kill-buffer-hook (function filesets-remove-from-ubl)) |
| 2516 | (add-hook 'first-change-hook (function filesets-reset-filename-on-change)) | 2500 | (add-hook 'first-change-hook (function filesets-reset-filename-on-change)) |
| 2517 | (add-hook 'kill-emacs-hook (function filesets-exit)) | 2501 | (add-hook 'kill-emacs-hook (function filesets-exit)) |
| @@ -2525,6 +2509,10 @@ Set up hooks, load the cache file -- if existing -- and build the menu." | |||
| 2525 | (setq filesets-menu-use-cached-flag t))) | 2509 | (setq filesets-menu-use-cached-flag t))) |
| 2526 | (filesets-build-menu))) | 2510 | (filesets-build-menu))) |
| 2527 | 2511 | ||
| 2512 | (defun filesets-error (_class &rest args) | ||
| 2513 | "`error' wrapper." | ||
| 2514 | (declare (obsolete error "28.1")) | ||
| 2515 | (error "%s" (mapconcat 'identity args " "))) | ||
| 2528 | 2516 | ||
| 2529 | (provide 'filesets) | 2517 | (provide 'filesets) |
| 2530 | 2518 | ||
diff --git a/lisp/find-lisp.el b/lisp/find-lisp.el index 352720412a5..c1be5ff403d 100644 --- a/lisp/find-lisp.el +++ b/lisp/find-lisp.el | |||
| @@ -221,15 +221,12 @@ It is a function which takes two arguments, the directory and its parent." | |||
| 221 | 221 | ||
| 222 | (make-local-variable 'revert-buffer-function) | 222 | (make-local-variable 'revert-buffer-function) |
| 223 | (setq revert-buffer-function | 223 | (setq revert-buffer-function |
| 224 | (function | 224 | (lambda (_ignore1 _ignore2) |
| 225 | (lambda (_ignore1 _ignore2) | 225 | (find-lisp-insert-directory |
| 226 | (find-lisp-insert-directory | 226 | default-directory |
| 227 | default-directory | 227 | find-lisp-file-predicate |
| 228 | find-lisp-file-predicate | 228 | find-lisp-directory-predicate |
| 229 | find-lisp-directory-predicate | 229 | 'ignore))) |
| 230 | 'ignore) | ||
| 231 | ) | ||
| 232 | )) | ||
| 233 | 230 | ||
| 234 | ;; Set subdir-alist so that Tree Dired will work: | 231 | ;; Set subdir-alist so that Tree Dired will work: |
| 235 | (if (fboundp 'dired-simple-subdir-alist) | 232 | (if (fboundp 'dired-simple-subdir-alist) |
| @@ -267,11 +264,10 @@ It is a function which takes two arguments, the directory and its parent." | |||
| 267 | (insert find-lisp-line-indent "\n") | 264 | (insert find-lisp-line-indent "\n") |
| 268 | ;; Run the find function | 265 | ;; Run the find function |
| 269 | (mapc | 266 | (mapc |
| 270 | (function | 267 | (lambda (file) |
| 271 | (lambda (file) | 268 | (find-lisp-find-dired-insert-file |
| 272 | (find-lisp-find-dired-insert-file | 269 | (substring file len) |
| 273 | (substring file len) | 270 | (current-buffer))) |
| 274 | (current-buffer)))) | ||
| 275 | (sort files 'string-lessp)) | 271 | (sort files 'string-lessp)) |
| 276 | ;; FIXME: Sort function is ignored for now | 272 | ;; FIXME: Sort function is ignored for now |
| 277 | ;; (funcall sort-function files)) | 273 | ;; (funcall sort-function files)) |
diff --git a/lisp/generic-x.el b/lisp/generic-x.el index 48ac1232051..5875dce5f03 100644 --- a/lisp/generic-x.el +++ b/lisp/generic-x.el | |||
| @@ -107,8 +107,6 @@ | |||
| 107 | 107 | ||
| 108 | ;;; Code: | 108 | ;;; Code: |
| 109 | 109 | ||
| 110 | (eval-when-compile (require 'font-lock)) | ||
| 111 | |||
| 112 | (defgroup generic-x nil | 110 | (defgroup generic-x nil |
| 113 | "A collection of generic modes." | 111 | "A collection of generic modes." |
| 114 | :prefix "generic-" | 112 | :prefix "generic-" |
| @@ -280,12 +278,11 @@ your changes into effect." | |||
| 280 | ("^\\s-*\\(\\sw+\\)\\s-" 1 font-lock-variable-name-face)) | 278 | ("^\\s-*\\(\\sw+\\)\\s-" 1 font-lock-variable-name-face)) |
| 281 | '("srm\\.conf\\'" "httpd\\.conf\\'" "access\\.conf\\'") | 279 | '("srm\\.conf\\'" "httpd\\.conf\\'" "access\\.conf\\'") |
| 282 | (list | 280 | (list |
| 283 | (function | 281 | (lambda () |
| 284 | (lambda () | 282 | (setq imenu-generic-expression |
| 285 | (setq imenu-generic-expression | 283 | '((nil "^\\([-A-Za-z0-9_]+\\)" 1) |
| 286 | '((nil "^\\([-A-Za-z0-9_]+\\)" 1) | 284 | ("*Directories*" "^\\s-*<Directory\\s-*\\([^>]+\\)>" 1) |
| 287 | ("*Directories*" "^\\s-*<Directory\\s-*\\([^>]+\\)>" 1) | 285 | ("*Locations*" "^\\s-*<Location\\s-*\\([^>]+\\)>" 1))))) |
| 288 | ("*Locations*" "^\\s-*<Location\\s-*\\([^>]+\\)>" 1)))))) | ||
| 289 | "Generic mode for Apache or HTTPD configuration files.")) | 286 | "Generic mode for Apache or HTTPD configuration files.")) |
| 290 | 287 | ||
| 291 | (when (memq 'apache-log-generic-mode generic-extras-enable-list) | 288 | (when (memq 'apache-log-generic-mode generic-extras-enable-list) |
| @@ -401,11 +398,10 @@ your changes into effect." | |||
| 401 | (2 font-lock-variable-name-face))) | 398 | (2 font-lock-variable-name-face))) |
| 402 | '("\\.[iI][nN][iI]\\'") | 399 | '("\\.[iI][nN][iI]\\'") |
| 403 | (list | 400 | (list |
| 404 | (function | 401 | (lambda () |
| 405 | (lambda () | 402 | (setq imenu-generic-expression |
| 406 | (setq imenu-generic-expression | 403 | '((nil "^\\[\\(.*\\)\\]" 1) |
| 407 | '((nil "^\\[\\(.*\\)\\]" 1) | 404 | ("*Variables*" "^\\s-*\\([^=]+\\)\\s-*=" 1))))) |
| 408 | ("*Variables*" "^\\s-*\\([^=]+\\)\\s-*=" 1)))))) | ||
| 409 | "Generic mode for MS-Windows INI files. | 405 | "Generic mode for MS-Windows INI files. |
| 410 | You can use `ini-generic-mode-find-file-hook' to enter this mode | 406 | You can use `ini-generic-mode-find-file-hook' to enter this mode |
| 411 | automatically for INI files whose names do not end in \".ini\".") | 407 | automatically for INI files whose names do not end in \".ini\".") |
| @@ -432,10 +428,9 @@ like an INI file. You can add this hook to `find-file-hook'." | |||
| 432 | ("^\\([^\n\r]*\\)\\s-*=" 1 font-lock-variable-name-face)) | 428 | ("^\\([^\n\r]*\\)\\s-*=" 1 font-lock-variable-name-face)) |
| 433 | '("\\.[rR][eE][gG]\\'") | 429 | '("\\.[rR][eE][gG]\\'") |
| 434 | (list | 430 | (list |
| 435 | (function | 431 | (lambda () |
| 436 | (lambda () | 432 | (setq imenu-generic-expression |
| 437 | (setq imenu-generic-expression | 433 | '((nil "^\\s-*\\(.*\\)\\s-*=" 1))))) |
| 438 | '((nil "^\\s-*\\(.*\\)\\s-*=" 1)))))) | ||
| 439 | "Generic mode for MS-Windows Registry files.")) | 434 | "Generic mode for MS-Windows Registry files.")) |
| 440 | 435 | ||
| 441 | (declare-function w32-shell-name "w32-fns" ()) | 436 | (declare-function w32-shell-name "w32-fns" ()) |
| @@ -456,10 +451,9 @@ like an INI file. You can add this hook to `find-file-hook'." | |||
| 456 | ("\\s-/\\([^/]+\\)/[i, \t\n]" 1 font-lock-constant-face)) | 451 | ("\\s-/\\([^/]+\\)/[i, \t\n]" 1 font-lock-constant-face)) |
| 457 | '("\\.rules\\'") | 452 | '("\\.rules\\'") |
| 458 | (list | 453 | (list |
| 459 | (function | 454 | (lambda () |
| 460 | (lambda () | 455 | (setq imenu-generic-expression |
| 461 | (setq imenu-generic-expression | 456 | '((nil "\\s-/\\([^/]+\\)/[i, \t\n]" 1))))) |
| 462 | '((nil "\\s-/\\([^/]+\\)/[i, \t\n]" 1)))))) | ||
| 463 | "Generic mode for Mailagent rules files.")) | 457 | "Generic mode for Mailagent rules files.")) |
| 464 | 458 | ||
| 465 | ;; Solaris/Sys V prototype files | 459 | ;; Solaris/Sys V prototype files |
| @@ -548,13 +542,12 @@ like an INI file. You can add this hook to `find-file-hook'." | |||
| 548 | (2 font-lock-variable-name-face))) | 542 | (2 font-lock-variable-name-face))) |
| 549 | '("\\.wrl\\'") | 543 | '("\\.wrl\\'") |
| 550 | (list | 544 | (list |
| 551 | (function | 545 | (lambda () |
| 552 | (lambda () | 546 | (setq imenu-generic-expression |
| 553 | (setq imenu-generic-expression | 547 | '((nil "^\\([A-Za-z0-9_]+\\)\\s-*{" 1) |
| 554 | '((nil "^\\([A-Za-z0-9_]+\\)\\s-*{" 1) | 548 | ("*Definitions*" |
| 555 | ("*Definitions*" | 549 | "DEF\\s-+\\([-A-Za-z0-9_]+\\)\\s-+\\([A-Za-z0-9]+\\)\\s-*{" |
| 556 | "DEF\\s-+\\([-A-Za-z0-9_]+\\)\\s-+\\([A-Za-z0-9]+\\)\\s-*{" | 550 | 1))))) |
| 557 | 1)))))) | ||
| 558 | "Generic Mode for VRML files.")) | 551 | "Generic Mode for VRML files.")) |
| 559 | 552 | ||
| 560 | ;; Java Manifests | 553 | ;; Java Manifests |
| @@ -594,20 +587,18 @@ like an INI file. You can add this hook to `find-file-hook'." | |||
| 594 | ;; * an equal sign | 587 | ;; * an equal sign |
| 595 | ;; * a colon | 588 | ;; * a colon |
| 596 | (mapcar | 589 | (mapcar |
| 597 | (function | 590 | (lambda (elt) |
| 598 | (lambda (elt) | 591 | (list |
| 599 | (list | 592 | (concat "^" java-properties-key elt java-properties-value "$") |
| 600 | (concat "^" java-properties-key elt java-properties-value "$") | 593 | '(1 font-lock-constant-face) |
| 601 | '(1 font-lock-constant-face) | 594 | '(4 font-lock-variable-name-face))) |
| 602 | '(4 font-lock-variable-name-face)))) | ||
| 603 | ;; These are the separators | 595 | ;; These are the separators |
| 604 | '(":\\s-*" "\\s-+" "\\s-*=\\s-*")))) | 596 | '(":\\s-*" "\\s-+" "\\s-*=\\s-*")))) |
| 605 | nil | 597 | nil |
| 606 | (list | 598 | (list |
| 607 | (function | 599 | (lambda () |
| 608 | (lambda () | 600 | (setq imenu-generic-expression |
| 609 | (setq imenu-generic-expression | 601 | '((nil "^\\([^#! \t\n\r=:]+\\)" 1))))) |
| 610 | '((nil "^\\([^#! \t\n\r=:]+\\)" 1)))))) | ||
| 611 | "Generic mode for Java properties files.")) | 602 | "Generic mode for Java properties files.")) |
| 612 | 603 | ||
| 613 | ;; C shell alias definitions | 604 | ;; C shell alias definitions |
| @@ -622,10 +613,9 @@ like an INI file. You can add this hook to `find-file-hook'." | |||
| 622 | (1 font-lock-variable-name-face))) | 613 | (1 font-lock-variable-name-face))) |
| 623 | '("alias\\'") | 614 | '("alias\\'") |
| 624 | (list | 615 | (list |
| 625 | (function | 616 | (lambda () |
| 626 | (lambda () | 617 | (setq imenu-generic-expression |
| 627 | (setq imenu-generic-expression | 618 | '((nil "^\\(alias\\|unalias\\)\\s-+\\([-a-zA-Z0-9_]+\\)" 2))))) |
| 628 | '((nil "^\\(alias\\|unalias\\)\\s-+\\([-a-zA-Z0-9_]+\\)" 2)))))) | ||
| 629 | "Generic mode for C Shell alias files.")) | 619 | "Generic mode for C Shell alias files.")) |
| 630 | 620 | ||
| 631 | ;; Ansible inventory files | 621 | ;; Ansible inventory files |
| @@ -645,11 +635,10 @@ like an INI file. You can add this hook to `find-file-hook'." | |||
| 645 | (2 font-lock-keyword-face))) | 635 | (2 font-lock-keyword-face))) |
| 646 | '("inventory\\'") | 636 | '("inventory\\'") |
| 647 | (list | 637 | (list |
| 648 | (function | 638 | (lambda () |
| 649 | (lambda () | 639 | (setq imenu-generic-expression |
| 650 | (setq imenu-generic-expression | 640 | '((nil "^\\s-*\\[\\(.*\\)\\]" 1) |
| 651 | '((nil "^\\s-*\\[\\(.*\\)\\]" 1) | 641 | ("*Variables*" "\\s-+\\([^ =\n\r]+\\)=" 1))))) |
| 652 | ("*Variables*" "\\s-+\\([^ =\n\r]+\\)=" 1)))))) | ||
| 653 | "Generic mode for Ansible inventory files.")) | 642 | "Generic mode for Ansible inventory files.")) |
| 654 | 643 | ||
| 655 | ;;; Windows RC files | 644 | ;;; Windows RC files |
| @@ -1432,10 +1421,9 @@ like an INI file. You can add this hook to `find-file-hook'." | |||
| 1432 | '(("^\\([-A-Za-z0-9_]+\\)" 1 font-lock-type-face)) | 1421 | '(("^\\([-A-Za-z0-9_]+\\)" 1 font-lock-type-face)) |
| 1433 | '("/etc/inetd\\.conf\\'") | 1422 | '("/etc/inetd\\.conf\\'") |
| 1434 | (list | 1423 | (list |
| 1435 | (function | 1424 | (lambda () |
| 1436 | (lambda () | 1425 | (setq imenu-generic-expression |
| 1437 | (setq imenu-generic-expression | 1426 | '((nil "^\\([-A-Za-z0-9_]+\\)" 1))))))) |
| 1438 | '((nil "^\\([-A-Za-z0-9_]+\\)" 1)))))))) | ||
| 1439 | 1427 | ||
| 1440 | ;; Services | 1428 | ;; Services |
| 1441 | (when (memq 'etc-services-generic-mode generic-extras-enable-list) | 1429 | (when (memq 'etc-services-generic-mode generic-extras-enable-list) |
| @@ -1450,10 +1438,9 @@ like an INI file. You can add this hook to `find-file-hook'." | |||
| 1450 | (2 font-lock-variable-name-face))) | 1438 | (2 font-lock-variable-name-face))) |
| 1451 | '("/etc/services\\'") | 1439 | '("/etc/services\\'") |
| 1452 | (list | 1440 | (list |
| 1453 | (function | 1441 | (lambda () |
| 1454 | (lambda () | 1442 | (setq imenu-generic-expression |
| 1455 | (setq imenu-generic-expression | 1443 | '((nil "^\\([-A-Za-z0-9_]+\\)" 1))))))) |
| 1456 | '((nil "^\\([-A-Za-z0-9_]+\\)" 1)))))))) | ||
| 1457 | 1444 | ||
| 1458 | ;; Password and Group files | 1445 | ;; Password and Group files |
| 1459 | (when (memq 'etc-passwd-generic-mode generic-extras-enable-list) | 1446 | (when (memq 'etc-passwd-generic-mode generic-extras-enable-list) |
| @@ -1493,10 +1480,9 @@ like an INI file. You can add this hook to `find-file-hook'." | |||
| 1493 | ;; /etc/passwd- is a backup file for /etc/passwd, so is group- and shadow- | 1480 | ;; /etc/passwd- is a backup file for /etc/passwd, so is group- and shadow- |
| 1494 | '("/etc/passwd-?\\'" "/etc/group-?\\'" "/etc/shadow-?\\'") | 1481 | '("/etc/passwd-?\\'" "/etc/group-?\\'" "/etc/shadow-?\\'") |
| 1495 | (list | 1482 | (list |
| 1496 | (function | 1483 | (lambda () |
| 1497 | (lambda () | 1484 | (setq imenu-generic-expression |
| 1498 | (setq imenu-generic-expression | 1485 | '((nil "^\\([-A-Za-z0-9_]+\\):" 1))))))) |
| 1499 | '((nil "^\\([-A-Za-z0-9_]+\\):" 1)))))))) | ||
| 1500 | 1486 | ||
| 1501 | ;; Fstab | 1487 | ;; Fstab |
| 1502 | (when (memq 'etc-fstab-generic-mode generic-extras-enable-list) | 1488 | (when (memq 'etc-fstab-generic-mode generic-extras-enable-list) |
| @@ -1547,10 +1533,9 @@ like an INI file. You can add this hook to `find-file-hook'." | |||
| 1547 | (2 font-lock-variable-name-face t))) | 1533 | (2 font-lock-variable-name-face t))) |
| 1548 | '("/etc/[v]*fstab\\'") | 1534 | '("/etc/[v]*fstab\\'") |
| 1549 | (list | 1535 | (list |
| 1550 | (function | 1536 | (lambda () |
| 1551 | (lambda () | 1537 | (setq imenu-generic-expression |
| 1552 | (setq imenu-generic-expression | 1538 | '((nil "^\\([^# \t]+\\)\\s-+" 1))))))) |
| 1553 | '((nil "^\\([^# \t]+\\)\\s-+" 1)))))))) | ||
| 1554 | 1539 | ||
| 1555 | ;; /etc/sudoers | 1540 | ;; /etc/sudoers |
| 1556 | (when (memq 'etc-sudoers-generic-mode generic-extras-enable-list) | 1541 | (when (memq 'etc-sudoers-generic-mode generic-extras-enable-list) |
| @@ -1710,9 +1695,8 @@ like an INI file. You can add this hook to `find-file-hook'." | |||
| 1710 | (list | 1695 | (list |
| 1711 | 'generic-bracket-support | 1696 | 'generic-bracket-support |
| 1712 | ;; Make keywords case-insensitive | 1697 | ;; Make keywords case-insensitive |
| 1713 | (function | 1698 | (lambda () |
| 1714 | (lambda() | 1699 | (setq font-lock-defaults '(generic-font-lock-keywords nil t)))) |
| 1715 | (setq font-lock-defaults '(generic-font-lock-keywords nil t))))) | ||
| 1716 | "Generic mode for SPICE circuit netlist files.")) | 1700 | "Generic mode for SPICE circuit netlist files.")) |
| 1717 | 1701 | ||
| 1718 | (when (memq 'ibis-generic-mode generic-extras-enable-list) | 1702 | (when (memq 'ibis-generic-mode generic-extras-enable-list) |
| @@ -1758,9 +1742,8 @@ like an INI file. You can add this hook to `find-file-hook'." | |||
| 1758 | (list | 1742 | (list |
| 1759 | 'generic-bracket-support | 1743 | 'generic-bracket-support |
| 1760 | ;; Make keywords case-insensitive | 1744 | ;; Make keywords case-insensitive |
| 1761 | (function | 1745 | (lambda () |
| 1762 | (lambda() | 1746 | (setq font-lock-defaults '(generic-font-lock-keywords nil t)))) |
| 1763 | (setq font-lock-defaults '(generic-font-lock-keywords nil t))))) | ||
| 1764 | "Generic mode for ASTAP circuit netlist files.")) | 1747 | "Generic mode for ASTAP circuit netlist files.")) |
| 1765 | 1748 | ||
| 1766 | (when (memq 'etc-modules-conf-generic-mode generic-extras-enable-list) | 1749 | (when (memq 'etc-modules-conf-generic-mode generic-extras-enable-list) |
diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el index 76c2904eaf0..053e7ea1f6b 100644 --- a/lisp/gnus/gnus-agent.el +++ b/lisp/gnus/gnus-agent.el | |||
| @@ -3567,22 +3567,21 @@ articles in every agentized group? ")) | |||
| 3567 | (let* (delete-recursive | 3567 | (let* (delete-recursive |
| 3568 | files f | 3568 | files f |
| 3569 | (delete-recursive | 3569 | (delete-recursive |
| 3570 | (function | 3570 | (lambda (f-or-d) |
| 3571 | (lambda (f-or-d) | 3571 | (ignore-errors |
| 3572 | (ignore-errors | 3572 | (if (file-directory-p f-or-d) |
| 3573 | (if (file-directory-p f-or-d) | 3573 | (condition-case nil |
| 3574 | (condition-case nil | 3574 | (delete-directory f-or-d) |
| 3575 | (delete-directory f-or-d) | 3575 | (file-error |
| 3576 | (file-error | 3576 | (setq files (directory-files f-or-d)) |
| 3577 | (setq files (directory-files f-or-d)) | 3577 | (while files |
| 3578 | (while files | 3578 | (setq f (pop files)) |
| 3579 | (setq f (pop files)) | 3579 | (or (member f '("." "..")) |
| 3580 | (or (member f '("." "..")) | 3580 | (funcall delete-recursive |
| 3581 | (funcall delete-recursive | 3581 | (nnheader-concat |
| 3582 | (nnheader-concat | 3582 | f-or-d f)))) |
| 3583 | f-or-d f)))) | 3583 | (delete-directory f-or-d))) |
| 3584 | (delete-directory f-or-d))) | 3584 | (delete-file f-or-d)))))) |
| 3585 | (delete-file f-or-d))))))) | ||
| 3586 | (funcall delete-recursive dir))))))))) | 3585 | (funcall delete-recursive dir))))))))) |
| 3587 | 3586 | ||
| 3588 | ;;;###autoload | 3587 | ;;;###autoload |
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 1efc1d6f7d9..8f4ca7eb3b9 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el | |||
| @@ -6175,7 +6175,6 @@ If nil, don't show those extra buttons." | |||
| 6175 | face ,gnus-article-button-face | 6175 | face ,gnus-article-button-face |
| 6176 | follow-link t | 6176 | follow-link t |
| 6177 | gnus-part ,id | 6177 | gnus-part ,id |
| 6178 | button t | ||
| 6179 | article-type multipart | 6178 | article-type multipart |
| 6180 | rear-nonsticky t)) | 6179 | rear-nonsticky t)) |
| 6181 | ;; Do the handles | 6180 | ;; Do the handles |
| @@ -6200,6 +6199,7 @@ If nil, don't show those extra buttons." | |||
| 6200 | follow-link t | 6199 | follow-link t |
| 6201 | gnus-part ,id | 6200 | gnus-part ,id |
| 6202 | button t | 6201 | button t |
| 6202 | category t | ||
| 6203 | gnus-data ,handle | 6203 | gnus-data ,handle |
| 6204 | rear-nonsticky t)) | 6204 | rear-nonsticky t)) |
| 6205 | (insert " ")) | 6205 | (insert " ")) |
diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el index 17f1108029c..498da200dab 100644 --- a/lisp/gnus/gnus-search.el +++ b/lisp/gnus/gnus-search.el | |||
| @@ -2101,9 +2101,10 @@ article came from is also searched." | |||
| 2101 | (defun gnus-search--complete-key-data () | 2101 | (defun gnus-search--complete-key-data () |
| 2102 | "Potentially return completion data for a search key or value." | 2102 | "Potentially return completion data for a search key or value." |
| 2103 | (let* ((key-start (save-excursion | 2103 | (let* ((key-start (save-excursion |
| 2104 | (if (re-search-backward " " (minibuffer-prompt-end) t) | 2104 | (or (re-search-backward " " (minibuffer-prompt-end) t) |
| 2105 | (1+ (point)) | 2105 | (goto-char (minibuffer-prompt-end))) |
| 2106 | (minibuffer-prompt-end)))) | 2106 | (skip-chars-forward " -") |
| 2107 | (point))) | ||
| 2107 | (after-colon (save-excursion | 2108 | (after-colon (save-excursion |
| 2108 | (when (re-search-backward ":" key-start t) | 2109 | (when (re-search-backward ":" key-start t) |
| 2109 | (1+ (point))))) | 2110 | (1+ (point))))) |
| @@ -2113,7 +2114,7 @@ article came from is also searched." | |||
| 2113 | ;; only handle in a contact-completion context. | 2114 | ;; only handle in a contact-completion context. |
| 2114 | (when (and gnus-search-contact-tables | 2115 | (when (and gnus-search-contact-tables |
| 2115 | (save-excursion | 2116 | (save-excursion |
| 2116 | (re-search-backward "\\<\\(\\w+\\):" key-start t) | 2117 | (re-search-backward "\\<-?\\(\\w+\\):" key-start t) |
| 2117 | (member (match-string 1) | 2118 | (member (match-string 1) |
| 2118 | '("from" "to" "cc" | 2119 | '("from" "to" "cc" |
| 2119 | "bcc" "recipient" "address")))) | 2120 | "bcc" "recipient" "address")))) |
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 0782778fd43..5bdf53763a2 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el | |||
| @@ -7651,7 +7651,7 @@ Optional DIGEST will use digest to forward." | |||
| 7651 | ;; Consider there is no illegible text. | 7651 | ;; Consider there is no illegible text. |
| 7652 | (add-text-properties | 7652 | (add-text-properties |
| 7653 | b (point) | 7653 | b (point) |
| 7654 | '(no-illegible-text t rear-nonsticky t start-open t)))) | 7654 | '(no-illegible-text t rear-nonsticky t)))) |
| 7655 | 7655 | ||
| 7656 | (defun message-forward-make-body-mml (forward-buffer) | 7656 | (defun message-forward-make-body-mml (forward-buffer) |
| 7657 | (insert "\n\n<#mml type=message/rfc822 disposition=inline>\n") | 7657 | (insert "\n\n<#mml type=message/rfc822 disposition=inline>\n") |
diff --git a/lisp/gnus/nnmairix.el b/lisp/gnus/nnmairix.el index dcecfcf6519..e53e000beae 100644 --- a/lisp/gnus/nnmairix.el +++ b/lisp/gnus/nnmairix.el | |||
| @@ -1548,9 +1548,8 @@ See %s for details" proc nnmairix-mairix-output-buffer))) | |||
| 1548 | (defun nnmairix-create-message-line-for-search () | 1548 | (defun nnmairix-create-message-line-for-search () |
| 1549 | "Create message line for interactive query in minibuffer." | 1549 | "Create message line for interactive query in minibuffer." |
| 1550 | (mapconcat | 1550 | (mapconcat |
| 1551 | (function | 1551 | (lambda (cur) |
| 1552 | (lambda (cur) | 1552 | (format "%c=%s" (car cur) (nth 3 cur))) |
| 1553 | (format "%c=%s" (car cur) (nth 3 cur)))) | ||
| 1554 | nnmairix-interactive-query-parameters ",")) | 1553 | nnmairix-interactive-query-parameters ",")) |
| 1555 | 1554 | ||
| 1556 | (defun nnmairix-replace-illegal-chars (header) | 1555 | (defun nnmairix-replace-illegal-chars (header) |
| @@ -1811,13 +1810,12 @@ If VERSION is a string: must be contained in mairix version output." | |||
| 1811 | (gnus-summary-toggle-header 1) | 1810 | (gnus-summary-toggle-header 1) |
| 1812 | (set-buffer gnus-article-buffer) | 1811 | (set-buffer gnus-article-buffer) |
| 1813 | (mapcar | 1812 | (mapcar |
| 1814 | (function | 1813 | (lambda (field) |
| 1815 | (lambda (field) | 1814 | (list (car (cddr field)) |
| 1816 | (list (car (cddr field)) | 1815 | (if (car field) |
| 1817 | (if (car field) | 1816 | (nnmairix-replace-illegal-chars |
| 1818 | (nnmairix-replace-illegal-chars | 1817 | (gnus-fetch-field (car field))) |
| 1819 | (gnus-fetch-field (car field))) | 1818 | nil))) |
| 1820 | nil)))) | ||
| 1821 | nnmairix-widget-fields-list)))) | 1819 | nnmairix-widget-fields-list)))) |
| 1822 | 1820 | ||
| 1823 | 1821 | ||
| @@ -1911,14 +1909,13 @@ If WITHVALUES is t, query is based on current article." | |||
| 1911 | (when (member 'flags nnmairix-widget-other) | 1909 | (when (member 'flags nnmairix-widget-other) |
| 1912 | (setq flag | 1910 | (setq flag |
| 1913 | (mapconcat | 1911 | (mapconcat |
| 1914 | (function | 1912 | (lambda (flag) |
| 1915 | (lambda (flag) | 1913 | (setq temp |
| 1916 | (setq temp | 1914 | (widget-value (cadr (assoc (car flag) nnmairix-widgets)))) |
| 1917 | (widget-value (cadr (assoc (car flag) nnmairix-widgets)))) | 1915 | (if (string= "yes" temp) |
| 1918 | (if (string= "yes" temp) | 1916 | (cadr flag) |
| 1919 | (cadr flag) | 1917 | (if (string= "no" temp) |
| 1920 | (if (string= "no" temp) | 1918 | (concat "-" (cadr flag))))) |
| 1921 | (concat "-" (cadr flag)))))) | ||
| 1922 | '(("seen" "s") ("replied" "r") ("flagged" "f")) "")) | 1919 | '(("seen" "s") ("replied" "r") ("flagged" "f")) "")) |
| 1923 | (when (not (zerop (length flag))) | 1920 | (when (not (zerop (length flag))) |
| 1924 | (push (concat "F:" flag) query))) | 1921 | (push (concat "F:" flag) query))) |
| @@ -1968,32 +1965,31 @@ VALUES may contain values for editable fields from current article." | |||
| 1968 | ;; how can this be done less ugly? | 1965 | ;; how can this be done less ugly? |
| 1969 | (let ((ret)) | 1966 | (let ((ret)) |
| 1970 | (mapc | 1967 | (mapc |
| 1971 | (function | 1968 | (lambda (field) |
| 1972 | (lambda (field) | 1969 | (setq field (car (cddr field))) |
| 1973 | (setq field (car (cddr field))) | 1970 | (setq ret |
| 1974 | (setq ret | 1971 | (nconc |
| 1975 | (nconc | 1972 | (list |
| 1976 | (list | 1973 | (list |
| 1977 | (list | 1974 | (concat "c" field) |
| 1978 | (concat "c" field) | 1975 | (widget-create 'checkbox |
| 1979 | (widget-create 'checkbox | 1976 | :tag field |
| 1980 | :tag field | 1977 | :notify (lambda (widget &rest ignore) |
| 1981 | :notify (lambda (widget &rest ignore) | 1978 | (nnmairix-widget-toggle-activate widget)) |
| 1982 | (nnmairix-widget-toggle-activate widget)) | 1979 | nil))) |
| 1983 | nil))) | 1980 | (list |
| 1984 | (list | 1981 | (list |
| 1985 | (list | 1982 | (concat "e" field) |
| 1986 | (concat "e" field) | 1983 | (widget-create 'editable-field |
| 1987 | (widget-create 'editable-field | 1984 | :size 60 |
| 1988 | :size 60 | 1985 | :format (concat " " field ":" |
| 1989 | :format (concat " " field ":" | 1986 | (make-string (- 11 (length field)) ?\ ) |
| 1990 | (make-string (- 11 (length field)) ?\ ) | 1987 | "%v") |
| 1991 | "%v") | 1988 | :value (or (cadr (assoc field values)) "")))) |
| 1992 | :value (or (cadr (assoc field values)) "")))) | 1989 | ret)) |
| 1993 | ret)) | 1990 | (widget-insert "\n") |
| 1994 | (widget-insert "\n") | 1991 | ;; Deactivate editable field |
| 1995 | ;; Deactivate editable field | 1992 | (widget-apply (cadr (nth 1 ret)) :deactivate)) |
| 1996 | (widget-apply (cadr (nth 1 ret)) :deactivate))) | ||
| 1997 | nnmairix-widget-fields-list) | 1993 | nnmairix-widget-fields-list) |
| 1998 | ret)) | 1994 | ret)) |
| 1999 | 1995 | ||
diff --git a/lisp/help.el b/lisp/help.el index 7eb50fd5451..8dac6dcd332 100644 --- a/lisp/help.el +++ b/lisp/help.el | |||
| @@ -1310,6 +1310,7 @@ TRANSL, PARTIAL, SHADOW, NOMENU, MENTION-SHADOW are as in | |||
| 1310 | ((and mention-shadow (not (eq tem definition))) | 1310 | ((and mention-shadow (not (eq tem definition))) |
| 1311 | (setq this-shadowed t)) | 1311 | (setq this-shadowed t)) |
| 1312 | (t nil)))) | 1312 | (t nil)))) |
| 1313 | (eq definition (lookup-key tail (vector event) t)) | ||
| 1313 | (push (list event definition this-shadowed) vect)))) | 1314 | (push (list event definition this-shadowed) vect)))) |
| 1314 | ((eq (car tail) 'keymap) | 1315 | ((eq (car tail) 'keymap) |
| 1315 | ;; The same keymap might be in the structure twice, if | 1316 | ;; The same keymap might be in the structure twice, if |
diff --git a/lisp/ibuf-ext.el b/lisp/ibuf-ext.el index 80c5b073985..79342976746 100644 --- a/lisp/ibuf-ext.el +++ b/lisp/ibuf-ext.el | |||
| @@ -208,11 +208,9 @@ either clicking or hitting return " | |||
| 208 | 'follow-link t | 208 | 'follow-link t |
| 209 | 'help-echo "Click or RET: save new value in customize" | 209 | 'help-echo "Click or RET: save new value in customize" |
| 210 | 'action (lambda (_) | 210 | 'action (lambda (_) |
| 211 | (if (not (fboundp 'customize-save-variable)) | 211 | (customize-save-variable 'ibuffer-saved-filters |
| 212 | (message "Customize not available; value not saved") | 212 | ibuffer-saved-filters) |
| 213 | (customize-save-variable 'ibuffer-saved-filters | 213 | (message "Saved updated ibuffer-saved-filters."))) |
| 214 | ibuffer-saved-filters) | ||
| 215 | (message "Saved updated ibuffer-saved-filters.")))) | ||
| 216 | ". See below for | 214 | ". See below for |
| 217 | an explanation and alternative ways to save the repaired value. | 215 | an explanation and alternative ways to save the repaired value. |
| 218 | 216 | ||
| @@ -1116,13 +1114,10 @@ filter into parts." | |||
| 1116 | 1114 | ||
| 1117 | (defun ibuffer-maybe-save-stuff () | 1115 | (defun ibuffer-maybe-save-stuff () |
| 1118 | (when ibuffer-save-with-custom | 1116 | (when ibuffer-save-with-custom |
| 1119 | (if (fboundp 'customize-save-variable) | 1117 | (customize-save-variable 'ibuffer-saved-filters |
| 1120 | (progn | 1118 | ibuffer-saved-filters) |
| 1121 | (customize-save-variable 'ibuffer-saved-filters | 1119 | (customize-save-variable 'ibuffer-saved-filter-groups |
| 1122 | ibuffer-saved-filters) | 1120 | ibuffer-saved-filter-groups))) |
| 1123 | (customize-save-variable 'ibuffer-saved-filter-groups | ||
| 1124 | ibuffer-saved-filter-groups)) | ||
| 1125 | (message "Not saved permanently: Customize not available")))) | ||
| 1126 | 1121 | ||
| 1127 | ;;;###autoload | 1122 | ;;;###autoload |
| 1128 | (defun ibuffer-save-filters (name filters) | 1123 | (defun ibuffer-save-filters (name filters) |
diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index 1e6fea8578c..d361971a1fc 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el | |||
| @@ -441,56 +441,55 @@ non-nil, it is used to sort CODINGS instead." | |||
| 441 | (most-preferred (car from-priority)) | 441 | (most-preferred (car from-priority)) |
| 442 | (lang-preferred (get-language-info current-language-environment | 442 | (lang-preferred (get-language-info current-language-environment |
| 443 | 'coding-system)) | 443 | 'coding-system)) |
| 444 | (func (function | 444 | (func (lambda (x) |
| 445 | (lambda (x) | 445 | (let ((base (coding-system-base x))) |
| 446 | (let ((base (coding-system-base x))) | 446 | ;; We calculate the priority number 0..255 by |
| 447 | ;; We calculate the priority number 0..255 by | 447 | ;; using the 8 bits PMMLCEII as this: |
| 448 | ;; using the 8 bits PMMLCEII as this: | 448 | ;; P: 1 if most preferred. |
| 449 | ;; P: 1 if most preferred. | 449 | ;; MM: greater than 0 if mime-charset. |
| 450 | ;; MM: greater than 0 if mime-charset. | 450 | ;; L: 1 if one of the current lang. env.'s codings. |
| 451 | ;; L: 1 if one of the current lang. env.'s codings. | 451 | ;; C: 1 if one of codings listed in the category list. |
| 452 | ;; C: 1 if one of codings listed in the category list. | 452 | ;; E: 1 if not XXX-with-esc |
| 453 | ;; E: 1 if not XXX-with-esc | 453 | ;; II: if iso-2022 based, 0..3, else 1. |
| 454 | ;; II: if iso-2022 based, 0..3, else 1. | 454 | (logior |
| 455 | (logior | 455 | (ash (if (eq base most-preferred) 1 0) 7) |
| 456 | (ash (if (eq base most-preferred) 1 0) 7) | 456 | (ash |
| 457 | (ash | 457 | (let ((mime (coding-system-get base :mime-charset))) |
| 458 | (let ((mime (coding-system-get base :mime-charset))) | 458 | ;; Prefer coding systems corresponding to a |
| 459 | ;; Prefer coding systems corresponding to a | 459 | ;; MIME charset. |
| 460 | ;; MIME charset. | 460 | (if mime |
| 461 | (if mime | 461 | ;; Lower utf-16 priority so that we |
| 462 | ;; Lower utf-16 priority so that we | 462 | ;; normally prefer utf-8 to it, and put |
| 463 | ;; normally prefer utf-8 to it, and put | 463 | ;; x-ctext below that. |
| 464 | ;; x-ctext below that. | 464 | (cond ((string-match-p "utf-16" |
| 465 | (cond ((string-match-p "utf-16" | 465 | (symbol-name mime)) |
| 466 | (symbol-name mime)) | 466 | 2) |
| 467 | 2) | 467 | ((string-match-p "^x-" (symbol-name mime)) |
| 468 | ((string-match-p "^x-" (symbol-name mime)) | 468 | 1) |
| 469 | 1) | 469 | (t 3)) |
| 470 | (t 3)) | 470 | 0)) |
| 471 | 0)) | 471 | 5) |
| 472 | 5) | 472 | (ash (if (memq base lang-preferred) 1 0) 4) |
| 473 | (ash (if (memq base lang-preferred) 1 0) 4) | 473 | (ash (if (memq base from-priority) 1 0) 3) |
| 474 | (ash (if (memq base from-priority) 1 0) 3) | 474 | (ash (if (string-match-p "-with-esc\\'" |
| 475 | (ash (if (string-match-p "-with-esc\\'" | 475 | (symbol-name base)) |
| 476 | (symbol-name base)) | 476 | 0 1) 2) |
| 477 | 0 1) 2) | 477 | (if (eq (coding-system-type base) 'iso-2022) |
| 478 | (if (eq (coding-system-type base) 'iso-2022) | 478 | (let ((category (coding-system-category base))) |
| 479 | (let ((category (coding-system-category base))) | 479 | ;; For ISO based coding systems, prefer |
| 480 | ;; For ISO based coding systems, prefer | 480 | ;; one that doesn't use designation nor |
| 481 | ;; one that doesn't use designation nor | 481 | ;; locking/single shifting. |
| 482 | ;; locking/single shifting. | 482 | (cond |
| 483 | (cond | 483 | ((or (eq category 'coding-category-iso-8-1) |
| 484 | ((or (eq category 'coding-category-iso-8-1) | 484 | (eq category 'coding-category-iso-8-2)) |
| 485 | (eq category 'coding-category-iso-8-2)) | 485 | 2) |
| 486 | 2) | 486 | ((or (eq category 'coding-category-iso-7-tight) |
| 487 | ((or (eq category 'coding-category-iso-7-tight) | 487 | (eq category 'coding-category-iso-7)) |
| 488 | (eq category 'coding-category-iso-7)) | 488 | 1) |
| 489 | 1) | 489 | (t |
| 490 | (t | 490 | 0))) |
| 491 | 0))) | 491 | 1) |
| 492 | 1) | 492 | ))))) |
| 493 | )))))) | ||
| 494 | (sort codings (lambda (x y) | 493 | (sort codings (lambda (x y) |
| 495 | (> (funcall func x) (funcall func y))))))) | 494 | (> (funcall func x) (funcall func y))))))) |
| 496 | 495 | ||
diff --git a/lisp/international/mule-diag.el b/lisp/international/mule-diag.el index b13bde58ca1..57e568689e3 100644 --- a/lisp/international/mule-diag.el +++ b/lisp/international/mule-diag.el | |||
| @@ -136,13 +136,12 @@ SORT-KEY should be `name' or `iso-spec' (default `name')." | |||
| 136 | 136 | ||
| 137 | ((eq sort-key 'iso-spec) | 137 | ((eq sort-key 'iso-spec) |
| 138 | ;; Sort by DIMENSION CHARS FINAL-CHAR | 138 | ;; Sort by DIMENSION CHARS FINAL-CHAR |
| 139 | (function | 139 | (lambda (x y) |
| 140 | (lambda (x y) | 140 | (or (< (nth 1 x) (nth 1 y)) |
| 141 | (or (< (nth 1 x) (nth 1 y)) | 141 | (and (= (nth 1 x) (nth 1 y)) |
| 142 | (and (= (nth 1 x) (nth 1 y)) | 142 | (or (< (nth 2 x) (nth 2 y)) |
| 143 | (or (< (nth 2 x) (nth 2 y)) | 143 | (and (= (nth 2 x) (nth 2 y)) |
| 144 | (and (= (nth 2 x) (nth 2 y)) | 144 | (< (nth 3 x) (nth 3 y)))))))) |
| 145 | (< (nth 3 x) (nth 3 y))))))))) | ||
| 146 | (t | 145 | (t |
| 147 | (error "Invalid charset sort key: %s" sort-key)))) | 146 | (error "Invalid charset sort key: %s" sort-key)))) |
| 148 | 147 | ||
diff --git a/lisp/international/quail.el b/lisp/international/quail.el index 5abd668db89..39ef6d3bf01 100644 --- a/lisp/international/quail.el +++ b/lisp/international/quail.el | |||
| @@ -1330,7 +1330,8 @@ If STR has `advice' text property, append the following special event: | |||
| 1330 | 1330 | ||
| 1331 | (defun quail-input-method (key) | 1331 | (defun quail-input-method (key) |
| 1332 | (if (or (and (or buffer-read-only | 1332 | (if (or (and (or buffer-read-only |
| 1333 | (get-char-property (point) 'read-only)) | 1333 | (and (get-char-property (point) 'read-only) |
| 1334 | (get-char-property (point) 'front-sticky))) | ||
| 1334 | (not (or inhibit-read-only | 1335 | (not (or inhibit-read-only |
| 1335 | (get-char-property (point) 'inhibit-read-only)))) | 1336 | (get-char-property (point) 'inhibit-read-only)))) |
| 1336 | (and overriding-terminal-local-map | 1337 | (and overriding-terminal-local-map |
| @@ -2477,14 +2478,13 @@ should be made by `quail-build-decode-map' (which see)." | |||
| 2477 | 'face 'font-lock-comment-face)) | 2478 | 'face 'font-lock-comment-face)) |
| 2478 | (quail-indent-to max-key-width) | 2479 | (quail-indent-to max-key-width) |
| 2479 | (if (vectorp (cdr elt)) | 2480 | (if (vectorp (cdr elt)) |
| 2480 | (mapc (function | 2481 | (mapc (lambda (x) |
| 2481 | (lambda (x) | 2482 | (let ((width (if (integerp x) (char-width x) |
| 2482 | (let ((width (if (integerp x) (char-width x) | 2483 | (string-width x)))) |
| 2483 | (string-width x)))) | 2484 | (when (> (+ (current-column) 1 width) window-width) |
| 2484 | (when (> (+ (current-column) 1 width) window-width) | 2485 | (insert "\n") |
| 2485 | (insert "\n") | 2486 | (quail-indent-to max-key-width)) |
| 2486 | (quail-indent-to max-key-width)) | 2487 | (insert " " x))) |
| 2487 | (insert " " x)))) | ||
| 2488 | (cdr elt)) | 2488 | (cdr elt)) |
| 2489 | (insert " " (cdr elt))) | 2489 | (insert " " (cdr elt))) |
| 2490 | (insert ?\n)) | 2490 | (insert ?\n)) |
diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el index 7de6baeb00a..0b3394080cc 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.12 | 7 | ;; Version: 1.0.14 |
| 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 |
| @@ -271,7 +271,7 @@ it only exits locally (returning the JSONRPC result object) if | |||
| 271 | the request is successful, otherwise it exits non-locally with an | 271 | the request is successful, otherwise it exits non-locally with an |
| 272 | error of type `jsonrpc-error'. | 272 | error of type `jsonrpc-error'. |
| 273 | 273 | ||
| 274 | DEFERRED is passed to `jsonrpc-async-request', which see. | 274 | DEFERRED and TIMEOUT as in `jsonrpc-async-request', which see. |
| 275 | 275 | ||
| 276 | If CANCEL-ON-INPUT is non-nil and the user inputs something while | 276 | If CANCEL-ON-INPUT is non-nil and the user inputs something while |
| 277 | the function is waiting, then it exits immediately, returning | 277 | the function is waiting, then it exits immediately, returning |
| @@ -284,7 +284,8 @@ ignored." | |||
| 284 | (catch tag | 284 | (catch tag |
| 285 | (setq | 285 | (setq |
| 286 | id-and-timer | 286 | id-and-timer |
| 287 | (jsonrpc--async-request-1 | 287 | (apply |
| 288 | #'jsonrpc--async-request-1 | ||
| 288 | connection method params | 289 | connection method params |
| 289 | :success-fn (lambda (result) | 290 | :success-fn (lambda (result) |
| 290 | (unless cancelled | 291 | (unless cancelled |
| @@ -300,11 +301,12 @@ ignored." | |||
| 300 | (lambda () | 301 | (lambda () |
| 301 | (unless cancelled | 302 | (unless cancelled |
| 302 | (throw tag '(error (jsonrpc-error-message . "Timed out"))))) | 303 | (throw tag '(error (jsonrpc-error-message . "Timed out"))))) |
| 303 | :deferred deferred | 304 | `(,@(when deferred `(:deferred ,deferred)) |
| 304 | :timeout timeout)) | 305 | ,@(when timeout `(:timeout ,timeout))))) |
| 305 | (cond (cancel-on-input | 306 | (cond (cancel-on-input |
| 306 | (while (sit-for 30)) | 307 | (unwind-protect |
| 307 | (setq cancelled t) | 308 | (let ((inhibit-quit t)) (while (sit-for 30))) |
| 309 | (setq cancelled t)) | ||
| 308 | `(cancelled ,cancel-on-input-retval)) | 310 | `(cancelled ,cancel-on-input-retval)) |
| 309 | (t (while t (accept-process-output nil 30))))) | 311 | (t (while t (accept-process-output nil 30))))) |
| 310 | ;; In normal operation, cancellation is handled by the | 312 | ;; In normal operation, cancellation is handled by the |
diff --git a/lisp/mail/reporter.el b/lisp/mail/reporter.el index 0c8b8d47a08..805dd12d3bd 100644 --- a/lisp/mail/reporter.el +++ b/lisp/mail/reporter.el | |||
| @@ -250,14 +250,12 @@ dumped." | |||
| 250 | (insert "(setq\n") | 250 | (insert "(setq\n") |
| 251 | (lisp-indent-line) | 251 | (lisp-indent-line) |
| 252 | (mapc | 252 | (mapc |
| 253 | (function | 253 | (lambda (varsym-or-cons-cell) |
| 254 | (lambda (varsym-or-cons-cell) | 254 | (let ((varsym (or (car-safe varsym-or-cons-cell) |
| 255 | (let ((varsym (or (car-safe varsym-or-cons-cell) | 255 | varsym-or-cons-cell)) |
| 256 | varsym-or-cons-cell)) | 256 | (printer (or (cdr-safe varsym-or-cons-cell) |
| 257 | (printer (or (cdr-safe varsym-or-cons-cell) | 257 | 'reporter-dump-variable))) |
| 258 | 'reporter-dump-variable))) | 258 | (funcall printer varsym mailbuf))) |
| 259 | (funcall printer varsym mailbuf) | ||
| 260 | ))) | ||
| 261 | varlist) | 259 | varlist) |
| 262 | (lisp-indent-line) | 260 | (lisp-indent-line) |
| 263 | (insert ")\n")) | 261 | (insert ")\n")) |
diff --git a/lisp/mail/supercite.el b/lisp/mail/supercite.el index 986d0cf4074..9b7af0111e2 100644 --- a/lisp/mail/supercite.el +++ b/lisp/mail/supercite.el | |||
| @@ -618,10 +618,7 @@ the list should be unique." | |||
| 618 | (lambda (elt) (char-to-string (cdr elt))) alist "/") | 618 | (lambda (elt) (char-to-string (cdr elt))) alist "/") |
| 619 | ") ")) | 619 | ") ")) |
| 620 | (p prompt) | 620 | (p prompt) |
| 621 | (event | 621 | event) |
| 622 | (if (fboundp 'allocate-event) | ||
| 623 | (allocate-event) | ||
| 624 | nil))) | ||
| 625 | (while (stringp p) | 622 | (while (stringp p) |
| 626 | (if (let ((cursor-in-echo-area t) | 623 | (if (let ((cursor-in-echo-area t) |
| 627 | (inhibit-quit t)) | 624 | (inhibit-quit t)) |
| @@ -630,8 +627,6 @@ the list should be unique." | |||
| 630 | (prog1 quit-flag (setq quit-flag nil))) | 627 | (prog1 quit-flag (setq quit-flag nil))) |
| 631 | (progn | 628 | (progn |
| 632 | (message "%s%s" p (single-key-description event)) | 629 | (message "%s%s" p (single-key-description event)) |
| 633 | (if (fboundp 'deallocate-event) | ||
| 634 | (deallocate-event event)) | ||
| 635 | (setq quit-flag nil) | 630 | (setq quit-flag nil) |
| 636 | (signal 'quit '()))) | 631 | (signal 'quit '()))) |
| 637 | (let ((char event) | 632 | (let ((char event) |
| @@ -650,8 +645,6 @@ the list should be unique." | |||
| 650 | (discard-input) | 645 | (discard-input) |
| 651 | (if (eq p prompt) | 646 | (if (eq p prompt) |
| 652 | (setq p (concat "Try again. " prompt))))))) | 647 | (setq p (concat "Try again. " prompt))))))) |
| 653 | (if (fboundp 'deallocate-event) | ||
| 654 | (deallocate-event event)) | ||
| 655 | p)) | 648 | p)) |
| 656 | 649 | ||
| 657 | (defun sc-scan-info-alist (alist) | 650 | (defun sc-scan-info-alist (alist) |
| @@ -1028,17 +1021,16 @@ supplied, is used instead of the line point is on in the current buffer." | |||
| 1028 | (setq position (1+ position)) | 1021 | (setq position (1+ position)) |
| 1029 | (let ((keep-p t)) | 1022 | (let ((keep-p t)) |
| 1030 | (mapc | 1023 | (mapc |
| 1031 | (function | 1024 | (lambda (filter) |
| 1032 | (lambda (filter) | 1025 | (let ((regexp (car filter)) |
| 1033 | (let ((regexp (car filter)) | 1026 | (pos (cdr filter))) |
| 1034 | (pos (cdr filter))) | 1027 | (if (and (string-match regexp name) |
| 1035 | (if (and (string-match regexp name) | 1028 | (or (and (numberp pos) |
| 1036 | (or (and (numberp pos) | 1029 | (= pos position)) |
| 1037 | (= pos position)) | 1030 | (and (eq pos 'last) |
| 1038 | (and (eq pos 'last) | 1031 | (= position (1- elements))) |
| 1039 | (= position (1- elements))) | 1032 | (eq pos 'any))) |
| 1040 | (eq pos 'any))) | 1033 | (setq keep-p nil)))) |
| 1041 | (setq keep-p nil))))) | ||
| 1042 | sc-name-filter-alist) | 1034 | sc-name-filter-alist) |
| 1043 | (if keep-p | 1035 | (if keep-p |
| 1044 | (setq keepers (cons position keepers))))) | 1036 | (setq keepers (cons position keepers))))) |
diff --git a/lisp/mh-e/mh-alias.el b/lisp/mh-e/mh-alias.el index cc437c3c49b..d037bdce887 100644 --- a/lisp/mh-e/mh-alias.el +++ b/lisp/mh-e/mh-alias.el | |||
| @@ -73,12 +73,11 @@ If ARG is non-nil, set timestamp with the current time." | |||
| 73 | (setq mh-alias-tstamp (list (nth 0 time) (nth 1 time)))) | 73 | (setq mh-alias-tstamp (list (nth 0 time) (nth 1 time)))) |
| 74 | (let ((stamp)) | 74 | (let ((stamp)) |
| 75 | (car (memq t (mapcar | 75 | (car (memq t (mapcar |
| 76 | (function | 76 | (lambda (file) |
| 77 | (lambda (file) | 77 | (when (and file (file-exists-p file)) |
| 78 | (when (and file (file-exists-p file)) | 78 | (setq stamp (file-attribute-modification-time |
| 79 | (setq stamp (file-attribute-modification-time | 79 | (file-attributes file))) |
| 80 | (file-attributes file))) | 80 | (time-less-p mh-alias-tstamp stamp))) |
| 81 | (time-less-p mh-alias-tstamp stamp)))) | ||
| 82 | (mh-alias-filenames t))))))) | 81 | (mh-alias-filenames t))))))) |
| 83 | 82 | ||
| 84 | (defun mh-alias-filenames (arg) | 83 | (defun mh-alias-filenames (arg) |
| @@ -93,11 +92,10 @@ appended." | |||
| 93 | (filelist (and filename (split-string filename "[ \t]+"))) | 92 | (filelist (and filename (split-string filename "[ \t]+"))) |
| 94 | (userlist | 93 | (userlist |
| 95 | (mapcar | 94 | (mapcar |
| 96 | (function | 95 | (lambda (file) |
| 97 | (lambda (file) | 96 | (if (and mh-user-path file |
| 98 | (if (and mh-user-path file | 97 | (file-exists-p (expand-file-name file mh-user-path))) |
| 99 | (file-exists-p (expand-file-name file mh-user-path))) | 98 | (expand-file-name file mh-user-path))) |
| 100 | (expand-file-name file mh-user-path)))) | ||
| 101 | filelist))) | 99 | filelist))) |
| 102 | (if arg | 100 | (if arg |
| 103 | (if (stringp mh-alias-system-aliases) | 101 | (if (stringp mh-alias-system-aliases) |
| @@ -466,12 +464,11 @@ set `mh-alias-insert-file' or the \"Aliasfile:\" profile component")) | |||
| 466 | ;; Double-check that we have an individual alias. This means that the | 464 | ;; Double-check that we have an individual alias. This means that the |
| 467 | ;; alias doesn't expand into a list (of which this address is part). | 465 | ;; alias doesn't expand into a list (of which this address is part). |
| 468 | (car (delq nil (mapcar | 466 | (car (delq nil (mapcar |
| 469 | (function | 467 | (lambda (alias) |
| 470 | (lambda (alias) | 468 | (let ((recurse (mh-alias-ali alias nil))) |
| 471 | (let ((recurse (mh-alias-ali alias nil))) | 469 | (if (string-match ".*,.*" recurse) |
| 472 | (if (string-match ".*,.*" recurse) | 470 | nil |
| 473 | nil | 471 | alias))) |
| 474 | alias)))) | ||
| 475 | (split-string aliases ", +"))))))) | 472 | (split-string aliases ", +"))))))) |
| 476 | 473 | ||
| 477 | ;;;###mh-autoload | 474 | ;;;###mh-autoload |
diff --git a/lisp/mh-e/mh-comp.el b/lisp/mh-e/mh-comp.el index 8a69adbb756..e766bca89d8 100644 --- a/lisp/mh-e/mh-comp.el +++ b/lisp/mh-e/mh-comp.el | |||
| @@ -435,43 +435,42 @@ See also `mh-send'." | |||
| 435 | (mh-insert-header-separator) | 435 | (mh-insert-header-separator) |
| 436 | ;; Merge in components | 436 | ;; Merge in components |
| 437 | (mh-mapc | 437 | (mh-mapc |
| 438 | (function | 438 | (lambda (header-field) |
| 439 | (lambda (header-field) | 439 | (let ((field (car header-field)) |
| 440 | (let ((field (car header-field)) | 440 | (value (cdr header-field)) |
| 441 | (value (cdr header-field)) | 441 | (case-fold-search t)) |
| 442 | (case-fold-search t)) | 442 | (cond |
| 443 | (cond | 443 | ;; Address field |
| 444 | ;; Address field | 444 | ((string-match field "^To$\\|^Cc$\\|^From$") |
| 445 | ((string-match field "^To$\\|^Cc$\\|^From$") | 445 | (cond |
| 446 | (cond | 446 | ((not (mh-goto-header-field (concat field ":"))) |
| 447 | ((not (mh-goto-header-field (concat field ":"))) | 447 | ;; Header field does not exist, add it |
| 448 | ;; Header field does not exist, add it | 448 | (mh-goto-header-end 0) |
| 449 | (mh-goto-header-end 0) | 449 | (insert field ": " value "\n")) |
| 450 | (insert field ": " value "\n")) | 450 | ((string-equal value "") |
| 451 | ((string-equal value "") | 451 | ;; Header field already exists and no value |
| 452 | ;; Header field already exists and no value | 452 | ) |
| 453 | ) | 453 | (t |
| 454 | (t | 454 | ;; Header field exists and we have a value |
| 455 | ;; Header field exists and we have a value | 455 | (let (address mailbox (alias (mh-alias-expand value))) |
| 456 | (let (address mailbox (alias (mh-alias-expand value))) | 456 | (and alias |
| 457 | (and alias | 457 | (setq address (ietf-drums-parse-address alias)) |
| 458 | (setq address (ietf-drums-parse-address alias)) | 458 | (setq mailbox (car address))) |
| 459 | (setq mailbox (car address))) | 459 | ;; XXX - Need to parse all addresses out of field |
| 460 | ;; XXX - Need to parse all addresses out of field | 460 | (if (and |
| 461 | (if (and | 461 | (not (mh-regexp-in-field-p |
| 462 | (not (mh-regexp-in-field-p | 462 | (concat "\\b" (regexp-quote value) "\\b") field)) |
| 463 | (concat "\\b" (regexp-quote value) "\\b") field)) | 463 | mailbox |
| 464 | mailbox | 464 | (not (mh-regexp-in-field-p |
| 465 | (not (mh-regexp-in-field-p | 465 | (concat "\\b" (regexp-quote mailbox) "\\b") field))) |
| 466 | (concat "\\b" (regexp-quote mailbox) "\\b") field))) | 466 | (insert " " value ",")) |
| 467 | (insert " " value ",")) | 467 | )))) |
| 468 | )))) | 468 | ((string-match field "^Fcc$") |
| 469 | ((string-match field "^Fcc$") | 469 | ;; Folder reference |
| 470 | ;; Folder reference | 470 | (mh-modify-header-field field value)) |
| 471 | (mh-modify-header-field field value)) | 471 | ;; Text field, that's an easy case |
| 472 | ;; Text field, that's an easy case | 472 | (t |
| 473 | (t | 473 | (mh-modify-header-field field value))))) |
| 474 | (mh-modify-header-field field value)))))) | ||
| 475 | (mh-components-to-list components-file)) | 474 | (mh-components-to-list components-file)) |
| 476 | (delete-file components-file) | 475 | (delete-file components-file) |
| 477 | (goto-char (point-min)) | 476 | (goto-char (point-min)) |
| @@ -700,25 +699,24 @@ message and scan line." | |||
| 700 | ;; trumping anything in the distcomps file. | 699 | ;; trumping anything in the distcomps file. |
| 701 | (let ((components-file (mh-bare-components mh-dist-formfile))) | 700 | (let ((components-file (mh-bare-components mh-dist-formfile))) |
| 702 | (mh-mapc | 701 | (mh-mapc |
| 703 | (function | 702 | (lambda (header-field) |
| 704 | (lambda (header-field) | 703 | (let ((field (car header-field)) |
| 705 | (let ((field (car header-field)) | 704 | (value (cdr header-field)) |
| 706 | (value (cdr header-field)) | 705 | (case-fold-search t)) |
| 707 | (case-fold-search t)) | 706 | (cond |
| 708 | (cond | 707 | ((string-match field "^Resent-Fcc$") |
| 709 | ((string-match field "^Resent-Fcc$") | 708 | (setq comp-fcc value)) |
| 710 | (setq comp-fcc value)) | 709 | ((string-match field "^Resent-From$") |
| 711 | ((string-match field "^Resent-From$") | 710 | (or from |
| 712 | (or from | 711 | (setq from value))) |
| 713 | (setq from value))) | 712 | ((string-match field "^Resent-To$") |
| 714 | ((string-match field "^Resent-To$") | 713 | (setq comp-to value)) |
| 715 | (setq comp-to value)) | 714 | ((string-match field "^Resent-Cc$") |
| 716 | ((string-match field "^Resent-Cc$") | 715 | (setq comp-cc value)) |
| 717 | (setq comp-cc value)) | 716 | ((string-match field "^Resent-Bcc$") |
| 718 | ((string-match field "^Resent-Bcc$") | 717 | (setq comp-bcc value)) |
| 719 | (setq comp-bcc value)) | 718 | ((string-match field "^Resent-.*$") |
| 720 | ((string-match field "^Resent-.*$") | 719 | (mh-insert-fields field value))))) |
| 721 | (mh-insert-fields field value)))))) | ||
| 722 | (mh-components-to-list components-file)) | 720 | (mh-components-to-list components-file)) |
| 723 | (delete-file components-file)) | 721 | (delete-file components-file)) |
| 724 | (mh-insert-fields "Resent-To:" (mapconcat 'identity (list to comp-to) ", ") | 722 | (mh-insert-fields "Resent-To:" (mapconcat 'identity (list to comp-to) ", ") |
diff --git a/lisp/mh-e/mh-identity.el b/lisp/mh-e/mh-identity.el index ebc7d2a4fcb..ed239963391 100644 --- a/lisp/mh-e/mh-identity.el +++ b/lisp/mh-e/mh-identity.el | |||
| @@ -71,10 +71,9 @@ See `mh-identity-add-menu'." | |||
| 71 | (mh-insert-auto-fields) mh-auto-fields-list] | 71 | (mh-insert-auto-fields) mh-auto-fields-list] |
| 72 | "--") | 72 | "--") |
| 73 | 73 | ||
| 74 | (mapcar (function | 74 | (mapcar (lambda (arg) |
| 75 | (lambda (arg) | 75 | `[,arg (mh-insert-identity ,arg) :style radio |
| 76 | `[,arg (mh-insert-identity ,arg) :style radio | 76 | :selected (equal mh-identity-local ,arg)]) |
| 77 | :selected (equal mh-identity-local ,arg)])) | ||
| 78 | (mapcar 'car mh-identity-list)) | 77 | (mapcar 'car mh-identity-list)) |
| 79 | '(["None" | 78 | '(["None" |
| 80 | (mh-insert-identity "None") :style radio | 79 | (mh-insert-identity "None") :style radio |
diff --git a/lisp/mh-e/mh-utils.el b/lisp/mh-e/mh-utils.el index 44b4ef48795..28d3c7614ce 100644 --- a/lisp/mh-e/mh-utils.el +++ b/lisp/mh-e/mh-utils.el | |||
| @@ -270,9 +270,8 @@ and displayed in a help buffer." | |||
| 270 | (cdr (assoc nil (assoc major-mode mh-help-messages))))) | 270 | (cdr (assoc nil (assoc major-mode mh-help-messages))))) |
| 271 | (text (substitute-command-keys (mapconcat 'identity help "")))) | 271 | (text (substitute-command-keys (mapconcat 'identity help "")))) |
| 272 | (with-electric-help | 272 | (with-electric-help |
| 273 | (function | 273 | (lambda () |
| 274 | (lambda () | 274 | (insert text)) |
| 275 | (insert text))) | ||
| 276 | mh-help-buffer))) | 275 | mh-help-buffer))) |
| 277 | 276 | ||
| 278 | ;;;###mh-autoload | 277 | ;;;###mh-autoload |
diff --git a/lisp/net/dig.el b/lisp/net/dig.el index f36999119f2..da4ea4050d8 100644 --- a/lisp/net/dig.el +++ b/lisp/net/dig.el | |||
| @@ -127,10 +127,8 @@ Buffer should contain output generated by `dig-invoke'." | |||
| 127 | "Major mode for displaying dig output." | 127 | "Major mode for displaying dig output." |
| 128 | (buffer-disable-undo) | 128 | (buffer-disable-undo) |
| 129 | (setq-local font-lock-defaults '(dig-font-lock-keywords t)) | 129 | (setq-local font-lock-defaults '(dig-font-lock-keywords t)) |
| 130 | (when (featurep 'font-lock) | 130 | ;; FIXME: what is this for?? --Stef M |
| 131 | ;; FIXME: what is this for?? --Stef | 131 | (font-lock-set-defaults)) |
| 132 | (font-lock-set-defaults)) | ||
| 133 | ) | ||
| 134 | 132 | ||
| 135 | (defun dig-exit () | 133 | (defun dig-exit () |
| 136 | "Quit dig output buffer." | 134 | "Quit dig output buffer." |
diff --git a/lisp/net/eudc-bob.el b/lisp/net/eudc-bob.el index bb6682520ae..b2069ed6ef8 100644 --- a/lisp/net/eudc-bob.el +++ b/lisp/net/eudc-bob.el | |||
| @@ -153,9 +153,7 @@ display a button." | |||
| 153 | 'end-glyph (if inline glyph) | 153 | 'end-glyph (if inline glyph) |
| 154 | 'duplicable t | 154 | 'duplicable t |
| 155 | 'invisible inline | 155 | 'invisible inline |
| 156 | 'start-open t | 156 | 'object-data data)))) |
| 157 | 'end-open t | ||
| 158 | 'object-data data)))) | ||
| 159 | ((fboundp 'create-image) | 157 | ((fboundp 'create-image) |
| 160 | (let* ((image (create-image data nil t)) | 158 | (let* ((image (create-image data nil t)) |
| 161 | (props (list 'object-data data 'eudc-image image))) | 159 | (props (list 'object-data data 'eudc-image image))) |
| @@ -192,9 +190,7 @@ display a button." | |||
| 192 | eudc-bob-sound-keymap | 190 | eudc-bob-sound-keymap |
| 193 | eudc-bob-sound-menu | 191 | eudc-bob-sound-menu |
| 194 | (list 'duplicable t | 192 | (list 'duplicable t |
| 195 | 'start-open t | 193 | 'object-data data))) |
| 196 | 'end-open t | ||
| 197 | 'object-data data))) | ||
| 198 | 194 | ||
| 199 | (defun eudc-bob-display-generic-binary (data) | 195 | (defun eudc-bob-display-generic-binary (data) |
| 200 | "Display a button for unidentified binary DATA." | 196 | "Display a button for unidentified binary DATA." |
| @@ -202,9 +198,7 @@ display a button." | |||
| 202 | eudc-bob-generic-keymap | 198 | eudc-bob-generic-keymap |
| 203 | eudc-bob-generic-menu | 199 | eudc-bob-generic-menu |
| 204 | (list 'duplicable t | 200 | (list 'duplicable t |
| 205 | 'start-open t | 201 | 'object-data data))) |
| 206 | 'end-open t | ||
| 207 | 'object-data data))) | ||
| 208 | 202 | ||
| 209 | (defun eudc-bob-play-sound-at-point () | 203 | (defun eudc-bob-play-sound-at-point () |
| 210 | "Play the sound data contained in the button at point." | 204 | "Play the sound data contained in the button at point." |
diff --git a/lisp/net/eudc-export.el b/lisp/net/eudc-export.el index ba86958142c..5c966281499 100644 --- a/lisp/net/eudc-export.el +++ b/lisp/net/eudc-export.el | |||
| @@ -78,12 +78,11 @@ If SILENT is non-nil then the created BBDB record is not displayed." | |||
| 78 | record t))) | 78 | record t))) |
| 79 | ;; BBDB custom fields | 79 | ;; BBDB custom fields |
| 80 | (setq bbdb-notes (append (list (and bbdb-notes (cons 'notes bbdb-notes))) | 80 | (setq bbdb-notes (append (list (and bbdb-notes (cons 'notes bbdb-notes))) |
| 81 | (mapcar (function | 81 | (mapcar (lambda (mapping) |
| 82 | (lambda (mapping) | 82 | (if (and (not (memq (car mapping) |
| 83 | (if (and (not (memq (car mapping) | 83 | '(name company net address phone notes))) |
| 84 | '(name company net address phone notes))) | 84 | (setq value (eudc-parse-spec (cdr mapping) record nil))) |
| 85 | (setq value (eudc-parse-spec (cdr mapping) record nil))) | 85 | (cons (car mapping) value))) |
| 86 | (cons (car mapping) value)))) | ||
| 87 | conversion-alist))) | 86 | conversion-alist))) |
| 88 | (setq bbdb-notes (delq nil bbdb-notes)) | 87 | (setq bbdb-notes (delq nil bbdb-notes)) |
| 89 | (setq bbdb-record (bbdb-create-internal | 88 | (setq bbdb-record (bbdb-create-internal |
diff --git a/lisp/net/eudc.el b/lisp/net/eudc.el index 08cab4f0470..f4e4c17d69e 100644 --- a/lisp/net/eudc.el +++ b/lisp/net/eudc.el | |||
| @@ -414,10 +414,9 @@ if any, is called to print the value in cdr of FIELD." | |||
| 414 | (eval (list (cdr match) val)) | 414 | (eval (list (cdr match) val)) |
| 415 | (insert "\n")) | 415 | (insert "\n")) |
| 416 | (mapc | 416 | (mapc |
| 417 | (function | 417 | (lambda (val-elem) |
| 418 | (lambda (val-elem) | 418 | (indent-to col) |
| 419 | (indent-to col) | 419 | (insert val-elem "\n")) |
| 420 | (insert val-elem "\n"))) | ||
| 421 | (cond | 420 | (cond |
| 422 | ((listp val) val) | 421 | ((listp val) val) |
| 423 | ((stringp val) (split-string val "\n")) | 422 | ((stringp val) (split-string val "\n")) |
| @@ -464,37 +463,33 @@ otherwise they are formatted according to `eudc-user-attribute-names-alist'." | |||
| 464 | ;; Replace field names with user names, compute max width | 463 | ;; Replace field names with user names, compute max width |
| 465 | (setq precords | 464 | (setq precords |
| 466 | (mapcar | 465 | (mapcar |
| 467 | (function | 466 | (lambda (record) |
| 468 | (lambda (record) | 467 | (mapcar |
| 469 | (mapcar | 468 | (lambda (field) |
| 470 | (function | 469 | (setq attribute-name |
| 471 | (lambda (field) | 470 | (if raw-attr-names |
| 472 | (setq attribute-name | 471 | (symbol-name (car field)) |
| 473 | (if raw-attr-names | 472 | (eudc-format-attribute-name-for-display (car field)))) |
| 474 | (symbol-name (car field)) | 473 | (if (> (length attribute-name) width) |
| 475 | (eudc-format-attribute-name-for-display (car field)))) | 474 | (setq width (length attribute-name))) |
| 476 | (if (> (length attribute-name) width) | 475 | (cons attribute-name (cdr field))) |
| 477 | (setq width (length attribute-name))) | 476 | record)) |
| 478 | (cons attribute-name (cdr field)))) | ||
| 479 | record))) | ||
| 480 | records)) | 477 | records)) |
| 481 | ;; Display the records | 478 | ;; Display the records |
| 482 | (setq first-record (point)) | 479 | (setq first-record (point)) |
| 483 | (mapc | 480 | (mapc |
| 484 | (function | 481 | (lambda (record) |
| 485 | (lambda (record) | 482 | (setq beg (point)) |
| 486 | (setq beg (point)) | 483 | ;; Map over the record fields to print the attribute/value pairs |
| 487 | ;; Map over the record fields to print the attribute/value pairs | 484 | (mapc (lambda (field) |
| 488 | (mapc (function | 485 | (eudc-print-record-field field width)) |
| 489 | (lambda (field) | 486 | record) |
| 490 | (eudc-print-record-field field width))) | 487 | ;; Store the record internal format in some convenient place |
| 491 | record) | 488 | (overlay-put (make-overlay beg (point)) |
| 492 | ;; Store the record internal format in some convenient place | 489 | 'eudc-record |
| 493 | (overlay-put (make-overlay beg (point)) | 490 | (car records)) |
| 494 | 'eudc-record | 491 | (setq records (cdr records)) |
| 495 | (car records)) | 492 | (insert "\n")) |
| 496 | (setq records (cdr records)) | ||
| 497 | (insert "\n"))) | ||
| 498 | precords)) | 493 | precords)) |
| 499 | (insert "\n") | 494 | (insert "\n") |
| 500 | (widget-create 'push-button | 495 | (widget-create 'push-button |
| @@ -518,12 +513,11 @@ otherwise they are formatted according to `eudc-user-attribute-names-alist'." | |||
| 518 | (if (not (and (boundp 'eudc-form-widget-list) | 513 | (if (not (and (boundp 'eudc-form-widget-list) |
| 519 | eudc-form-widget-list)) | 514 | eudc-form-widget-list)) |
| 520 | (error "Not in a directory query form buffer") | 515 | (error "Not in a directory query form buffer") |
| 521 | (mapc (function | 516 | (mapc (lambda (wid-field) |
| 522 | (lambda (wid-field) | 517 | (setq value (widget-value (cdr wid-field))) |
| 523 | (setq value (widget-value (cdr wid-field))) | 518 | (if (not (string= value "")) |
| 524 | (if (not (string= value "")) | 519 | (setq query-alist (cons (cons (car wid-field) value) |
| 525 | (setq query-alist (cons (cons (car wid-field) value) | 520 | query-alist)))) |
| 526 | query-alist))))) | ||
| 527 | eudc-form-widget-list) | 521 | eudc-form-widget-list) |
| 528 | (kill-buffer (current-buffer)) | 522 | (kill-buffer (current-buffer)) |
| 529 | (eudc-display-records (eudc-query query-alist) eudc-use-raw-directory-names)))) | 523 | (eudc-display-records (eudc-query query-alist) eudc-use-raw-directory-names)))) |
| @@ -543,49 +537,47 @@ otherwise they are formatted according to `eudc-user-attribute-names-alist'." | |||
| 543 | 537 | ||
| 544 | (if (null (cdar rec)) | 538 | (if (null (cdar rec)) |
| 545 | (list record) ; No duplicate attrs in this record | 539 | (list record) ; No duplicate attrs in this record |
| 546 | (mapc (function | 540 | (mapc (lambda (field) |
| 547 | (lambda (field) | 541 | (if (listp (cdr field)) |
| 548 | (if (listp (cdr field)) | 542 | (setq duplicates (cons field duplicates)) |
| 549 | (setq duplicates (cons field duplicates)) | 543 | (setq unique (cons field unique)))) |
| 550 | (setq unique (cons field unique))))) | ||
| 551 | record) | 544 | record) |
| 552 | (setq result (list unique)) | 545 | (setq result (list unique)) |
| 553 | ;; Map over the record fields that have multiple values | 546 | ;; Map over the record fields that have multiple values |
| 554 | (mapc | 547 | (mapc |
| 555 | (function | 548 | (lambda (field) |
| 556 | (lambda (field) | 549 | (let ((method (if (consp eudc-duplicate-attribute-handling-method) |
| 557 | (let ((method (if (consp eudc-duplicate-attribute-handling-method) | 550 | (cdr |
| 558 | (cdr | 551 | (assq |
| 559 | (assq | 552 | (or |
| 560 | (or | 553 | (car |
| 561 | (car | 554 | (rassq |
| 562 | (rassq | 555 | (car field) |
| 563 | (car field) | 556 | (symbol-value |
| 564 | (symbol-value | 557 | eudc-protocol-attributes-translation-alist))) |
| 565 | eudc-protocol-attributes-translation-alist))) | 558 | (car field)) |
| 566 | (car field)) | 559 | eudc-duplicate-attribute-handling-method)) |
| 567 | eudc-duplicate-attribute-handling-method)) | 560 | eudc-duplicate-attribute-handling-method))) |
| 568 | eudc-duplicate-attribute-handling-method))) | 561 | (cond |
| 569 | (cond | 562 | ((or (null method) (eq 'list method)) |
| 570 | ((or (null method) (eq 'list method)) | 563 | (setq result |
| 571 | (setq result | 564 | (eudc-add-field-to-records field result))) |
| 572 | (eudc-add-field-to-records field result))) | 565 | ((eq 'first method) |
| 573 | ((eq 'first method) | 566 | (setq result |
| 574 | (setq result | 567 | (eudc-add-field-to-records (cons (car field) |
| 575 | (eudc-add-field-to-records (cons (car field) | 568 | (cadr field)) |
| 576 | (cadr field)) | 569 | result))) |
| 577 | result))) | 570 | ((eq 'concat method) |
| 578 | ((eq 'concat method) | 571 | (setq result |
| 579 | (setq result | 572 | (eudc-add-field-to-records (cons (car field) |
| 580 | (eudc-add-field-to-records (cons (car field) | 573 | (mapconcat |
| 581 | (mapconcat | 574 | #'identity |
| 582 | #'identity | 575 | (cdr field) |
| 583 | (cdr field) | 576 | "\n")) |
| 584 | "\n")) | 577 | result))) |
| 585 | result))) | 578 | ((eq 'duplicate method) |
| 586 | ((eq 'duplicate method) | 579 | (setq result |
| 587 | (setq result | 580 | (eudc-distribute-field-on-records field result)))))) |
| 588 | (eudc-distribute-field-on-records field result))))))) | ||
| 589 | duplicates) | 581 | duplicates) |
| 590 | result))) | 582 | result))) |
| 591 | 583 | ||
| @@ -593,19 +585,17 @@ otherwise they are formatted according to `eudc-user-attribute-names-alist'." | |||
| 593 | "Eliminate records that do not contain all ATTRS from RECORDS." | 585 | "Eliminate records that do not contain all ATTRS from RECORDS." |
| 594 | (delq nil | 586 | (delq nil |
| 595 | (mapcar | 587 | (mapcar |
| 596 | (function | 588 | (lambda (rec) |
| 597 | (lambda (rec) | 589 | (if (cl-every (lambda (attr) |
| 598 | (if (cl-every (lambda (attr) | 590 | (consp (assq attr rec))) |
| 599 | (consp (assq attr rec))) | 591 | attrs) |
| 600 | attrs) | 592 | rec)) |
| 601 | rec))) | ||
| 602 | records))) | 593 | records))) |
| 603 | 594 | ||
| 604 | (defun eudc-add-field-to-records (field records) | 595 | (defun eudc-add-field-to-records (field records) |
| 605 | "Add FIELD to each individual record in RECORDS and return the resulting list." | 596 | "Add FIELD to each individual record in RECORDS and return the resulting list." |
| 606 | (mapcar (function | 597 | (mapcar (lambda (r) |
| 607 | (lambda (r) | 598 | (cons field r)) |
| 608 | (cons field r))) | ||
| 609 | records)) | 599 | records)) |
| 610 | 600 | ||
| 611 | (defun eudc-distribute-field-on-records (field records) | 601 | (defun eudc-distribute-field-on-records (field records) |
| @@ -886,10 +876,9 @@ see `eudc-inline-expansion-servers'." | |||
| 886 | (let ((response-string | 876 | (let ((response-string |
| 887 | (apply #'format | 877 | (apply #'format |
| 888 | (car eudc-inline-expansion-format) | 878 | (car eudc-inline-expansion-format) |
| 889 | (mapcar (function | 879 | (mapcar (lambda (field) |
| 890 | (lambda (field) | 880 | (or (cdr (assq field r)) |
| 891 | (or (cdr (assq field r)) | 881 | "")) |
| 892 | ""))) | ||
| 893 | (eudc-translate-attribute-list | 882 | (eudc-translate-attribute-list |
| 894 | (cdr eudc-inline-expansion-format)))))) | 883 | (cdr eudc-inline-expansion-format)))))) |
| 895 | (if (> (length response-string) 0) | 884 | (if (> (length response-string) 0) |
| @@ -929,16 +918,14 @@ queries the server for the existing fields and displays a corresponding form." | |||
| 929 | ;; Build the list of prompts | 918 | ;; Build the list of prompts |
| 930 | (setq prompts (if eudc-use-raw-directory-names | 919 | (setq prompts (if eudc-use-raw-directory-names |
| 931 | (mapcar #'symbol-name (eudc-translate-attribute-list fields)) | 920 | (mapcar #'symbol-name (eudc-translate-attribute-list fields)) |
| 932 | (mapcar (function | 921 | (mapcar (lambda (field) |
| 933 | (lambda (field) | 922 | (or (cdr (assq field eudc-user-attribute-names-alist)) |
| 934 | (or (cdr (assq field eudc-user-attribute-names-alist)) | 923 | (capitalize (symbol-name field)))) |
| 935 | (capitalize (symbol-name field))))) | ||
| 936 | fields))) | 924 | fields))) |
| 937 | ;; Loop over prompt strings to find the longest one | 925 | ;; Loop over prompt strings to find the longest one |
| 938 | (mapc (function | 926 | (mapc (lambda (prompt) |
| 939 | (lambda (prompt) | 927 | (if (> (length prompt) width) |
| 940 | (if (> (length prompt) width) | 928 | (setq width (length prompt)))) |
| 941 | (setq width (length prompt))))) | ||
| 942 | prompts) | 929 | prompts) |
| 943 | ;; Insert the first widget out of the mapcar to leave the cursor | 930 | ;; Insert the first widget out of the mapcar to leave the cursor |
| 944 | ;; in the first field | 931 | ;; in the first field |
| @@ -949,14 +936,13 @@ queries the server for the existing fields and displays a corresponding form." | |||
| 949 | eudc-form-widget-list)) | 936 | eudc-form-widget-list)) |
| 950 | (setq fields (cdr fields)) | 937 | (setq fields (cdr fields)) |
| 951 | (setq prompts (cdr prompts)) | 938 | (setq prompts (cdr prompts)) |
| 952 | (mapc (function | 939 | (mapc (lambda (field) |
| 953 | (lambda (field) | 940 | (widget-insert "\n\n" (format (concat "%" (int-to-string width) "s: ") (car prompts))) |
| 954 | (widget-insert "\n\n" (format (concat "%" (int-to-string width) "s: ") (car prompts))) | 941 | (setq widget (widget-create 'editable-field |
| 955 | (setq widget (widget-create 'editable-field | 942 | :size 15)) |
| 956 | :size 15)) | 943 | (setq eudc-form-widget-list (cons (cons field widget) |
| 957 | (setq eudc-form-widget-list (cons (cons field widget) | 944 | eudc-form-widget-list)) |
| 958 | eudc-form-widget-list)) | 945 | (setq prompts (cdr prompts))) |
| 959 | (setq prompts (cdr prompts)))) | ||
| 960 | fields) | 946 | fields) |
| 961 | (widget-insert "\n\n") | 947 | (widget-insert "\n\n") |
| 962 | (widget-create 'push-button | 948 | (widget-create 'push-button |
| @@ -1118,27 +1104,26 @@ queries the server for the existing fields and displays a corresponding form." | |||
| 1118 | (append | 1104 | (append |
| 1119 | '("Server") | 1105 | '("Server") |
| 1120 | (mapcar | 1106 | (mapcar |
| 1121 | (function | 1107 | (lambda (servspec) |
| 1122 | (lambda (servspec) | 1108 | (let* ((server (car servspec)) |
| 1123 | (let* ((server (car servspec)) | 1109 | (protocol (cdr servspec)) |
| 1124 | (protocol (cdr servspec)) | 1110 | (proto-name (symbol-name protocol))) |
| 1125 | (proto-name (symbol-name protocol))) | 1111 | (setq command (intern (concat "eudc-set-server-" |
| 1126 | (setq command (intern (concat "eudc-set-server-" | 1112 | server |
| 1127 | server | 1113 | "-" |
| 1128 | "-" | 1114 | proto-name))) |
| 1129 | proto-name))) | 1115 | (if (not (fboundp command)) |
| 1130 | (if (not (fboundp command)) | 1116 | (fset command |
| 1131 | (fset command | 1117 | `(lambda () |
| 1132 | `(lambda () | 1118 | (interactive) |
| 1133 | (interactive) | 1119 | (eudc-set-server ,server (quote ,protocol)) |
| 1134 | (eudc-set-server ,server (quote ,protocol)) | 1120 | (message "Selected directory server is now %s (%s)" |
| 1135 | (message "Selected directory server is now %s (%s)" | 1121 | ,server |
| 1136 | ,server | 1122 | ,proto-name)))) |
| 1137 | ,proto-name)))) | 1123 | (vector (format "%s (%s)" server proto-name) |
| 1138 | (vector (format "%s (%s)" server proto-name) | 1124 | command |
| 1139 | command | 1125 | :style 'radio |
| 1140 | :style 'radio | 1126 | :selected `(equal eudc-server ,server)))) |
| 1141 | :selected `(equal eudc-server ,server))))) | ||
| 1142 | eudc-server-hotlist) | 1127 | eudc-server-hotlist) |
| 1143 | eudc-server-menu)) | 1128 | eudc-server-menu)) |
| 1144 | eudc-tail-menu))) | 1129 | eudc-tail-menu))) |
diff --git a/lisp/net/eudcb-bbdb.el b/lisp/net/eudcb-bbdb.el index 82e58c28336..5d6b52a19d2 100644 --- a/lisp/net/eudcb-bbdb.el +++ b/lisp/net/eudcb-bbdb.el | |||
| @@ -137,18 +137,17 @@ BBDB < 3 used `net'; BBDB >= 3 uses `mail'." | |||
| 137 | 137 | ||
| 138 | (defun eudc-bbdb-extract-phones (record) | 138 | (defun eudc-bbdb-extract-phones (record) |
| 139 | (require 'bbdb) | 139 | (require 'bbdb) |
| 140 | (mapcar (function | 140 | (mapcar (lambda (phone) |
| 141 | (lambda (phone) | 141 | (if eudc-bbdb-use-locations-as-attribute-names |
| 142 | (if eudc-bbdb-use-locations-as-attribute-names | 142 | (cons (intern (if (eudc--using-bbdb-3-or-newer-p) |
| 143 | (cons (intern (if (eudc--using-bbdb-3-or-newer-p) | 143 | (bbdb-phone-label phone) |
| 144 | (bbdb-phone-label phone) | 144 | (bbdb-phone-location phone))) |
| 145 | (bbdb-phone-location phone))) | 145 | (bbdb-phone-string phone)) |
| 146 | (bbdb-phone-string phone)) | 146 | (cons 'phones (format "%s: %s" |
| 147 | (cons 'phones (format "%s: %s" | 147 | (if (eudc--using-bbdb-3-or-newer-p) |
| 148 | (if (eudc--using-bbdb-3-or-newer-p) | 148 | (bbdb-phone-label phone) |
| 149 | (bbdb-phone-label phone) | 149 | (bbdb-phone-location phone)) |
| 150 | (bbdb-phone-location phone)) | 150 | (bbdb-phone-string phone))))) |
| 151 | (bbdb-phone-string phone)))))) | ||
| 152 | (if (eudc--using-bbdb-3-or-newer-p) | 151 | (if (eudc--using-bbdb-3-or-newer-p) |
| 153 | (bbdb-record-phone record) | 152 | (bbdb-record-phone record) |
| 154 | (bbdb-record-phones record)))) | 153 | (bbdb-record-phones record)))) |
| @@ -243,17 +242,15 @@ RETURN-ATTRS is a list of attributes to return, defaulting to | |||
| 243 | (if (car query-attrs) | 242 | (if (car query-attrs) |
| 244 | (setq records (eval `(bbdb-search ,(quote records) ,@bbdb-attrs)))) | 243 | (setq records (eval `(bbdb-search ,(quote records) ,@bbdb-attrs)))) |
| 245 | (setq query-attrs (cdr query-attrs))) | 244 | (setq query-attrs (cdr query-attrs))) |
| 246 | (mapc (function | 245 | (mapc (lambda (record) |
| 247 | (lambda (record) | 246 | (setq filtered (eudc-filter-duplicate-attributes record)) |
| 248 | (setq filtered (eudc-filter-duplicate-attributes record)) | 247 | ;; If there were duplicate attributes reverse the order of the |
| 249 | ;; If there were duplicate attributes reverse the order of the | 248 | ;; record so the unique attributes appear first |
| 250 | ;; record so the unique attributes appear first | 249 | (if (> (length filtered) 1) |
| 251 | (if (> (length filtered) 1) | 250 | (setq filtered (mapcar (lambda (rec) |
| 252 | (setq filtered (mapcar (function | 251 | (reverse rec)) |
| 253 | (lambda (rec) | 252 | filtered))) |
| 254 | (reverse rec))) | 253 | (setq result (append result filtered))) |
| 255 | filtered))) | ||
| 256 | (setq result (append result filtered)))) | ||
| 257 | (delq nil | 254 | (delq nil |
| 258 | (mapcar 'eudc-bbdb-format-record-as-result | 255 | (mapcar 'eudc-bbdb-format-record-as-result |
| 259 | (delq nil | 256 | (delq nil |
diff --git a/lisp/net/mairix.el b/lisp/net/mairix.el index 8218249ec18..5571b2ab81c 100644 --- a/lisp/net/mairix.el +++ b/lisp/net/mairix.el | |||
| @@ -631,14 +631,13 @@ See %s for details" mairix-output-buffer))) | |||
| 631 | (when (member 'flags mairix-widget-other) | 631 | (when (member 'flags mairix-widget-other) |
| 632 | (setq flag | 632 | (setq flag |
| 633 | (mapconcat | 633 | (mapconcat |
| 634 | (function | 634 | (lambda (flag) |
| 635 | (lambda (flag) | 635 | (setq temp |
| 636 | (setq temp | 636 | (widget-value (cadr (assoc (car flag) mairix-widgets)))) |
| 637 | (widget-value (cadr (assoc (car flag) mairix-widgets)))) | 637 | (if (string= "yes" temp) |
| 638 | (if (string= "yes" temp) | 638 | (cadr flag) |
| 639 | (cadr flag) | 639 | (if (string= "no" temp) |
| 640 | (if (string= "no" temp) | 640 | (concat "-" (cadr flag))))) |
| 641 | (concat "-" (cadr flag)))))) | ||
| 642 | '(("seen" "s") ("replied" "r") ("flagged" "f")) "")) | 641 | '(("seen" "s") ("replied" "r") ("flagged" "f")) "")) |
| 643 | (when (not (zerop (length flag))) | 642 | (when (not (zerop (length flag))) |
| 644 | (push (concat "F:" flag) query))) | 643 | (push (concat "F:" flag) query))) |
| @@ -694,34 +693,33 @@ Fill in VALUES if based on an article." | |||
| 694 | VALUES may contain values for editable fields from current article." | 693 | VALUES may contain values for editable fields from current article." |
| 695 | (let ((ret)) | 694 | (let ((ret)) |
| 696 | (mapc | 695 | (mapc |
| 697 | (function | 696 | (lambda (field) |
| 698 | (lambda (field) | 697 | (setq field (car (cddr field))) |
| 699 | (setq field (car (cddr field))) | 698 | (setq |
| 700 | (setq | 699 | ret |
| 701 | ret | 700 | (nconc |
| 702 | (nconc | 701 | (list |
| 703 | (list | 702 | (list |
| 704 | (list | 703 | (concat "c" field) |
| 705 | (concat "c" field) | 704 | (widget-create 'checkbox |
| 706 | (widget-create 'checkbox | 705 | :tag field |
| 707 | :tag field | 706 | :notify (lambda (widget &rest ignore) |
| 708 | :notify (lambda (widget &rest ignore) | 707 | (mairix-widget-toggle-activate widget)) |
| 709 | (mairix-widget-toggle-activate widget)) | 708 | nil))) |
| 710 | nil))) | 709 | (list |
| 711 | (list | 710 | (list |
| 712 | (list | 711 | (concat "e" field) |
| 713 | (concat "e" field) | 712 | (widget-create 'editable-field |
| 714 | (widget-create 'editable-field | 713 | :size 60 |
| 715 | :size 60 | 714 | :format (concat " " field ":" |
| 716 | :format (concat " " field ":" | 715 | (make-string |
| 717 | (make-string | 716 | (- 11 (length field)) ?\ ) |
| 718 | (- 11 (length field)) ?\ ) | 717 | "%v") |
| 719 | "%v") | 718 | :value (or (cadr (assoc field values)) "")))) |
| 720 | :value (or (cadr (assoc field values)) "")))) | 719 | ret)) |
| 721 | ret)) | 720 | (widget-insert "\n") |
| 722 | (widget-insert "\n") | 721 | ;; Deactivate editable field |
| 723 | ;; Deactivate editable field | 722 | (widget-apply (cadr (nth 1 ret)) :deactivate)) |
| 724 | (widget-apply (cadr (nth 1 ret)) :deactivate))) | ||
| 725 | mairix-widget-fields-list) | 723 | mairix-widget-fields-list) |
| 726 | ret)) | 724 | ret)) |
| 727 | 725 | ||
| @@ -936,13 +934,12 @@ Use cursor keys or C-n,C-p to select next/previous search.\n\n") | |||
| 936 | (save-excursion | 934 | (save-excursion |
| 937 | (save-restriction | 935 | (save-restriction |
| 938 | (mapcar | 936 | (mapcar |
| 939 | (function | 937 | (lambda (field) |
| 940 | (lambda (field) | 938 | (list (car (cddr field)) |
| 941 | (list (car (cddr field)) | 939 | (if (car field) |
| 942 | (if (car field) | 940 | (mairix-replace-invalid-chars |
| 943 | (mairix-replace-invalid-chars | 941 | (funcall get-mail-header (car field))) |
| 944 | (funcall get-mail-header (car field))) | 942 | nil))) |
| 945 | nil)))) | ||
| 946 | mairix-widget-fields-list))) | 943 | mairix-widget-fields-list))) |
| 947 | (error "No function for obtaining mail header specified")))) | 944 | (error "No function for obtaining mail header specified")))) |
| 948 | 945 | ||
diff --git a/lisp/net/sieve-mode.el b/lisp/net/sieve-mode.el index c5f44917919..05e9747e74d 100644 --- a/lisp/net/sieve-mode.el +++ b/lisp/net/sieve-mode.el | |||
| @@ -43,8 +43,6 @@ | |||
| 43 | 43 | ||
| 44 | (autoload 'sieve-manage "sieve") | 44 | (autoload 'sieve-manage "sieve") |
| 45 | (autoload 'sieve-upload "sieve") | 45 | (autoload 'sieve-upload "sieve") |
| 46 | (eval-when-compile | ||
| 47 | (require 'font-lock)) | ||
| 48 | 46 | ||
| 49 | (defgroup sieve nil | 47 | (defgroup sieve nil |
| 50 | "Sieve." | 48 | "Sieve." |
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 7cdb7ebf536..51cb316249d 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el | |||
| @@ -363,7 +363,8 @@ ARGUMENTS to pass to the OPERATION." | |||
| 363 | ;; by GNU Coreutils. Force "ls" to print one column and set | 363 | ;; by GNU Coreutils. Force "ls" to print one column and set |
| 364 | ;; time-style to imitate other "ls" flavors. | 364 | ;; time-style to imitate other "ls" flavors. |
| 365 | ((tramp-adb-send-command-and-check | 365 | ((tramp-adb-send-command-and-check |
| 366 | vec "ls --time-style=long-iso /dev/null") | 366 | vec (concat "ls --time-style=long-iso " |
| 367 | (tramp-get-remote-null-device vec))) | ||
| 367 | "ls -1 --time-style=long-iso") | 368 | "ls -1 --time-style=long-iso") |
| 368 | ;; Can't disable coloring explicitly for toybox ls command. We | 369 | ;; Can't disable coloring explicitly for toybox ls command. We |
| 369 | ;; also must force "ls" to print just one column. | 370 | ;; also must force "ls" to print just one column. |
| @@ -371,7 +372,8 @@ ARGUMENTS to pass to the OPERATION." | |||
| 371 | ;; On CyanogenMod based system BusyBox is used and "ls" output | 372 | ;; On CyanogenMod based system BusyBox is used and "ls" output |
| 372 | ;; coloring is enabled by default. So we try to disable it when | 373 | ;; coloring is enabled by default. So we try to disable it when |
| 373 | ;; possible. | 374 | ;; possible. |
| 374 | ((tramp-adb-send-command-and-check vec "ls --color=never -al /dev/null") | 375 | ((tramp-adb-send-command-and-check |
| 376 | vec (concat "ls --color=never -al " (tramp-get-remote-null-device vec))) | ||
| 375 | "ls --color=never") | 377 | "ls --color=never") |
| 376 | (t "ls")))) | 378 | (t "ls")))) |
| 377 | 379 | ||
| @@ -611,13 +613,13 @@ But handle the case, if the \"test\" command is not available." | |||
| 611 | ;; (introduced in POSIX.1-2008) fails. | 613 | ;; (introduced in POSIX.1-2008) fails. |
| 612 | (tramp-adb-send-command-and-check | 614 | (tramp-adb-send-command-and-check |
| 613 | v (format | 615 | v (format |
| 614 | (concat "touch -d %s %s %s 2>/dev/null || " | 616 | (concat "touch -d %s %s %s 2>%s || " |
| 615 | "touch -d %s %s %s 2>/dev/null || " | 617 | "touch -d %s %s %s 2>%s || " |
| 616 | "touch -t %s %s %s") | 618 | "touch -t %s %s %s") |
| 617 | (format-time-string "%Y-%m-%dT%H:%M:%S.%NZ" time t) | 619 | (format-time-string "%Y-%m-%dT%H:%M:%S.%NZ" time t) |
| 618 | nofollow quoted-name | 620 | nofollow quoted-name (tramp-get-remote-null-device v) |
| 619 | (format-time-string "%Y-%m-%dT%H:%M:%S" time t) | 621 | (format-time-string "%Y-%m-%dT%H:%M:%S" time t) |
| 620 | nofollow quoted-name | 622 | nofollow quoted-name (tramp-get-remote-null-device v) |
| 621 | (format-time-string "%Y%m%d%H%M.%S" time t) | 623 | (format-time-string "%Y%m%d%H%M.%S" time t) |
| 622 | nofollow quoted-name))))) | 624 | nofollow quoted-name))))) |
| 623 | 625 | ||
| @@ -791,7 +793,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." | |||
| 791 | (cons program args) " ")) | 793 | (cons program args) " ")) |
| 792 | ;; Determine input. | 794 | ;; Determine input. |
| 793 | (if (null infile) | 795 | (if (null infile) |
| 794 | (setq input "/dev/null") | 796 | (setq input (tramp-get-remote-null-device v)) |
| 795 | (setq infile (expand-file-name infile)) | 797 | (setq infile (expand-file-name infile)) |
| 796 | (if (tramp-equal-remote default-directory infile) | 798 | (if (tramp-equal-remote default-directory infile) |
| 797 | ;; INFILE is on the same remote host. | 799 | ;; INFILE is on the same remote host. |
| @@ -833,7 +835,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." | |||
| 833 | tmpstderr (tramp-make-tramp-file-name v stderr)))) | 835 | tmpstderr (tramp-make-tramp-file-name v stderr)))) |
| 834 | ;; stderr to be discarded. | 836 | ;; stderr to be discarded. |
| 835 | ((null (cadr destination)) | 837 | ((null (cadr destination)) |
| 836 | (setq stderr "/dev/null")))) | 838 | (setq stderr (tramp-get-remote-null-device v))))) |
| 837 | ;; 't | 839 | ;; 't |
| 838 | (destination | 840 | (destination |
| 839 | (setq outbuf (current-buffer)))) | 841 | (setq outbuf (current-buffer)))) |
| @@ -1316,23 +1318,24 @@ connection if a previous connection has died for some reason." | |||
| 1316 | ;; Mark it as connected. | 1318 | ;; Mark it as connected. |
| 1317 | (tramp-set-connection-property p "connected" t))))))) | 1319 | (tramp-set-connection-property p "connected" t))))))) |
| 1318 | 1320 | ||
| 1319 | ;; Default settings for connection-local variables. | 1321 | ;;; Default connection-local variables for Tramp: |
| 1320 | (defconst tramp-adb-connection-local-default-profile | 1322 | ;; `connection-local-set-profile-variables' and |
| 1323 | ;; `connection-local-set-profiles' exists since Emacs 26.1. | ||
| 1324 | (defconst tramp-adb-connection-local-default-shell-variables | ||
| 1321 | '((shell-file-name . "/system/bin/sh") | 1325 | '((shell-file-name . "/system/bin/sh") |
| 1322 | (shell-command-switch . "-c")) | 1326 | (shell-command-switch . "-c")) |
| 1323 | "Default connection-local variables for remote adb connections.") | 1327 | "Default connection-local shell variables for remote adb connections.") |
| 1328 | |||
| 1329 | (tramp-compat-funcall | ||
| 1330 | 'connection-local-set-profile-variables | ||
| 1331 | 'tramp-adb-connection-local-default-shell-profile | ||
| 1332 | tramp-adb-connection-local-default-shell-variables) | ||
| 1324 | 1333 | ||
| 1325 | ;; `connection-local-set-profile-variables' and | ||
| 1326 | ;; `connection-local-set-profiles' exists since Emacs 26.1. | ||
| 1327 | (with-eval-after-load 'shell | 1334 | (with-eval-after-load 'shell |
| 1328 | (tramp-compat-funcall | 1335 | (tramp-compat-funcall |
| 1329 | 'connection-local-set-profile-variables | ||
| 1330 | 'tramp-adb-connection-local-default-profile | ||
| 1331 | tramp-adb-connection-local-default-profile) | ||
| 1332 | (tramp-compat-funcall | ||
| 1333 | 'connection-local-set-profiles | 1336 | 'connection-local-set-profiles |
| 1334 | `(:application tramp :protocol ,tramp-adb-method) | 1337 | `(:application tramp :protocol ,tramp-adb-method) |
| 1335 | 'tramp-adb-connection-local-default-profile)) | 1338 | 'tramp-adb-connection-local-default-shell-profile)) |
| 1336 | 1339 | ||
| 1337 | (add-hook 'tramp-unload-hook | 1340 | (add-hook 'tramp-unload-hook |
| 1338 | (lambda () | 1341 | (lambda () |
diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index 9a4e16efe20..7fae9ba7e2f 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el | |||
| @@ -43,6 +43,7 @@ | |||
| 43 | 43 | ||
| 44 | ;; `temporary-file-directory' as function is introduced with Emacs 26.1. | 44 | ;; `temporary-file-directory' as function is introduced with Emacs 26.1. |
| 45 | (declare-function tramp-handle-temporary-file-directory "tramp") | 45 | (declare-function tramp-handle-temporary-file-directory "tramp") |
| 46 | (declare-function tramp-tramp-file-p "tramp") | ||
| 46 | (defvar tramp-temp-name-prefix) | 47 | (defvar tramp-temp-name-prefix) |
| 47 | 48 | ||
| 48 | (defconst tramp-compat-emacs-compiled-version (eval-when-compile emacs-version) | 49 | (defconst tramp-compat-emacs-compiled-version (eval-when-compile emacs-version) |
| @@ -333,6 +334,13 @@ A nil value for either argument stands for the current time." | |||
| 333 | (null (tramp-compat-directory-files | 334 | (null (tramp-compat-directory-files |
| 334 | dir nil directory-files-no-dot-files-regexp t 1)))))) | 335 | dir nil directory-files-no-dot-files-regexp t 1)))))) |
| 335 | 336 | ||
| 337 | ;; Function `null-device' is new in Emacs 28.1. | ||
| 338 | (defalias 'tramp-compat-null-device | ||
| 339 | (if (fboundp 'null-device) | ||
| 340 | #'null-device | ||
| 341 | (lambda () | ||
| 342 | (if (tramp-tramp-file-p default-directory) "/dev/null" null-device)))) | ||
| 343 | |||
| 336 | (add-hook 'tramp-unload-hook | 344 | (add-hook 'tramp-unload-hook |
| 337 | (lambda () | 345 | (lambda () |
| 338 | (unload-feature 'tramp-loaddefs 'force) | 346 | (unload-feature 'tramp-loaddefs 'force) |
diff --git a/lisp/net/tramp-integration.el b/lisp/net/tramp-integration.el index 7e4a9bf05e5..566c673af16 100644 --- a/lisp/net/tramp-integration.el +++ b/lisp/net/tramp-integration.el | |||
| @@ -262,23 +262,39 @@ NAME must be equal to `tramp-current-connection'." | |||
| 262 | (info-lookup->topic-cache 'symbol)))))))) | 262 | (info-lookup->topic-cache 'symbol)))))))) |
| 263 | 263 | ||
| 264 | ;;; Default connection-local variables for Tramp: | 264 | ;;; Default connection-local variables for Tramp: |
| 265 | ;; `connection-local-set-profile-variables' and | ||
| 266 | ;; `connection-local-set-profiles' exists since Emacs 26.1. | ||
| 267 | |||
| 268 | (defconst tramp-connection-local-default-system-variables | ||
| 269 | '((path-separator . ":") | ||
| 270 | (null-device . "/dev/null")) | ||
| 271 | "Default connection-local system variables for remote connections.") | ||
| 272 | |||
| 273 | (tramp-compat-funcall | ||
| 274 | 'connection-local-set-profile-variables | ||
| 275 | 'tramp-connection-local-default-system-profile | ||
| 276 | tramp-connection-local-default-system-variables) | ||
| 277 | |||
| 278 | (tramp-compat-funcall | ||
| 279 | 'connection-local-set-profiles | ||
| 280 | `(:application tramp) | ||
| 281 | 'tramp-connection-local-default-system-profile) | ||
| 265 | 282 | ||
| 266 | (defconst tramp-connection-local-default-profile | 283 | (defconst tramp-connection-local-default-shell-variables |
| 267 | '((shell-file-name . "/bin/sh") | 284 | '((shell-file-name . "/bin/sh") |
| 268 | (shell-command-switch . "-c")) | 285 | (shell-command-switch . "-c")) |
| 269 | "Default connection-local variables for remote connections.") | 286 | "Default connection-local shell variables for remote connections.") |
| 287 | |||
| 288 | (tramp-compat-funcall | ||
| 289 | 'connection-local-set-profile-variables | ||
| 290 | 'tramp-connection-local-default-shell-profile | ||
| 291 | tramp-connection-local-default-shell-variables) | ||
| 270 | 292 | ||
| 271 | ;; `connection-local-set-profile-variables' and | ||
| 272 | ;; `connection-local-set-profiles' exists since Emacs 26.1. | ||
| 273 | (with-eval-after-load 'shell | 293 | (with-eval-after-load 'shell |
| 274 | (tramp-compat-funcall | 294 | (tramp-compat-funcall |
| 275 | 'connection-local-set-profile-variables | ||
| 276 | 'tramp-connection-local-default-profile | ||
| 277 | tramp-connection-local-default-profile) | ||
| 278 | (tramp-compat-funcall | ||
| 279 | 'connection-local-set-profiles | 295 | 'connection-local-set-profiles |
| 280 | `(:application tramp) | 296 | `(:application tramp) |
| 281 | 'tramp-connection-local-default-profile)) | 297 | 'tramp-connection-local-default-shell-profile)) |
| 282 | 298 | ||
| 283 | (add-hook 'tramp-unload-hook | 299 | (add-hook 'tramp-unload-hook |
| 284 | (lambda () (unload-feature 'tramp-integration 'force))) | 300 | (lambda () (unload-feature 'tramp-integration 'force))) |
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index ccf0c0d0e28..d2265ed1dfa 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el | |||
| @@ -244,14 +244,14 @@ The string is used in `tramp-methods'.") | |||
| 244 | (add-to-list 'tramp-methods | 244 | (add-to-list 'tramp-methods |
| 245 | `("telnet" | 245 | `("telnet" |
| 246 | (tramp-login-program "telnet") | 246 | (tramp-login-program "telnet") |
| 247 | (tramp-login-args (("%h") ("%p") ("2>/dev/null"))) | 247 | (tramp-login-args (("%h") ("%p") ("%n"))) |
| 248 | (tramp-remote-shell ,tramp-default-remote-shell) | 248 | (tramp-remote-shell ,tramp-default-remote-shell) |
| 249 | (tramp-remote-shell-login ("-l")) | 249 | (tramp-remote-shell-login ("-l")) |
| 250 | (tramp-remote-shell-args ("-c")))) | 250 | (tramp-remote-shell-args ("-c")))) |
| 251 | (add-to-list 'tramp-methods | 251 | (add-to-list 'tramp-methods |
| 252 | `("nc" | 252 | `("nc" |
| 253 | (tramp-login-program "telnet") | 253 | (tramp-login-program "telnet") |
| 254 | (tramp-login-args (("%h") ("%p") ("2>/dev/null"))) | 254 | (tramp-login-args (("%h") ("%p") ("%n"))) |
| 255 | (tramp-remote-shell ,tramp-default-remote-shell) | 255 | (tramp-remote-shell ,tramp-default-remote-shell) |
| 256 | (tramp-remote-shell-login ("-l")) | 256 | (tramp-remote-shell-login ("-l")) |
| 257 | (tramp-remote-shell-args ("-c")) | 257 | (tramp-remote-shell-args ("-c")) |
| @@ -262,8 +262,7 @@ The string is used in `tramp-methods'.") | |||
| 262 | ;; We use "-p" as required for newer busyboxes. For older | 262 | ;; We use "-p" as required for newer busyboxes. For older |
| 263 | ;; busybox/nc versions, the value must be (("-l") ("%r")). This | 263 | ;; busybox/nc versions, the value must be (("-l") ("%r")). This |
| 264 | ;; can be achieved by tweaking `tramp-connection-properties'. | 264 | ;; can be achieved by tweaking `tramp-connection-properties'. |
| 265 | (tramp-remote-copy-args (("-l") ("-p" "%r") | 265 | (tramp-remote-copy-args (("-l") ("-p" "%r") ("%n"))))) |
| 266 | ("2>/dev/null"))))) | ||
| 267 | (add-to-list 'tramp-methods | 266 | (add-to-list 'tramp-methods |
| 268 | `("su" | 267 | `("su" |
| 269 | (tramp-login-program "su") | 268 | (tramp-login-program "su") |
| @@ -763,7 +762,7 @@ This string is passed to `format', so percent characters need to be doubled.") | |||
| 763 | 762 | ||
| 764 | ;; These two use base64 encoding. | 763 | ;; These two use base64 encoding. |
| 765 | (defconst tramp-perl-encode-with-module | 764 | (defconst tramp-perl-encode-with-module |
| 766 | "%s -MMIME::Base64 -0777 -ne 'print encode_base64($_)' 2>/dev/null" | 765 | "%s -MMIME::Base64 -0777 -ne 'print encode_base64($_)' %n" |
| 767 | "Perl program to use for encoding a file. | 766 | "Perl program to use for encoding a file. |
| 768 | Escape sequence %s is replaced with name of Perl binary. | 767 | Escape sequence %s is replaced with name of Perl binary. |
| 769 | This string is passed to `format', so percent characters need to be doubled. | 768 | This string is passed to `format', so percent characters need to be doubled. |
| @@ -771,7 +770,7 @@ This implementation requires the MIME::Base64 Perl module to be installed | |||
| 771 | on the remote host.") | 770 | on the remote host.") |
| 772 | 771 | ||
| 773 | (defconst tramp-perl-decode-with-module | 772 | (defconst tramp-perl-decode-with-module |
| 774 | "%s -MMIME::Base64 -0777 -ne 'print decode_base64($_)' 2>/dev/null" | 773 | "%s -MMIME::Base64 -0777 -ne 'print decode_base64($_)' %n" |
| 775 | "Perl program to use for decoding a file. | 774 | "Perl program to use for decoding a file. |
| 776 | Escape sequence %s is replaced with name of Perl binary. | 775 | Escape sequence %s is replaced with name of Perl binary. |
| 777 | This string is passed to `format', so percent characters need to be doubled. | 776 | This string is passed to `format', so percent characters need to be doubled. |
| @@ -812,7 +811,7 @@ while (read STDIN, $data, 54) { | |||
| 812 | (substr(unpack(q(B*), $data) . q(00000), 0, 432) =~ /....../g)), | 811 | (substr(unpack(q(B*), $data) . q(00000), 0, 432) =~ /....../g)), |
| 813 | $pad, | 812 | $pad, |
| 814 | qq(\\n); | 813 | qq(\\n); |
| 815 | }' 2>/dev/null" | 814 | }' %n" |
| 816 | "Perl program to use for encoding a file. | 815 | "Perl program to use for encoding a file. |
| 817 | Escape sequence %s is replaced with name of Perl binary. | 816 | Escape sequence %s is replaced with name of Perl binary. |
| 818 | This string is passed to `format', so percent characters need to be doubled.") | 817 | This string is passed to `format', so percent characters need to be doubled.") |
| @@ -856,7 +855,7 @@ while (my $data = <STDIN>) { | |||
| 856 | ((join q(), map {$trans{$_} || q()} split //, $chunk) =~ /......../g); | 855 | ((join q(), map {$trans{$_} || q()} split //, $chunk) =~ /......../g); |
| 857 | 856 | ||
| 858 | last if $finished; | 857 | last if $finished; |
| 859 | }' 2>/dev/null" | 858 | }' %n" |
| 860 | "Perl program to use for decoding a file. | 859 | "Perl program to use for decoding a file. |
| 861 | Escape sequence %s is replaced with name of Perl binary. | 860 | Escape sequence %s is replaced with name of Perl binary. |
| 862 | This string is passed to `format', so percent characters need to be doubled.") | 861 | This string is passed to `format', so percent characters need to be doubled.") |
| @@ -938,7 +937,7 @@ BEGIN { | |||
| 938 | if (o) { | 937 | if (o) { |
| 939 | printf \"%%c\", o | 938 | printf \"%%c\", o |
| 940 | } else { | 939 | } else { |
| 941 | system(\"dd if=/dev/zero bs=1 count=1 2>/dev/null\") | 940 | system(\"dd if=/dev/zero bs=1 count=1 %n\") |
| 942 | } | 941 | } |
| 943 | obc=0; o=0 | 942 | obc=0; o=0 |
| 944 | } | 943 | } |
| @@ -1785,7 +1784,7 @@ ID-FORMAT valid values are `string' and `integer'." | |||
| 1785 | "cd %s && echo \"(\"; (%s %s -a | tr '\\n\\r' '\\000\\000' | " | 1784 | "cd %s && echo \"(\"; (%s %s -a | tr '\\n\\r' '\\000\\000' | " |
| 1786 | "xargs -0 %s -c " | 1785 | "xargs -0 %s -c " |
| 1787 | "'(%s%%n%s (%s%%N%s) %%h %s %s %%X %%Y %%Z %%s %s%%A%s t %%i -1)' " | 1786 | "'(%s%%n%s (%s%%N%s) %%h %s %s %%X %%Y %%Z %%s %s%%A%s t %%i -1)' " |
| 1788 | "-- 2>/dev/null | sed -e 's/\"/\\\\\"/g' -e 's/%s/\"/g'); echo \")\"") | 1787 | "-- 2>%s | sed -e 's/\"/\\\\\"/g' -e 's/%s/\"/g'); echo \")\"") |
| 1789 | (tramp-shell-quote-argument localname) | 1788 | (tramp-shell-quote-argument localname) |
| 1790 | (tramp-get-ls-command vec) | 1789 | (tramp-get-ls-command vec) |
| 1791 | ;; On systems which have no quoting style, file names with special | 1790 | ;; On systems which have no quoting style, file names with special |
| @@ -1801,6 +1800,7 @@ ID-FORMAT valid values are `string' and `integer'." | |||
| 1801 | "%g" | 1800 | "%g" |
| 1802 | (eval-when-compile (concat tramp-stat-marker "%G" tramp-stat-marker))) | 1801 | (eval-when-compile (concat tramp-stat-marker "%G" tramp-stat-marker))) |
| 1803 | tramp-stat-marker tramp-stat-marker | 1802 | tramp-stat-marker tramp-stat-marker |
| 1803 | (tramp-get-remote-null-device vec) | ||
| 1804 | tramp-stat-quoted-marker))) | 1804 | tramp-stat-quoted-marker))) |
| 1805 | 1805 | ||
| 1806 | ;; This function should return "foo/" for directories and "bar" for | 1806 | ;; This function should return "foo/" for directories and "bar" for |
| @@ -1827,14 +1827,16 @@ ID-FORMAT valid values are `string' and `integer'." | |||
| 1827 | (tramp-shell-quote-argument localname))) | 1827 | (tramp-shell-quote-argument localname))) |
| 1828 | 1828 | ||
| 1829 | (format (concat | 1829 | (format (concat |
| 1830 | "(cd %s 2>&1 && %s -a 2>/dev/null" | 1830 | "(cd %s 2>&1 && %s -a 2>%s" |
| 1831 | " | while IFS= read f; do" | 1831 | " | while IFS= read f; do" |
| 1832 | " if %s -d \"$f\" 2>/dev/null;" | 1832 | " if %s -d \"$f\" 2>%s;" |
| 1833 | " then \\echo \"$f/\"; else \\echo \"$f\"; fi; done" | 1833 | " then \\echo \"$f/\"; else \\echo \"$f\"; fi; done" |
| 1834 | " && \\echo ok) || \\echo fail") | 1834 | " && \\echo ok) || \\echo fail") |
| 1835 | (tramp-shell-quote-argument localname) | 1835 | (tramp-shell-quote-argument localname) |
| 1836 | (tramp-get-ls-command v) | 1836 | (tramp-get-ls-command v) |
| 1837 | (tramp-get-test-command v)))) | 1837 | (tramp-get-remote-null-device v) |
| 1838 | (tramp-get-test-command v) | ||
| 1839 | (tramp-get-remote-null-device v)))) | ||
| 1838 | 1840 | ||
| 1839 | ;; Now grab the output. | 1841 | ;; Now grab the output. |
| 1840 | (with-current-buffer (tramp-get-buffer v) | 1842 | (with-current-buffer (tramp-get-buffer v) |
| @@ -2362,7 +2364,8 @@ The method used must be an out-of-band method." | |||
| 2362 | options (format-spec (tramp-ssh-controlmaster-options v) spec) | 2364 | options (format-spec (tramp-ssh-controlmaster-options v) spec) |
| 2363 | spec (format-spec-make | 2365 | spec (format-spec-make |
| 2364 | ?h host ?u user ?p port ?r listener ?c options | 2366 | ?h host ?u user ?p port ?r listener ?c options |
| 2365 | ?k (if keep-date " " "")) | 2367 | ?k (if keep-date " " "") |
| 2368 | ?n (concat "2>" (tramp-get-remote-null-device v))) | ||
| 2366 | copy-program (tramp-get-method-parameter v 'tramp-copy-program) | 2369 | copy-program (tramp-get-method-parameter v 'tramp-copy-program) |
| 2367 | copy-keep-date (tramp-get-method-parameter | 2370 | copy-keep-date (tramp-get-method-parameter |
| 2368 | v 'tramp-copy-keep-date) | 2371 | v 'tramp-copy-keep-date) |
| @@ -2629,12 +2632,13 @@ The method used must be an out-of-band method." | |||
| 2629 | (if full-directory-p | 2632 | (if full-directory-p |
| 2630 | (tramp-send-command | 2633 | (tramp-send-command |
| 2631 | v | 2634 | v |
| 2632 | (format "%s %s %s 2>/dev/null" | 2635 | (format "%s %s %s 2>%s" |
| 2633 | (tramp-get-ls-command v) | 2636 | (tramp-get-ls-command v) |
| 2634 | switches | 2637 | switches |
| 2635 | (if wildcard | 2638 | (if wildcard |
| 2636 | localname | 2639 | localname |
| 2637 | (tramp-shell-quote-argument (concat localname "."))))) | 2640 | (tramp-shell-quote-argument (concat localname "."))) |
| 2641 | (tramp-get-remote-null-device v))) | ||
| 2638 | (tramp-barf-unless-okay | 2642 | (tramp-barf-unless-okay |
| 2639 | v | 2643 | v |
| 2640 | (format "cd %s" (tramp-shell-quote-argument | 2644 | (format "cd %s" (tramp-shell-quote-argument |
| @@ -2645,7 +2649,7 @@ The method used must be an out-of-band method." | |||
| 2645 | (tramp-run-real-handler #'file-name-directory (list localname)))) | 2649 | (tramp-run-real-handler #'file-name-directory (list localname)))) |
| 2646 | (tramp-send-command | 2650 | (tramp-send-command |
| 2647 | v | 2651 | v |
| 2648 | (format "%s %s %s 2>/dev/null" | 2652 | (format "%s %s %s 2>%s" |
| 2649 | (tramp-get-ls-command v) | 2653 | (tramp-get-ls-command v) |
| 2650 | switches | 2654 | switches |
| 2651 | (if (or wildcard | 2655 | (if (or wildcard |
| @@ -2655,7 +2659,8 @@ The method used must be an out-of-band method." | |||
| 2655 | "" | 2659 | "" |
| 2656 | (tramp-shell-quote-argument | 2660 | (tramp-shell-quote-argument |
| 2657 | (tramp-run-real-handler | 2661 | (tramp-run-real-handler |
| 2658 | #'file-name-nondirectory (list localname))))))) | 2662 | #'file-name-nondirectory (list localname)))) |
| 2663 | (tramp-get-remote-null-device v)))) | ||
| 2659 | 2664 | ||
| 2660 | (save-restriction | 2665 | (save-restriction |
| 2661 | (let ((beg (point))) | 2666 | (let ((beg (point))) |
| @@ -2691,15 +2696,44 @@ The method used must be an out-of-band method." | |||
| 2691 | ;; Some busyboxes are reluctant to discard colors. | 2696 | ;; Some busyboxes are reluctant to discard colors. |
| 2692 | (unless | 2697 | (unless |
| 2693 | (string-match-p "color" (tramp-get-connection-property v "ls" "")) | 2698 | (string-match-p "color" (tramp-get-connection-property v "ls" "")) |
| 2694 | (goto-char beg) | 2699 | (save-excursion |
| 2695 | (while | 2700 | (goto-char beg) |
| 2696 | (re-search-forward tramp-display-escape-sequence-regexp nil t) | 2701 | (while |
| 2697 | (replace-match ""))) | 2702 | (re-search-forward tramp-display-escape-sequence-regexp nil t) |
| 2698 | 2703 | (replace-match "")))) | |
| 2699 | ;; Decode the output, it could be multibyte. | 2704 | |
| 2700 | (decode-coding-region | 2705 | ;; Now decode what read if necessary. Stolen from `insert-directory'. |
| 2701 | beg (point-max) | 2706 | (let ((coding (or coding-system-for-read |
| 2702 | (or file-name-coding-system default-file-name-coding-system)) | 2707 | file-name-coding-system |
| 2708 | default-file-name-coding-system | ||
| 2709 | 'undecided)) | ||
| 2710 | coding-no-eol | ||
| 2711 | val pos) | ||
| 2712 | (when (and enable-multibyte-characters | ||
| 2713 | (not (memq (coding-system-base coding) | ||
| 2714 | '(raw-text no-conversion)))) | ||
| 2715 | ;; If no coding system is specified or detection is | ||
| 2716 | ;; requested, detect the coding. | ||
| 2717 | (if (eq (coding-system-base coding) 'undecided) | ||
| 2718 | (setq coding (detect-coding-region beg (point) t))) | ||
| 2719 | (if (not (eq (coding-system-base coding) 'undecided)) | ||
| 2720 | (save-restriction | ||
| 2721 | (setq coding-no-eol | ||
| 2722 | (coding-system-change-eol-conversion coding 'unix)) | ||
| 2723 | (narrow-to-region beg (point)) | ||
| 2724 | (goto-char (point-min)) | ||
| 2725 | (while (not (eobp)) | ||
| 2726 | (setq pos (point) | ||
| 2727 | val (get-text-property (point) 'dired-filename)) | ||
| 2728 | (goto-char (next-single-property-change | ||
| 2729 | (point) 'dired-filename nil (point-max))) | ||
| 2730 | ;; Force no eol conversion on a file name, so | ||
| 2731 | ;; that CR is preserved. | ||
| 2732 | (decode-coding-region pos (point) | ||
| 2733 | (if val coding-no-eol coding)) | ||
| 2734 | (if val | ||
| 2735 | (put-text-property pos (point) | ||
| 2736 | 'dired-filename t))))))) | ||
| 2703 | 2737 | ||
| 2704 | ;; The inserted file could be from somewhere else. | 2738 | ;; The inserted file could be from somewhere else. |
| 2705 | (when (and (not wildcard) (not full-directory-p)) | 2739 | (when (and (not wildcard) (not full-directory-p)) |
| @@ -3117,7 +3151,7 @@ implementation will be used." | |||
| 3117 | (mapconcat #'tramp-shell-quote-argument uenv " ") command))) | 3151 | (mapconcat #'tramp-shell-quote-argument uenv " ") command))) |
| 3118 | ;; Determine input. | 3152 | ;; Determine input. |
| 3119 | (if (null infile) | 3153 | (if (null infile) |
| 3120 | (setq input "/dev/null") | 3154 | (setq input (tramp-get-remote-null-device v)) |
| 3121 | (setq infile (expand-file-name infile)) | 3155 | (setq infile (expand-file-name infile)) |
| 3122 | (if (tramp-equal-remote default-directory infile) | 3156 | (if (tramp-equal-remote default-directory infile) |
| 3123 | ;; INFILE is on the same remote host. | 3157 | ;; INFILE is on the same remote host. |
| @@ -3159,7 +3193,7 @@ implementation will be used." | |||
| 3159 | tmpstderr (tramp-make-tramp-file-name v stderr 'nohop)))) | 3193 | tmpstderr (tramp-make-tramp-file-name v stderr 'nohop)))) |
| 3160 | ;; stderr to be discarded. | 3194 | ;; stderr to be discarded. |
| 3161 | ((null (cadr destination)) | 3195 | ((null (cadr destination)) |
| 3162 | (setq stderr "/dev/null")))) | 3196 | (setq stderr (tramp-get-remote-null-device v))))) |
| 3163 | ;; 't | 3197 | ;; 't |
| 3164 | (destination | 3198 | (destination |
| 3165 | (setq outbuf (current-buffer)))) | 3199 | (setq outbuf (current-buffer)))) |
| @@ -4088,7 +4122,10 @@ variable PATH." | |||
| 4088 | (pipe-buf | 4122 | (pipe-buf |
| 4089 | (with-tramp-connection-property vec "pipe-buf" | 4123 | (with-tramp-connection-property vec "pipe-buf" |
| 4090 | (tramp-send-command-and-read | 4124 | (tramp-send-command-and-read |
| 4091 | vec "getconf PIPE_BUF / 2>/dev/null || echo 4096" 'noerror))) | 4125 | vec |
| 4126 | (format "getconf PIPE_BUF / 2>%s || echo 4096" | ||
| 4127 | (tramp-get-remote-null-device vec)) | ||
| 4128 | 'noerror))) | ||
| 4092 | tmpfile chunk chunksize) | 4129 | tmpfile chunk chunksize) |
| 4093 | (tramp-message vec 5 "Setting $PATH environment variable") | 4130 | (tramp-message vec 5 "Setting $PATH environment variable") |
| 4094 | (if (< (length command) pipe-buf) | 4131 | (if (< (length command) pipe-buf) |
| @@ -4410,7 +4447,12 @@ process to set up. VEC specifies the connection." | |||
| 4410 | (tramp-find-shell vec) | 4447 | (tramp-find-shell vec) |
| 4411 | 4448 | ||
| 4412 | ;; Disable unexpected output. | 4449 | ;; Disable unexpected output. |
| 4413 | (tramp-send-command vec "mesg n 2>/dev/null; biff n 2>/dev/null" t) | 4450 | (tramp-send-command |
| 4451 | vec | ||
| 4452 | (format "mesg n 2>%s; biff n 2>%s" | ||
| 4453 | (tramp-get-remote-null-device vec) | ||
| 4454 | (tramp-get-remote-null-device vec)) | ||
| 4455 | t) | ||
| 4414 | 4456 | ||
| 4415 | ;; IRIX64 bash expands "!" even when in single quotes. This | 4457 | ;; IRIX64 bash expands "!" even when in single quotes. This |
| 4416 | ;; destroys our shell functions, we must disable it. See | 4458 | ;; destroys our shell functions, we must disable it. See |
| @@ -4425,7 +4467,8 @@ process to set up. VEC specifies the connection." | |||
| 4425 | 4467 | ||
| 4426 | ;; Set utf8 encoding. Needed for macOS, for example. This is | 4468 | ;; Set utf8 encoding. Needed for macOS, for example. This is |
| 4427 | ;; non-POSIX, so we must expect errors on some systems. | 4469 | ;; non-POSIX, so we must expect errors on some systems. |
| 4428 | (tramp-send-command vec "stty iutf8 2>/dev/null" t) | 4470 | (tramp-send-command |
| 4471 | vec (concat "stty iutf8 2>" (tramp-get-remote-null-device vec)) t) | ||
| 4429 | 4472 | ||
| 4430 | ;; Set `remote-tty' process property. | 4473 | ;; Set `remote-tty' process property. |
| 4431 | (let ((tty (tramp-send-command-and-read vec "echo \\\"`tty`\\\"" 'noerror))) | 4474 | (let ((tty (tramp-send-command-and-read vec "echo \\\"`tty`\\\"" 'noerror))) |
| @@ -4541,7 +4584,8 @@ program will be transferred to the remote host, and it is | |||
| 4541 | available as shell function with the same name. A \"%t\" format | 4584 | available as shell function with the same name. A \"%t\" format |
| 4542 | specifier in the variable value denotes a temporary file. | 4585 | specifier in the variable value denotes a temporary file. |
| 4543 | \"%a\", \"%h\" and \"%o\" format specifiers are replaced by the | 4586 | \"%a\", \"%h\" and \"%o\" format specifiers are replaced by the |
| 4544 | respective `awk', `hexdump' and `od' commands. | 4587 | respective `awk', `hexdump' and `od' commands. \"%n\" is |
| 4588 | replaced by \"2>/dev/null\". | ||
| 4545 | 4589 | ||
| 4546 | The optional TEST command can be used for further tests, whether | 4590 | The optional TEST command can be used for further tests, whether |
| 4547 | ENCODING and DECODING are applicable.") | 4591 | ENCODING and DECODING are applicable.") |
| @@ -4628,6 +4672,8 @@ Goes through the list `tramp-local-coding-commands' and | |||
| 4628 | (format-spec-make | 4672 | (format-spec-make |
| 4629 | ?a (tramp-get-remote-awk vec) | 4673 | ?a (tramp-get-remote-awk vec) |
| 4630 | ?h (tramp-get-remote-hexdump vec) | 4674 | ?h (tramp-get-remote-hexdump vec) |
| 4675 | ?n (concat | ||
| 4676 | "2>" (tramp-get-remote-null-device vec)) | ||
| 4631 | ?o (tramp-get-remote-od vec))) | 4677 | ?o (tramp-get-remote-od vec))) |
| 4632 | value (replace-regexp-in-string "%" "%%" value))) | 4678 | value (replace-regexp-in-string "%" "%%" value))) |
| 4633 | (tramp-maybe-send-script vec value name) | 4679 | (tramp-maybe-send-script vec value name) |
| @@ -4636,7 +4682,10 @@ Goes through the list `tramp-local-coding-commands' and | |||
| 4636 | vec 5 | 4682 | vec 5 |
| 4637 | "Checking remote encoding command `%s' for sanity" rem-enc) | 4683 | "Checking remote encoding command `%s' for sanity" rem-enc) |
| 4638 | (unless (tramp-send-command-and-check | 4684 | (unless (tramp-send-command-and-check |
| 4639 | vec (format "%s </dev/null" rem-enc) t) | 4685 | vec |
| 4686 | (format | ||
| 4687 | "%s <%s" rem-enc (tramp-get-remote-null-device vec)) | ||
| 4688 | t) | ||
| 4640 | (throw 'wont-work-remote nil)) | 4689 | (throw 'wont-work-remote nil)) |
| 4641 | 4690 | ||
| 4642 | (unless (stringp rem-dec) | 4691 | (unless (stringp rem-dec) |
| @@ -4652,6 +4701,8 @@ Goes through the list `tramp-local-coding-commands' and | |||
| 4652 | (format-spec-make | 4701 | (format-spec-make |
| 4653 | ?a (tramp-get-remote-awk vec) | 4702 | ?a (tramp-get-remote-awk vec) |
| 4654 | ?h (tramp-get-remote-hexdump vec) | 4703 | ?h (tramp-get-remote-hexdump vec) |
| 4704 | ?n (concat | ||
| 4705 | "2>" (tramp-get-remote-null-device vec)) | ||
| 4655 | ?o (tramp-get-remote-od vec))) | 4706 | ?o (tramp-get-remote-od vec))) |
| 4656 | value (replace-regexp-in-string "%" "%%" value))) | 4707 | value (replace-regexp-in-string "%" "%%" value))) |
| 4657 | (when (string-match-p "\\(^\\|[^%]\\)%t" value) | 4708 | (when (string-match-p "\\(^\\|[^%]\\)%t" value) |
| @@ -4698,7 +4749,7 @@ Goes through the list `tramp-local-coding-commands' and | |||
| 4698 | "Call the local encoding or decoding command. | 4749 | "Call the local encoding or decoding command. |
| 4699 | If CMD contains \"%s\", provide input file INPUT there in command. | 4750 | If CMD contains \"%s\", provide input file INPUT there in command. |
| 4700 | Otherwise, INPUT is passed via standard input. | 4751 | Otherwise, INPUT is passed via standard input. |
| 4701 | INPUT can also be nil which means `/dev/null'. | 4752 | INPUT can also be nil which means `null-device'. |
| 4702 | OUTPUT can be a string (which specifies a file name), or t (which | 4753 | OUTPUT can be a string (which specifies a file name), or t (which |
| 4703 | means standard output and thus the current buffer), or nil (which | 4754 | means standard output and thus the current buffer), or nil (which |
| 4704 | means discard it)." | 4755 | means discard it)." |
| @@ -5170,14 +5221,17 @@ status is 0, and nil otherwise. | |||
| 5170 | 5221 | ||
| 5171 | If the optional argument SUBSHELL is non-nil, the command is | 5222 | If the optional argument SUBSHELL is non-nil, the command is |
| 5172 | executed in a subshell, ie surrounded by parentheses. If | 5223 | executed in a subshell, ie surrounded by parentheses. If |
| 5173 | DONT-SUPPRESS-ERR is non-nil, stderr won't be sent to /dev/null. | 5224 | DONT-SUPPRESS-ERR is non-nil, stderr won't be sent to \"/dev/null\". |
| 5174 | Optional argument EXIT-STATUS, if non-nil, triggers the return of | 5225 | Optional argument EXIT-STATUS, if non-nil, triggers the return of |
| 5175 | the exit status." | 5226 | the exit status." |
| 5176 | (tramp-send-command | 5227 | (tramp-send-command |
| 5177 | vec | 5228 | vec |
| 5178 | (concat (if subshell "( " "") | 5229 | (concat (if subshell "( " "") |
| 5179 | command | 5230 | command |
| 5180 | (if command (if dont-suppress-err "; " " 2>/dev/null; ") "") | 5231 | (if command |
| 5232 | (if dont-suppress-err | ||
| 5233 | "; " (format " 2>%s; " (tramp-get-remote-null-device vec))) | ||
| 5234 | "") | ||
| 5181 | "echo tramp_exit_status $?" | 5235 | "echo tramp_exit_status $?" |
| 5182 | (if subshell " )" ""))) | 5236 | (if subshell " )" ""))) |
| 5183 | (with-current-buffer (tramp-get-connection-buffer vec) | 5237 | (with-current-buffer (tramp-get-connection-buffer vec) |
| @@ -5387,7 +5441,11 @@ Nonexistent directories are removed from spec." | |||
| 5387 | (when elt1 | 5441 | (when elt1 |
| 5388 | (or | 5442 | (or |
| 5389 | (tramp-send-command-and-read | 5443 | (tramp-send-command-and-read |
| 5390 | vec "echo \\\"`getconf PATH 2>/dev/null`\\\"" 'noerror) | 5444 | vec |
| 5445 | (format | ||
| 5446 | "echo \\\"`getconf PATH 2>%s`\\\"" | ||
| 5447 | (tramp-get-remote-null-device vec)) | ||
| 5448 | 'noerror) | ||
| 5391 | ;; Default if "getconf" is not available. | 5449 | ;; Default if "getconf" is not available. |
| 5392 | (progn | 5450 | (progn |
| 5393 | (tramp-message | 5451 | (tramp-message |
| @@ -5491,7 +5549,8 @@ Nonexistent directories are removed from spec." | |||
| 5491 | vec (format "%s -lnd /" result)) | 5549 | vec (format "%s -lnd /" result)) |
| 5492 | (when (tramp-send-command-and-check | 5550 | (when (tramp-send-command-and-check |
| 5493 | vec (format | 5551 | vec (format |
| 5494 | "%s --color=never -al /dev/null" result)) | 5552 | "%s --color=never -al %s" |
| 5553 | result (tramp-get-remote-null-device vec))) | ||
| 5495 | (setq result (concat result " --color=never"))) | 5554 | (setq result (concat result " --color=never"))) |
| 5496 | (throw 'ls-found result)) | 5555 | (throw 'ls-found result)) |
| 5497 | (setq dl (cdr dl)))))) | 5556 | (setq dl (cdr dl)))))) |
| @@ -5512,7 +5571,9 @@ Nonexistent directories are removed from spec." | |||
| 5512 | (format | 5571 | (format |
| 5513 | "%s --help 2>&1 | grep -iq busybox" (tramp-get-ls-command vec)))) | 5572 | "%s --help 2>&1 | grep -iq busybox" (tramp-get-ls-command vec)))) |
| 5514 | (tramp-send-command-and-check | 5573 | (tramp-send-command-and-check |
| 5515 | vec (format "%s %s -al /dev/null" (tramp-get-ls-command vec) option)) | 5574 | vec (format |
| 5575 | "%s %s -al %s" | ||
| 5576 | (tramp-get-ls-command vec) option (tramp-get-remote-null-device vec))) | ||
| 5516 | option))) | 5577 | option))) |
| 5517 | 5578 | ||
| 5518 | (defun tramp-get-test-command (vec) | 5579 | (defun tramp-get-test-command (vec) |
| @@ -5791,7 +5852,7 @@ This command is returned only if `delete-by-moving-to-trash' is non-nil." | |||
| 5791 | (command (format "%s %s" busybox "awk"))) | 5852 | (command (format "%s %s" busybox "awk"))) |
| 5792 | (and busybox | 5853 | (and busybox |
| 5793 | (tramp-send-command-and-check | 5854 | (tramp-send-command-and-check |
| 5794 | vec (concat command " {} </dev/null")) | 5855 | vec (concat command " {} <" (tramp-get-remote-null-device vec))) |
| 5795 | command))))) | 5856 | command))))) |
| 5796 | 5857 | ||
| 5797 | (defun tramp-get-remote-hexdump (vec) | 5858 | (defun tramp-get-remote-hexdump (vec) |
| @@ -5802,7 +5863,8 @@ This command is returned only if `delete-by-moving-to-trash' is non-nil." | |||
| 5802 | (let* ((busybox (tramp-get-remote-busybox vec)) | 5863 | (let* ((busybox (tramp-get-remote-busybox vec)) |
| 5803 | (command (format "%s %s" busybox "hexdump"))) | 5864 | (command (format "%s %s" busybox "hexdump"))) |
| 5804 | (and busybox | 5865 | (and busybox |
| 5805 | (tramp-send-command-and-check vec (concat command " </dev/null")) | 5866 | (tramp-send-command-and-check |
| 5867 | vec (concat command " <" (tramp-get-remote-null-device vec))) | ||
| 5806 | command))))) | 5868 | command))))) |
| 5807 | 5869 | ||
| 5808 | (defun tramp-get-remote-od (vec) | 5870 | (defun tramp-get-remote-od (vec) |
| @@ -5814,7 +5876,8 @@ This command is returned only if `delete-by-moving-to-trash' is non-nil." | |||
| 5814 | (command (format "%s %s" busybox "od"))) | 5876 | (command (format "%s %s" busybox "od"))) |
| 5815 | (and busybox | 5877 | (and busybox |
| 5816 | (tramp-send-command-and-check | 5878 | (tramp-send-command-and-check |
| 5817 | vec (concat command " -A n </dev/null")) | 5879 | vec |
| 5880 | (concat command " -A n <" (tramp-get-remote-null-device vec))) | ||
| 5818 | command))))) | 5881 | command))))) |
| 5819 | 5882 | ||
| 5820 | (defun tramp-get-remote-chmod-h (vec) | 5883 | (defun tramp-get-remote-chmod-h (vec) |
| @@ -5836,7 +5899,9 @@ This command is returned only if `delete-by-moving-to-trash' is non-nil." | |||
| 5836 | (tramp-message vec 5 "Checking, whether `env -u' works") | 5899 | (tramp-message vec 5 "Checking, whether `env -u' works") |
| 5837 | ;; Option "-u" is a GNU extension. | 5900 | ;; Option "-u" is a GNU extension. |
| 5838 | (tramp-send-command-and-check | 5901 | (tramp-send-command-and-check |
| 5839 | vec "env FOO=foo env -u FOO 2>/dev/null | grep -qv FOO" t))) | 5902 | vec (format "env FOO=foo env -u FOO 2>%s | grep -qv FOO" |
| 5903 | (tramp-get-remote-null-device vec)) | ||
| 5904 | t))) | ||
| 5840 | 5905 | ||
| 5841 | ;; Some predefined connection properties. | 5906 | ;; Some predefined connection properties. |
| 5842 | (defun tramp-get-inline-compress (vec prop size) | 5907 | (defun tramp-get-inline-compress (vec prop size) |
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 8a48ffc09b8..cafa97cec09 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el | |||
| @@ -74,7 +74,7 @@ | |||
| 74 | :version "24.4") | 74 | :version "24.4") |
| 75 | 75 | ||
| 76 | ;;;###tramp-autoload | 76 | ;;;###tramp-autoload |
| 77 | (defcustom tramp-smb-conf "/dev/null" | 77 | (defcustom tramp-smb-conf null-device |
| 78 | "Path of the \"smb.conf\" file. | 78 | "Path of the \"smb.conf\" file. |
| 79 | If it is nil, no \"smb.conf\" will be added to the `tramp-smb-program' | 79 | If it is nil, no \"smb.conf\" will be added to the `tramp-smb-program' |
| 80 | call, letting the SMB client use the default one." | 80 | call, letting the SMB client use the default one." |
| @@ -797,7 +797,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." | |||
| 797 | (setq | 797 | (setq |
| 798 | args | 798 | args |
| 799 | (append args (list (tramp-unquote-shell-quote-argument localname) | 799 | (append args (list (tramp-unquote-shell-quote-argument localname) |
| 800 | "2>/dev/null"))) | 800 | (concat "2>" (tramp-get-remote-null-device v))))) |
| 801 | 801 | ||
| 802 | (unwind-protect | 802 | (unwind-protect |
| 803 | (with-temp-buffer | 803 | (with-temp-buffer |
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index a98d478bc1a..d40f9a5927c 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el | |||
| @@ -238,6 +238,7 @@ pair of the form (KEY VALUE). The following KEYs are defined: | |||
| 238 | - \"%k\" indicates the keep-date parameter of a program, if exists. | 238 | - \"%k\" indicates the keep-date parameter of a program, if exists. |
| 239 | - \"%c\" adds additional `tramp-ssh-controlmaster-options' | 239 | - \"%c\" adds additional `tramp-ssh-controlmaster-options' |
| 240 | options for the first hop. | 240 | options for the first hop. |
| 241 | - \"%n\" expands to \"2>/dev/null\". | ||
| 241 | 242 | ||
| 242 | The existence of `tramp-login-args', combined with the | 243 | The existence of `tramp-login-args', combined with the |
| 243 | absence of `tramp-copy-args', is an indication that the | 244 | absence of `tramp-copy-args', is an indication that the |
| @@ -5325,7 +5326,9 @@ name of a process or buffer, or nil to default to the current buffer." | |||
| 5325 | (tramp-compat-funcall | 5326 | (tramp-compat-funcall |
| 5326 | 'tramp-send-command | 5327 | 'tramp-send-command |
| 5327 | (process-get proc 'vector) | 5328 | (process-get proc 'vector) |
| 5328 | (format "(\\kill -2 -%d || \\kill -2 %d) 2>/dev/null" pid pid)) | 5329 | (format "(\\kill -2 -%d || \\kill -2 %d) 2>%s" |
| 5330 | pid pid | ||
| 5331 | (tramp-get-remote-null-device (process-get proc 'vector)))) | ||
| 5329 | ;; Wait, until the process has disappeared. If it doesn't, | 5332 | ;; Wait, until the process has disappeared. If it doesn't, |
| 5330 | ;; fall back to the default implementation. | 5333 | ;; fall back to the default implementation. |
| 5331 | (while (tramp-accept-process-output proc 0)) | 5334 | (while (tramp-accept-process-output proc 0)) |
| @@ -5339,6 +5342,15 @@ name of a process or buffer, or nil to default to the current buffer." | |||
| 5339 | (lambda () | 5342 | (lambda () |
| 5340 | (remove-hook 'interrupt-process-functions #'tramp-interrupt-process)))) | 5343 | (remove-hook 'interrupt-process-functions #'tramp-interrupt-process)))) |
| 5341 | 5344 | ||
| 5345 | (defun tramp-get-remote-null-device (vec) | ||
| 5346 | "Return null device on the remote host identified by VEC. | ||
| 5347 | If VEC is nil, return local null device." | ||
| 5348 | (if (null vec) | ||
| 5349 | null-device | ||
| 5350 | (with-tramp-connection-property vec "null-device" | ||
| 5351 | (let ((default-directory (tramp-make-tramp-file-name vec))) | ||
| 5352 | (tramp-compat-null-device))))) | ||
| 5353 | |||
| 5342 | (defmacro tramp-skeleton-delete-directory (directory recursive trash &rest body) | 5354 | (defmacro tramp-skeleton-delete-directory (directory recursive trash &rest body) |
| 5343 | "Skeleton for `tramp-*-handle-delete-directory'. | 5355 | "Skeleton for `tramp-*-handle-delete-directory'. |
| 5344 | BODY is the backend specific code." | 5356 | BODY is the backend specific code." |
diff --git a/lisp/newcomment.el b/lisp/newcomment.el index e111ae8e225..3eb158dc2c8 100644 --- a/lisp/newcomment.el +++ b/lisp/newcomment.el | |||
| @@ -1292,7 +1292,15 @@ changed with `comment-style'." | |||
| 1292 | 1292 | ||
| 1293 | (defun comment-region-default (beg end &optional arg) | 1293 | (defun comment-region-default (beg end &optional arg) |
| 1294 | (if comment-combine-change-calls | 1294 | (if comment-combine-change-calls |
| 1295 | (combine-change-calls beg end (comment-region-default-1 beg end arg)) | 1295 | (combine-change-calls beg |
| 1296 | ;; A new line might get inserted and whitespace deleted | ||
| 1297 | ;; after END for line comments. Ensure the next argument is | ||
| 1298 | ;; after any and all changes. | ||
| 1299 | (save-excursion | ||
| 1300 | (goto-char end) | ||
| 1301 | (forward-line) | ||
| 1302 | (point)) | ||
| 1303 | (comment-region-default-1 beg end arg)) | ||
| 1296 | (comment-region-default-1 beg end arg))) | 1304 | (comment-region-default-1 beg end arg))) |
| 1297 | 1305 | ||
| 1298 | ;;;###autoload | 1306 | ;;;###autoload |
diff --git a/lisp/org/org.el b/lisp/org/org.el index 1ab8ab68880..d2a36dd0bad 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el | |||
| @@ -18535,8 +18535,7 @@ an argument, unconditionally call `org-insert-heading'." | |||
| 18535 | ("Customize" | 18535 | ("Customize" |
| 18536 | ["Browse Org Group" org-customize t] | 18536 | ["Browse Org Group" org-customize t] |
| 18537 | "--" | 18537 | "--" |
| 18538 | ["Expand This Menu" org-create-customize-menu | 18538 | ["Expand This Menu" org-create-customize-menu t]) |
| 18539 | (fboundp 'customize-menu-create)]) | ||
| 18540 | ["Send bug report" org-submit-bug-report t] | 18539 | ["Send bug report" org-submit-bug-report t] |
| 18541 | "--" | 18540 | "--" |
| 18542 | ("Refresh/Reload" | 18541 | ("Refresh/Reload" |
| @@ -18709,20 +18708,17 @@ With prefix arg UNCOMPILED, load the uncompiled versions." | |||
| 18709 | (interactive) | 18708 | (interactive) |
| 18710 | (org-load-modules-maybe) | 18709 | (org-load-modules-maybe) |
| 18711 | (org-require-autoloaded-modules) | 18710 | (org-require-autoloaded-modules) |
| 18712 | (if (fboundp 'customize-menu-create) | 18711 | (easy-menu-change |
| 18713 | (progn | 18712 | '("Org") "Customize" |
| 18714 | (easy-menu-change | 18713 | `(["Browse Org group" org-customize t] |
| 18715 | '("Org") "Customize" | 18714 | "--" |
| 18716 | `(["Browse Org group" org-customize t] | 18715 | ,(customize-menu-create 'org) |
| 18717 | "--" | 18716 | ["Set" Custom-set t] |
| 18718 | ,(customize-menu-create 'org) | 18717 | ["Save" Custom-save t] |
| 18719 | ["Set" Custom-set t] | 18718 | ["Reset to Current" Custom-reset-current t] |
| 18720 | ["Save" Custom-save t] | 18719 | ["Reset to Saved" Custom-reset-saved t] |
| 18721 | ["Reset to Current" Custom-reset-current t] | 18720 | ["Reset to Standard Settings" Custom-reset-standard t])) |
| 18722 | ["Reset to Saved" Custom-reset-saved t] | 18721 | (message "\"Org\"-menu now contains full customization menu")) |
| 18723 | ["Reset to Standard Settings" Custom-reset-standard t])) | ||
| 18724 | (message "\"Org\"-menu now contains full customization menu")) | ||
| 18725 | (error "Cannot expand menu (outdated version of cus-edit.el)"))) | ||
| 18726 | 18722 | ||
| 18727 | ;;;; Miscellaneous stuff | 18723 | ;;;; Miscellaneous stuff |
| 18728 | 18724 | ||
diff --git a/lisp/password-cache.el b/lisp/password-cache.el index 2443f374a84..375d06c74fd 100644 --- a/lisp/password-cache.el +++ b/lisp/password-cache.el | |||
| @@ -103,9 +103,7 @@ that a password is invalid, so that `password-read' query the | |||
| 103 | user again." | 103 | user again." |
| 104 | (let ((password (gethash key password-data))) | 104 | (let ((password (gethash key password-data))) |
| 105 | (when (stringp password) | 105 | (when (stringp password) |
| 106 | (if (fboundp 'clear-string) | 106 | (clear-string password)) |
| 107 | (clear-string password) | ||
| 108 | (fillarray password ?_))) | ||
| 109 | (remhash key password-data))) | 107 | (remhash key password-data))) |
| 110 | 108 | ||
| 111 | (defun password-cache-add (key password) | 109 | (defun password-cache-add (key password) |
diff --git a/lisp/pcmpl-gnu.el b/lisp/pcmpl-gnu.el index fa84b31675e..c6050094498 100644 --- a/lisp/pcmpl-gnu.el +++ b/lisp/pcmpl-gnu.el | |||
| @@ -65,15 +65,14 @@ | |||
| 65 | "Find all zipped or unzipped files: the inverse of UNZIP-P." | 65 | "Find all zipped or unzipped files: the inverse of UNZIP-P." |
| 66 | (pcomplete-entries | 66 | (pcomplete-entries |
| 67 | nil | 67 | nil |
| 68 | (function | 68 | (lambda (entry) |
| 69 | (lambda (entry) | 69 | (or (file-directory-p entry) |
| 70 | (or (file-directory-p entry) | 70 | (when (and (file-readable-p entry) |
| 71 | (when (and (file-readable-p entry) | 71 | (file-regular-p entry)) |
| 72 | (file-regular-p entry)) | 72 | (let ((zipped (string-match "\\.\\(t?gz\\|\\(ta\\)?Z\\)\\'" |
| 73 | (let ((zipped (string-match "\\.\\(t?gz\\|\\(ta\\)?Z\\)\\'" | 73 | entry))) |
| 74 | entry))) | 74 | (or (and unzip-p zipped) |
| 75 | (or (and unzip-p zipped) | 75 | (and (not unzip-p) (not zipped))))))))) |
| 76 | (and (not unzip-p) (not zipped)))))))))) | ||
| 77 | 76 | ||
| 78 | ;;;###autoload | 77 | ;;;###autoload |
| 79 | (defun pcomplete/bzip2 () | 78 | (defun pcomplete/bzip2 () |
| @@ -92,13 +91,12 @@ | |||
| 92 | "Find all zipped or unzipped files: the inverse of UNZIP-P." | 91 | "Find all zipped or unzipped files: the inverse of UNZIP-P." |
| 93 | (pcomplete-entries | 92 | (pcomplete-entries |
| 94 | nil | 93 | nil |
| 95 | (function | 94 | (lambda (entry) |
| 96 | (lambda (entry) | 95 | (when (and (file-readable-p entry) |
| 97 | (when (and (file-readable-p entry) | 96 | (file-regular-p entry)) |
| 98 | (file-regular-p entry)) | 97 | (let ((zipped (string-match "\\.\\(t?z2\\|bz2\\)\\'" entry))) |
| 99 | (let ((zipped (string-match "\\.\\(t?z2\\|bz2\\)\\'" entry))) | 98 | (or (and unzip-p zipped) |
| 100 | (or (and unzip-p zipped) | 99 | (and (not unzip-p) (not zipped)))))))) |
| 101 | (and (not unzip-p) (not zipped))))))))) | ||
| 102 | 100 | ||
| 103 | ;;;###autoload | 101 | ;;;###autoload |
| 104 | (defun pcomplete/make () | 102 | (defun pcomplete/make () |
diff --git a/lisp/play/handwrite.el b/lisp/play/handwrite.el index 1cf690a86db..06ea54cb473 100644 --- a/lisp/play/handwrite.el +++ b/lisp/play/handwrite.el | |||
| @@ -233,7 +233,7 @@ Variables: `handwrite-linespace' (default 12) | |||
| 233 | )) | 233 | )) |
| 234 | (switch-to-buffer ps-buf-name) | 234 | (switch-to-buffer ps-buf-name) |
| 235 | (forward-line 1) | 235 | (forward-line 1) |
| 236 | (insert "showpage exec Hwsave restore\n\n") | 236 | (insert " showpage exec Hwsave restore\n\n") |
| 237 | (insert "%%Pages " (number-to-string ipage) " 0\n") | 237 | (insert "%%Pages " (number-to-string ipage) " 0\n") |
| 238 | (insert "%%EOF\n") | 238 | (insert "%%EOF\n") |
| 239 | ;;To avoid cumbersome code we simply ignore formfeeds | 239 | ;;To avoid cumbersome code we simply ignore formfeeds |
diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index 7e36e1f2e3c..9a044fcef31 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el | |||
| @@ -3684,7 +3684,7 @@ When \"(\" is present, that defun will attempt to parse a | |||
| 3684 | parenthesized expression inside the template. When \")\" is | 3684 | parenthesized expression inside the template. When \")\" is |
| 3685 | present it will treat an unbalanced closing paren as a sign of | 3685 | present it will treat an unbalanced closing paren as a sign of |
| 3686 | the invalidity of the putative template construct." | 3686 | the invalidity of the putative template construct." |
| 3687 | t "[<;{},|+&->)]" | 3687 | t "[<;{},|+&>)-]" |
| 3688 | c++ "[<;{},>()]") | 3688 | c++ "[<;{},>()]") |
| 3689 | (c-lang-defvar c-<>-notable-chars-re (c-lang-const c-<>-notable-chars-re)) | 3689 | (c-lang-defvar c-<>-notable-chars-re (c-lang-const c-<>-notable-chars-re)) |
| 3690 | 3690 | ||
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index e0dabed6a7a..de9c9a209d1 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el | |||
| @@ -334,48 +334,44 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1)) | |||
| 334 | ": \\*\\*\\* \\[\\(\\(.+?\\):\\([0-9]+\\): .+\\)\\]" 2 3 nil 0 1) | 334 | ": \\*\\*\\* \\[\\(\\(.+?\\):\\([0-9]+\\): .+\\)\\]" 2 3 nil 0 1) |
| 335 | 335 | ||
| 336 | (gnu | 336 | (gnu |
| 337 | ;; The first line matches the program name for | ||
| 338 | |||
| 339 | ;; PROGRAM:SOURCE-FILE-NAME:LINENO: MESSAGE | ||
| 340 | |||
| 341 | ;; format, which is used for non-interactive programs other than | ||
| 342 | ;; compilers (e.g. the "jade:" entry in compilation.txt). | ||
| 343 | |||
| 344 | ;; This first line makes things ambiguous with output such as | ||
| 345 | ;; "foo:344:50:blabla" since the "foo" part can match this first | ||
| 346 | ;; line (in which case the file name as "344"). To avoid this, | ||
| 347 | ;; the second line disallows filenames exclusively composed of | ||
| 348 | ;; digits. | ||
| 349 | |||
| 350 | ;; Similarly, we get lots of false positives with messages including | ||
| 351 | ;; times of the form "HH:MM:SS" where MM is taken as a line number, so | ||
| 352 | ;; the last line tries to rule out message where the info after the | ||
| 353 | ;; line number starts with "SS". --Stef | ||
| 354 | |||
| 355 | ;; The core of the regexp is the one with *?. It says that a file name | ||
| 356 | ;; can be composed of any non-newline char, but it also rules out some | ||
| 357 | ;; valid but unlikely cases, such as a trailing space or a space | ||
| 358 | ;; followed by a -, or a colon followed by a space. | ||
| 359 | ;; | ||
| 360 | ;; The "in \\|from " exception was added to handle messages from Ruby. | ||
| 361 | ,(rx | 337 | ,(rx |
| 362 | bol | 338 | bol |
| 339 | ;; Match an optional program name in the format | ||
| 340 | ;; PROGRAM:SOURCE-FILE-NAME:LINENO: MESSAGE | ||
| 341 | ;; which is used for non-interactive programs other than | ||
| 342 | ;; compilers (e.g. the "jade:" entry in compilation.txt). | ||
| 363 | (? (| (regexp "[[:alpha:]][-[:alnum:].]+: ?") | 343 | (? (| (regexp "[[:alpha:]][-[:alnum:].]+: ?") |
| 344 | ;; FIXME: This pattern was added for handling messages | ||
| 345 | ;; from Ruby, but it is unclear whether it is actually | ||
| 346 | ;; used since the gcc-include rule above seems to cover | ||
| 347 | ;; it. | ||
| 364 | (regexp "[ \t]+\\(?:in \\|from\\)"))) | 348 | (regexp "[ \t]+\\(?:in \\|from\\)"))) |
| 365 | (group-n 1 (: (regexp "[0-9]*[^0-9\n]") | 349 | |
| 366 | (*? (| (regexp "[^\n :]") | 350 | ;; File name group. |
| 367 | (regexp " [^-/\n]") | 351 | (group-n 1 |
| 368 | (regexp ":[^ \n]"))))) | 352 | ;; Avoid matching the file name as a program in the pattern |
| 353 | ;; above by disallow file names entirely composed of digits. | ||
| 354 | (: (regexp "[0-9]*[^0-9\n]") | ||
| 355 | ;; This rule says that a file name can be composed | ||
| 356 | ;; of any non-newline char, but it also rules out | ||
| 357 | ;; some valid but unlikely cases, such as a | ||
| 358 | ;; trailing space or a space followed by a -, or a | ||
| 359 | ;; colon followed by a space. | ||
| 360 | (*? (| (regexp "[^\n :]") | ||
| 361 | (regexp " [^-/\n]") | ||
| 362 | (regexp ":[^ \n]"))))) | ||
| 369 | (regexp ": ?") | 363 | (regexp ": ?") |
| 364 | |||
| 365 | ;; Line number group. | ||
| 370 | (group-n 2 (regexp "[0-9]+")) | 366 | (group-n 2 (regexp "[0-9]+")) |
| 371 | (? (| (: "-" | 367 | (? (| (: "-" |
| 372 | (group-n 4 (regexp "[0-9]+")) | 368 | (group-n 4 (regexp "[0-9]+")) ; ending line |
| 373 | (? "." (group-n 5 (regexp "[0-9]+")))) | 369 | (? "." (group-n 5 (regexp "[0-9]+")))) ; ending column |
| 374 | (: (in ".:") | 370 | (: (in ".:") |
| 375 | (group-n 3 (regexp "[0-9]+")) | 371 | (group-n 3 (regexp "[0-9]+")) ; starting column |
| 376 | (? "-" | 372 | (? "-" |
| 377 | (? (group-n 4 (regexp "[0-9]+")) ".") | 373 | (? (group-n 4 (regexp "[0-9]+")) ".") ; ending line |
| 378 | (group-n 5 (regexp "[0-9]+")))))) | 374 | (group-n 5 (regexp "[0-9]+")))))) ; ending column |
| 379 | ":" | 375 | ":" |
| 380 | (| (: (* " ") | 376 | (| (: (* " ") |
| 381 | (group-n 6 (| "FutureWarning" | 377 | (group-n 6 (| "FutureWarning" |
| @@ -392,6 +388,11 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1)) | |||
| 392 | (regexp "[Nn]ote")))) | 388 | (regexp "[Nn]ote")))) |
| 393 | (: (* " ") | 389 | (: (* " ") |
| 394 | (regexp "[Ee]rror")) | 390 | (regexp "[Ee]rror")) |
| 391 | |||
| 392 | ;; Avoid matching time stamps on the form "HH:MM:SS" where | ||
| 393 | ;; MM is interpreted as a line number by trying to rule out | ||
| 394 | ;; messages where the text after the line number starts with | ||
| 395 | ;; a 2-digit number. | ||
| 395 | (: (regexp "[0-9]?") | 396 | (: (regexp "[0-9]?") |
| 396 | (| (regexp "[^0-9\n]") | 397 | (| (regexp "[^0-9\n]") |
| 397 | eol)) | 398 | eol)) |
diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index a42ace105aa..30a80ea8f22 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el | |||
| @@ -54,8 +54,6 @@ | |||
| 54 | ;; of other details. | 54 | ;; of other details. |
| 55 | 55 | ||
| 56 | ;; The mode information (on C-h m) provides some customization help. | 56 | ;; The mode information (on C-h m) provides some customization help. |
| 57 | ;; If you use font-lock feature of this mode, it is advisable to use | ||
| 58 | ;; either lazy-lock-mode or fast-lock-mode. I prefer lazy-lock. | ||
| 59 | 57 | ||
| 60 | ;; Faces used now: three faces for first-class and second-class keywords | 58 | ;; Faces used now: three faces for first-class and second-class keywords |
| 61 | ;; and control flow words, one for each: comments, string, labels, | 59 | ;; and control flow words, one for each: comments, string, labels, |
| @@ -402,7 +400,7 @@ Font for POD headers." | |||
| 402 | :version "21.1" | 400 | :version "21.1" |
| 403 | :group 'cperl-faces) | 401 | :group 'cperl-faces) |
| 404 | 402 | ||
| 405 | (defcustom cperl-pod-here-fontify '(featurep 'font-lock) | 403 | (defcustom cperl-pod-here-fontify t |
| 406 | "Not-nil after evaluation means to highlight POD and here-docs sections." | 404 | "Not-nil after evaluation means to highlight POD and here-docs sections." |
| 407 | :type 'boolean | 405 | :type 'boolean |
| 408 | :group 'cperl-faces) | 406 | :group 'cperl-faces) |
| @@ -3959,7 +3957,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', | |||
| 3959 | (not (memq (preceding-char) | 3957 | (not (memq (preceding-char) |
| 3960 | '(?$ ?@ ?& ?%))) | 3958 | '(?$ ?@ ?& ?%))) |
| 3961 | (looking-at | 3959 | (looking-at |
| 3962 | "\\(while\\|if\\|unless\\|until\\|and\\|or\\|not\\|xor\\|split\\|grep\\|map\\|print\\|say\\)\\>"))))) | 3960 | "\\(while\\|if\\|unless\\|until\\|and\\|or\\|not\\|xor\\|split\\|grep\\|map\\|print\\|say\\|return\\)\\>"))))) |
| 3963 | (and (eq (preceding-char) ?.) | 3961 | (and (eq (preceding-char) ?.) |
| 3964 | (eq (char-after (- (point) 2)) ?.)) | 3962 | (eq (char-after (- (point) 2)) ?.)) |
| 3965 | (bobp)) | 3963 | (bobp)) |
| @@ -5442,11 +5440,10 @@ indentation and initial hashes. Behaves usually outside of comment." | |||
| 5442 | (cperl-init-faces)))) | 5440 | (cperl-init-faces)))) |
| 5443 | ((not cperl-faces-init) | 5441 | ((not cperl-faces-init) |
| 5444 | (add-hook 'font-lock-mode-hook | 5442 | (add-hook 'font-lock-mode-hook |
| 5445 | (function | 5443 | (lambda () |
| 5446 | (lambda () | 5444 | (if (memq major-mode '(perl-mode cperl-mode)) |
| 5447 | (if (memq major-mode '(perl-mode cperl-mode)) | 5445 | (progn |
| 5448 | (progn | 5446 | (or cperl-faces-init (cperl-init-faces)))))) |
| 5449 | (or cperl-faces-init (cperl-init-faces))))))) | ||
| 5450 | (eval-after-load | 5447 | (eval-after-load |
| 5451 | "ps-print" | 5448 | "ps-print" |
| 5452 | '(or cperl-faces-init (cperl-init-faces)))))) | 5449 | '(or cperl-faces-init (cperl-init-faces)))))) |
| @@ -6073,9 +6070,8 @@ side-effect of memorizing only. Examples in `cperl-style-examples'." | |||
| 6073 | (list (completing-read "Enter style: " cperl-style-alist nil 'insist))) | 6070 | (list (completing-read "Enter style: " cperl-style-alist nil 'insist))) |
| 6074 | (or cperl-old-style | 6071 | (or cperl-old-style |
| 6075 | (setq cperl-old-style | 6072 | (setq cperl-old-style |
| 6076 | (mapcar (function | 6073 | (mapcar (lambda (name) |
| 6077 | (lambda (name) | 6074 | (cons name (eval name))) |
| 6078 | (cons name (eval name)))) | ||
| 6079 | cperl-styles-entries))) | 6075 | cperl-styles-entries))) |
| 6080 | (let ((style (cdr (assoc style cperl-style-alist))) setting) | 6076 | (let ((style (cdr (assoc style cperl-style-alist))) setting) |
| 6081 | (while style | 6077 | (while style |
| @@ -6527,22 +6523,21 @@ Does not move point." | |||
| 6527 | (setq lst (cdr (assoc "+Unsorted List+..." ind)))) | 6523 | (setq lst (cdr (assoc "+Unsorted List+..." ind)))) |
| 6528 | (setq lst | 6524 | (setq lst |
| 6529 | (mapcar | 6525 | (mapcar |
| 6530 | (function | 6526 | (lambda (elt) |
| 6531 | (lambda (elt) | 6527 | (cond ((string-match "^[_a-zA-Z]" (car elt)) |
| 6532 | (cond ((string-match "^[_a-zA-Z]" (car elt)) | 6528 | (goto-char (cdr elt)) |
| 6533 | (goto-char (cdr elt)) | 6529 | (beginning-of-line) ; pos should be of the start of the line |
| 6534 | (beginning-of-line) ; pos should be of the start of the line | 6530 | (list (car elt) |
| 6535 | (list (car elt) | 6531 | (point) |
| 6536 | (point) | 6532 | (1+ (count-lines 1 (point))) ; 1+ since at beg-o-l |
| 6537 | (1+ (count-lines 1 (point))) ; 1+ since at beg-o-l | 6533 | (buffer-substring (progn |
| 6538 | (buffer-substring (progn | 6534 | (goto-char (cdr elt)) |
| 6539 | (goto-char (cdr elt)) | 6535 | ;; After name now... |
| 6540 | ;; After name now... | 6536 | (or (eolp) (forward-char 1)) |
| 6541 | (or (eolp) (forward-char 1)) | 6537 | (point)) |
| 6542 | (point)) | 6538 | (progn |
| 6543 | (progn | 6539 | (beginning-of-line) |
| 6544 | (beginning-of-line) | 6540 | (point))))))) |
| 6545 | (point)))))))) | ||
| 6546 | lst)) | 6541 | lst)) |
| 6547 | (erase-buffer) | 6542 | (erase-buffer) |
| 6548 | (while lst | 6543 | (while lst |
| @@ -6607,6 +6602,9 @@ Use as | |||
| 6607 | " | 6602 | " |
| 6608 | (cperl-write-tags nil nil t t)) | 6603 | (cperl-write-tags nil nil t t)) |
| 6609 | 6604 | ||
| 6605 | (defvar cperl-tags-file-name "TAGS" | ||
| 6606 | "TAGS file name to use in `cperl-write-tags'.") | ||
| 6607 | |||
| 6610 | (defun cperl-write-tags (&optional file erase recurse dir inbuffer noxs topdir) | 6608 | (defun cperl-write-tags (&optional file erase recurse dir inbuffer noxs topdir) |
| 6611 | ;; If INBUFFER, do not select buffer, and do not save | 6609 | ;; If INBUFFER, do not select buffer, and do not save |
| 6612 | ;; If ERASE is `ignore', do not erase, and do not try to delete old info. | 6610 | ;; If ERASE is `ignore', do not erase, and do not try to delete old info. |
| @@ -6616,7 +6614,7 @@ Use as | |||
| 6616 | (if (and (not dir) (buffer-modified-p)) (error "Save buffer first!"))) | 6614 | (if (and (not dir) (buffer-modified-p)) (error "Save buffer first!"))) |
| 6617 | (or topdir | 6615 | (or topdir |
| 6618 | (setq topdir default-directory)) | 6616 | (setq topdir default-directory)) |
| 6619 | (let ((tags-file-name "TAGS") | 6617 | (let ((tags-file-name cperl-tags-file-name) |
| 6620 | (inhibit-read-only t) | 6618 | (inhibit-read-only t) |
| 6621 | (case-fold-search nil) | 6619 | (case-fold-search nil) |
| 6622 | xs rel) | 6620 | xs rel) |
| @@ -6645,16 +6643,15 @@ Use as | |||
| 6645 | (setq cperl-unreadable-ok t) | 6643 | (setq cperl-unreadable-ok t) |
| 6646 | nil) ; Return empty list | 6644 | nil) ; Return empty list |
| 6647 | (error "Aborting: unreadable directory %s" file))))))) | 6645 | (error "Aborting: unreadable directory %s" file))))))) |
| 6648 | (mapc (function | 6646 | (mapc (lambda (file) |
| 6649 | (lambda (file) | 6647 | (cond |
| 6650 | (cond | 6648 | ((string-match cperl-noscan-files-regexp file) |
| 6651 | ((string-match cperl-noscan-files-regexp file) | 6649 | nil) |
| 6652 | nil) | 6650 | ((not (file-directory-p file)) |
| 6653 | ((not (file-directory-p file)) | 6651 | (if (string-match cperl-scan-files-regexp file) |
| 6654 | (if (string-match cperl-scan-files-regexp file) | 6652 | (cperl-write-tags file erase recurse nil t noxs topdir))) |
| 6655 | (cperl-write-tags file erase recurse nil t noxs topdir))) | 6653 | ((not recurse) nil) |
| 6656 | ((not recurse) nil) | 6654 | (t (cperl-write-tags file erase recurse t t noxs topdir)))) |
| 6657 | (t (cperl-write-tags file erase recurse t t noxs topdir))))) | ||
| 6658 | files))) | 6655 | files))) |
| 6659 | (t | 6656 | (t |
| 6660 | (setq xs (string-match "\\.xs$" file)) | 6657 | (setq xs (string-match "\\.xs$" file)) |
| @@ -6768,11 +6765,10 @@ One may build such TAGS files from CPerl mode menu." | |||
| 6768 | (or tags-table-list | 6765 | (or tags-table-list |
| 6769 | (call-interactively 'visit-tags-table)) | 6766 | (call-interactively 'visit-tags-table)) |
| 6770 | (mapc | 6767 | (mapc |
| 6771 | (function | 6768 | (lambda (tagsfile) |
| 6772 | (lambda (tagsfile) | 6769 | (message "Updating list of classes... %s" tagsfile) |
| 6773 | (message "Updating list of classes... %s" tagsfile) | 6770 | (set-buffer (get-file-buffer tagsfile)) |
| 6774 | (set-buffer (get-file-buffer tagsfile)) | 6771 | (cperl-tags-hier-fill)) |
| 6775 | (cperl-tags-hier-fill))) | ||
| 6776 | tags-table-list) | 6772 | tags-table-list) |
| 6777 | (message "Updating list of classes... postprocessing...") | 6773 | (message "Updating list of classes... postprocessing...") |
| 6778 | (mapc remover (car cperl-hierarchy)) | 6774 | (mapc remover (car cperl-hierarchy)) |
| @@ -6816,24 +6812,23 @@ One may build such TAGS files from CPerl mode menu." | |||
| 6816 | l1 head cons1 cons2 ord writeto recurse | 6812 | l1 head cons1 cons2 ord writeto recurse |
| 6817 | root-packages root-functions | 6813 | root-packages root-functions |
| 6818 | (move-deeper | 6814 | (move-deeper |
| 6819 | (function | 6815 | (lambda (elt) |
| 6820 | (lambda (elt) | 6816 | (cond ((and (string-match regexp (car elt)) |
| 6821 | (cond ((and (string-match regexp (car elt)) | 6817 | (or (eq ord 1) (match-end 2))) |
| 6822 | (or (eq ord 1) (match-end 2))) | 6818 | (setq head (substring (car elt) 0 (match-end 1)) |
| 6823 | (setq head (substring (car elt) 0 (match-end 1)) | 6819 | recurse t) |
| 6824 | recurse t) | 6820 | (if (setq cons1 (assoc head writeto)) nil |
| 6825 | (if (setq cons1 (assoc head writeto)) nil | 6821 | ;; Need to init new head |
| 6826 | ;; Need to init new head | 6822 | (setcdr writeto (cons (list head (list "Packages: ") |
| 6827 | (setcdr writeto (cons (list head (list "Packages: ") | 6823 | (list "Methods: ")) |
| 6828 | (list "Methods: ")) | 6824 | (cdr writeto))) |
| 6829 | (cdr writeto))) | 6825 | (setq cons1 (nth 1 writeto))) |
| 6830 | (setq cons1 (nth 1 writeto))) | 6826 | (setq cons2 (nth ord cons1)) ; Either packs or meths |
| 6831 | (setq cons2 (nth ord cons1)) ; Either packs or meths | 6827 | (setcdr cons2 (cons elt (cdr cons2)))) |
| 6832 | (setcdr cons2 (cons elt (cdr cons2)))) | 6828 | ((eq ord 2) |
| 6833 | ((eq ord 2) | 6829 | (setq root-functions (cons elt root-functions))) |
| 6834 | (setq root-functions (cons elt root-functions))) | 6830 | (t |
| 6835 | (t | 6831 | (setq root-packages (cons elt root-packages))))))) |
| 6836 | (setq root-packages (cons elt root-packages)))))))) | ||
| 6837 | (setcdr to l1) ; Init to dynamic space | 6832 | (setcdr to l1) ; Init to dynamic space |
| 6838 | (setq writeto to) | 6833 | (setq writeto to) |
| 6839 | (setq ord 1) | 6834 | (setq ord 1) |
| @@ -6903,16 +6898,15 @@ One may build such TAGS files from CPerl mode menu." | |||
| 6903 | (let (list) | 6898 | (let (list) |
| 6904 | (cons 'keymap | 6899 | (cons 'keymap |
| 6905 | (mapcar | 6900 | (mapcar |
| 6906 | (function | 6901 | (lambda (elt) |
| 6907 | (lambda (elt) | 6902 | (cond ((listp (cdr elt)) |
| 6908 | (cond ((listp (cdr elt)) | 6903 | (setq list (cperl-list-fold |
| 6909 | (setq list (cperl-list-fold | 6904 | (cdr elt) (car elt) imenu-max-items)) |
| 6910 | (cdr elt) (car elt) imenu-max-items)) | 6905 | (cons nil |
| 6911 | (cons nil | 6906 | (cons (car elt) |
| 6912 | (cons (car elt) | 6907 | (cperl-menu-to-keymap list)))) |
| 6913 | (cperl-menu-to-keymap list)))) | 6908 | (t |
| 6914 | (t | 6909 | (list (cdr elt) (car elt) t)))) ; t is needed in 19.34 |
| 6915 | (list (cdr elt) (car elt) t))))) ; t is needed in 19.34 | ||
| 6916 | (cperl-list-fold menu "Root" imenu-max-items))))) | 6910 | (cperl-list-fold menu "Root" imenu-max-items))))) |
| 6917 | 6911 | ||
| 6918 | 6912 | ||
| @@ -8239,15 +8233,14 @@ If a region is highlighted, restricts to the region." | |||
| 8239 | end (max (mark) (point))) | 8233 | end (max (mark) (point))) |
| 8240 | (setq beg (point-min) | 8234 | (setq beg (point-min) |
| 8241 | end (point-max))) | 8235 | end (point-max))) |
| 8242 | (cperl-map-pods-heres (function | 8236 | (cperl-map-pods-heres (lambda (s e _p) |
| 8243 | (lambda (s e _p) | 8237 | (if do-heres |
| 8244 | (if do-heres | 8238 | (setq e (save-excursion |
| 8245 | (setq e (save-excursion | 8239 | (goto-char e) |
| 8246 | (goto-char e) | 8240 | (forward-line -1) |
| 8247 | (forward-line -1) | 8241 | (point)))) |
| 8248 | (point)))) | 8242 | (ispell-region s e) |
| 8249 | (ispell-region s e) | 8243 | t) |
| 8250 | t)) | ||
| 8251 | (if do-heres 'here-doc-group 'in-pod) | 8244 | (if do-heres 'here-doc-group 'in-pod) |
| 8252 | beg end)))) | 8245 | beg end)))) |
| 8253 | 8246 | ||
diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el index 6e9b6830a01..903005610d7 100644 --- a/lisp/progmodes/gdb-mi.el +++ b/lisp/progmodes/gdb-mi.el | |||
| @@ -373,19 +373,17 @@ were not yet received." | |||
| 373 | (dolist (handler gdb-handler-list) | 373 | (dolist (handler gdb-handler-list) |
| 374 | (setf (gdb-handler-pending-trigger handler) nil))) | 374 | (setf (gdb-handler-pending-trigger handler) nil))) |
| 375 | 375 | ||
| 376 | (defmacro gdb-wait-for-pending (&rest body) | 376 | (defun gdb-wait-for-pending (func) |
| 377 | "Wait for all pending GDB commands to finish and evaluate BODY. | 377 | "Wait for all pending GDB commands to finish and call FUNC. |
| 378 | 378 | ||
| 379 | This function checks every 0.5 seconds if there are any pending | 379 | This function checks every 0.5 seconds if there are any pending |
| 380 | triggers in `gdb-handler-list'." | 380 | triggers in `gdb-handler-list'." |
| 381 | `(run-with-timer | 381 | (run-with-timer |
| 382 | 0.5 nil | 382 | 0.5 nil |
| 383 | '(lambda () | 383 | (lambda () |
| 384 | (if (not (cl-find-if (lambda (handler) | 384 | (if (cl-some #'gdb-handler-pending-trigger gdb-handler-list) |
| 385 | (gdb-handler-pending-trigger handler)) | 385 | (gdb-wait-for-pending func) |
| 386 | gdb-handler-list)) | 386 | (funcall func))))) |
| 387 | (progn ,@body) | ||
| 388 | (gdb-wait-for-pending ,@body))))) | ||
| 389 | 387 | ||
| 390 | ;; Publish-subscribe | 388 | ;; Publish-subscribe |
| 391 | 389 | ||
| @@ -1617,17 +1615,16 @@ this trigger is subscribed to `gdb-buf-publisher' and called with | |||
| 1617 | ;; (if it has an associated update trigger) | 1615 | ;; (if it has an associated update trigger) |
| 1618 | (add-hook | 1616 | (add-hook |
| 1619 | 'kill-buffer-hook | 1617 | 'kill-buffer-hook |
| 1620 | (function | 1618 | (lambda () |
| 1621 | (lambda () | 1619 | (let ((trigger (gdb-rules-update-trigger |
| 1622 | (let ((trigger (gdb-rules-update-trigger | 1620 | (gdb-current-buffer-rules)))) |
| 1623 | (gdb-current-buffer-rules)))) | 1621 | (when trigger |
| 1624 | (when trigger | 1622 | (gdb-delete-subscriber |
| 1625 | (gdb-delete-subscriber | 1623 | gdb-buf-publisher |
| 1626 | gdb-buf-publisher | 1624 | ;; This should match gdb-add-subscriber done in |
| 1627 | ;; This should match gdb-add-subscriber done in | 1625 | ;; gdb-get-buffer-create |
| 1628 | ;; gdb-get-buffer-create | 1626 | (cons (current-buffer) |
| 1629 | (cons (current-buffer) | 1627 | (gdb-bind-function-to-buffer trigger (current-buffer))))))) |
| 1630 | (gdb-bind-function-to-buffer trigger (current-buffer)))))))) | ||
| 1631 | nil t)) | 1628 | nil t)) |
| 1632 | 1629 | ||
| 1633 | ;; Partial-output buffer : This accumulates output from a command executed on | 1630 | ;; Partial-output buffer : This accumulates output from a command executed on |
| @@ -2525,7 +2522,7 @@ Unset `gdb-thread-number' if current thread exited and update threads list." | |||
| 2525 | ;; disallow us to properly call -thread-info without --thread option. | 2522 | ;; disallow us to properly call -thread-info without --thread option. |
| 2526 | ;; Thus we need to use gdb-wait-for-pending. | 2523 | ;; Thus we need to use gdb-wait-for-pending. |
| 2527 | (gdb-wait-for-pending | 2524 | (gdb-wait-for-pending |
| 2528 | (gdb-emit-signal gdb-buf-publisher 'update-threads)))) | 2525 | (lambda () (gdb-emit-signal gdb-buf-publisher 'update-threads))))) |
| 2529 | 2526 | ||
| 2530 | (defun gdb-thread-selected (_token output-field) | 2527 | (defun gdb-thread-selected (_token output-field) |
| 2531 | "Handler for =thread-selected MI output record. | 2528 | "Handler for =thread-selected MI output record. |
| @@ -2539,11 +2536,10 @@ Sets `gdb-thread-number' to new id." | |||
| 2539 | ;; as usually. Things happen too fast and second call (from | 2536 | ;; as usually. Things happen too fast and second call (from |
| 2540 | ;; gdb-thread-selected handler) gets cut off by our beloved | 2537 | ;; gdb-thread-selected handler) gets cut off by our beloved |
| 2541 | ;; pending triggers. | 2538 | ;; pending triggers. |
| 2542 | ;; Solution is `gdb-wait-for-pending' macro: it guarantees that its | 2539 | ;; Solution is `gdb-wait-for-pending': it guarantees that its |
| 2543 | ;; body will get executed when `gdb-handler-list' if free of | 2540 | ;; argument will get called when `gdb-handler-list' if free of |
| 2544 | ;; pending triggers. | 2541 | ;; pending triggers. |
| 2545 | (gdb-wait-for-pending | 2542 | (gdb-wait-for-pending #'gdb-update))) |
| 2546 | (gdb-update)))) | ||
| 2547 | 2543 | ||
| 2548 | (defun gdb-running (_token output-field) | 2544 | (defun gdb-running (_token output-field) |
| 2549 | (let* ((thread-id | 2545 | (let* ((thread-id |
diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index 96838269749..dafba22f777 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el | |||
| @@ -296,8 +296,10 @@ See `compilation-error-screen-columns'." | |||
| 296 | :help "Kill the currently running grep process")) | 296 | :help "Kill the currently running grep process")) |
| 297 | (define-key map [menu-bar grep compilation-separator2] '("----")) | 297 | (define-key map [menu-bar grep compilation-separator2] '("----")) |
| 298 | (define-key map [menu-bar grep compilation-compile] | 298 | (define-key map [menu-bar grep compilation-compile] |
| 299 | '(menu-item "Compile..." compile | 299 | '(menu-item |
| 300 | :help "Compile the program including the current buffer. Default: run `make'")) | 300 | "Compile..." compile |
| 301 | :help | ||
| 302 | "Compile the program including the current buffer. Default: run `make'")) | ||
| 301 | (define-key map [menu-bar grep compilation-rgrep] | 303 | (define-key map [menu-bar grep compilation-rgrep] |
| 302 | '(menu-item "Recursive grep..." rgrep | 304 | '(menu-item "Recursive grep..." rgrep |
| 303 | :help "User-friendly recursive grep in directory tree")) | 305 | :help "User-friendly recursive grep in directory tree")) |
| @@ -308,15 +310,18 @@ See `compilation-error-screen-columns'." | |||
| 308 | '(menu-item "Grep via Find..." grep-find | 310 | '(menu-item "Grep via Find..." grep-find |
| 309 | :help "Run grep via find, with user-specified args")) | 311 | :help "Run grep via find, with user-specified args")) |
| 310 | (define-key map [menu-bar grep compilation-grep] | 312 | (define-key map [menu-bar grep compilation-grep] |
| 311 | '(menu-item "Another grep..." grep | 313 | '(menu-item |
| 312 | :help "Run grep, with user-specified args, and collect output in a buffer.")) | 314 | "Another grep..." grep |
| 315 | :help | ||
| 316 | "Run grep, with user-specified args, and collect output in a buffer.")) | ||
| 313 | (define-key map [menu-bar grep compilation-recompile] | 317 | (define-key map [menu-bar grep compilation-recompile] |
| 314 | '(menu-item "Repeat grep" recompile | 318 | '(menu-item "Repeat grep" recompile |
| 315 | :help "Run grep again")) | 319 | :help "Run grep again")) |
| 316 | (define-key map [menu-bar grep compilation-separator1] '("----")) | 320 | (define-key map [menu-bar grep compilation-separator1] '("----")) |
| 317 | (define-key map [menu-bar grep compilation-first-error] | 321 | (define-key map [menu-bar grep compilation-first-error] |
| 318 | '(menu-item "First Match" first-error | 322 | '(menu-item |
| 319 | :help "Restart at the first match, visit corresponding location")) | 323 | "First Match" first-error |
| 324 | :help "Restart at the first match, visit corresponding location")) | ||
| 320 | (define-key map [menu-bar grep compilation-previous-error] | 325 | (define-key map [menu-bar grep compilation-previous-error] |
| 321 | '(menu-item "Previous Match" previous-error | 326 | '(menu-item "Previous Match" previous-error |
| 322 | :help "Visit the previous match and corresponding location")) | 327 | :help "Visit the previous match and corresponding location")) |
| @@ -389,7 +394,8 @@ Notice that using \\[next-error] or \\[compile-goto-error] modifies | |||
| 389 | (when grep-highlight-matches | 394 | (when grep-highlight-matches |
| 390 | (let* ((beg (match-end 0)) | 395 | (let* ((beg (match-end 0)) |
| 391 | (end (save-excursion (goto-char beg) (line-end-position))) | 396 | (end (save-excursion (goto-char beg) (line-end-position))) |
| 392 | (mbeg (text-property-any beg end 'font-lock-face grep-match-face))) | 397 | (mbeg |
| 398 | (text-property-any beg end 'font-lock-face grep-match-face))) | ||
| 393 | (when mbeg | 399 | (when mbeg |
| 394 | (- mbeg beg))))) | 400 | (- mbeg beg))))) |
| 395 | . | 401 | . |
| @@ -397,8 +403,11 @@ Notice that using \\[next-error] or \\[compile-goto-error] modifies | |||
| 397 | (when grep-highlight-matches | 403 | (when grep-highlight-matches |
| 398 | (let* ((beg (match-end 0)) | 404 | (let* ((beg (match-end 0)) |
| 399 | (end (save-excursion (goto-char beg) (line-end-position))) | 405 | (end (save-excursion (goto-char beg) (line-end-position))) |
| 400 | (mbeg (text-property-any beg end 'font-lock-face grep-match-face)) | 406 | (mbeg |
| 401 | (mend (and mbeg (next-single-property-change mbeg 'font-lock-face nil end)))) | 407 | (text-property-any beg end 'font-lock-face grep-match-face)) |
| 408 | (mend | ||
| 409 | (and mbeg (next-single-property-change | ||
| 410 | mbeg 'font-lock-face nil end)))) | ||
| 402 | (when mend | 411 | (when mend |
| 403 | (- mend beg)))))) | 412 | (- mend beg)))))) |
| 404 | nil nil | 413 | nil nil |
| @@ -614,6 +623,15 @@ This function is called from `compilation-filter-hook'." | |||
| 614 | (error nil)) | 623 | (error nil)) |
| 615 | (or result 0)))) | 624 | (or result 0)))) |
| 616 | 625 | ||
| 626 | (defun grep-hello-file () | ||
| 627 | (let ((result | ||
| 628 | (if (file-remote-p default-directory) | ||
| 629 | (make-temp-file (file-name-as-directory (temporary-file-directory))) | ||
| 630 | (expand-file-name "HELLO" data-directory)))) | ||
| 631 | (when (file-remote-p result) | ||
| 632 | (write-region "Copyright\n" nil result)) | ||
| 633 | result)) | ||
| 634 | |||
| 617 | ;;;###autoload | 635 | ;;;###autoload |
| 618 | (defun grep-compute-defaults () | 636 | (defun grep-compute-defaults () |
| 619 | "Compute the defaults for the `grep' command. | 637 | "Compute the defaults for the `grep' command. |
| @@ -655,37 +673,46 @@ The value depends on `grep-command', `grep-template', | |||
| 655 | (unless (or (not grep-use-null-device) (eq grep-use-null-device t)) | 673 | (unless (or (not grep-use-null-device) (eq grep-use-null-device t)) |
| 656 | (setq grep-use-null-device | 674 | (setq grep-use-null-device |
| 657 | (with-temp-buffer | 675 | (with-temp-buffer |
| 658 | (let ((hello-file (expand-file-name "HELLO" data-directory))) | 676 | (let ((hello-file (grep-hello-file))) |
| 659 | (not | 677 | (prog1 |
| 660 | (and (if grep-command | 678 | (not |
| 661 | ;; `grep-command' is already set, so | 679 | (and (if grep-command |
| 662 | ;; use that for testing. | 680 | ;; `grep-command' is already set, so |
| 663 | (grep-probe grep-command | 681 | ;; use that for testing. |
| 664 | `(nil t nil "^Copyright" ,hello-file) | 682 | (grep-probe |
| 665 | #'call-process-shell-command) | 683 | grep-command |
| 666 | ;; otherwise use `grep-program' | 684 | `(nil t nil "^Copyright" |
| 667 | (grep-probe grep-program | 685 | ,(file-local-name hello-file)) |
| 668 | `(nil t nil "-nH" "^Copyright" ,hello-file))) | 686 | #'process-file-shell-command) |
| 669 | (progn | 687 | ;; otherwise use `grep-program' |
| 670 | (goto-char (point-min)) | 688 | (grep-probe |
| 671 | (looking-at | 689 | grep-program |
| 672 | (concat (regexp-quote hello-file) | 690 | `(nil t nil "-nH" "^Copyright" |
| 673 | ":[0-9]+:Copyright"))))))))) | 691 | ,(file-local-name hello-file)))) |
| 692 | (progn | ||
| 693 | (goto-char (point-min)) | ||
| 694 | (looking-at | ||
| 695 | (concat (regexp-quote (file-local-name hello-file)) | ||
| 696 | ":[0-9]+:Copyright"))))) | ||
| 697 | (when (file-remote-p hello-file) (delete-file hello-file))))))) | ||
| 674 | 698 | ||
| 675 | (when (eq grep-use-null-filename-separator 'auto-detect) | 699 | (when (eq grep-use-null-filename-separator 'auto-detect) |
| 676 | (setq grep-use-null-filename-separator | 700 | (setq grep-use-null-filename-separator |
| 677 | (with-temp-buffer | 701 | (with-temp-buffer |
| 678 | (let* ((hello-file (expand-file-name "HELLO" data-directory)) | 702 | (let* ((hello-file (grep-hello-file)) |
| 679 | (args `("--null" "-ne" "^Copyright" ,hello-file))) | 703 | (args `("--null" "-ne" "^Copyright" |
| 704 | ,(file-local-name hello-file)))) | ||
| 680 | (if grep-use-null-device | 705 | (if grep-use-null-device |
| 681 | (setq args (append args (list null-device))) | 706 | (setq args (append args (list (null-device)))) |
| 682 | (push "-H" args)) | 707 | (push "-H" args)) |
| 683 | (and (grep-probe grep-program `(nil t nil ,@args)) | 708 | (prog1 |
| 684 | (progn | 709 | (and (grep-probe grep-program `(nil t nil ,@args)) |
| 685 | (goto-char (point-min)) | 710 | (progn |
| 686 | (looking-at | 711 | (goto-char (point-min)) |
| 687 | (concat (regexp-quote hello-file) | 712 | (looking-at |
| 688 | "\0[0-9]+:Copyright")))))))) | 713 | (concat (regexp-quote (file-local-name hello-file)) |
| 714 | "\0[0-9]+:Copyright")))) | ||
| 715 | (when (file-remote-p hello-file) (delete-file hello-file))))))) | ||
| 689 | 716 | ||
| 690 | (when (eq grep-highlight-matches 'auto-detect) | 717 | (when (eq grep-highlight-matches 'auto-detect) |
| 691 | (setq grep-highlight-matches | 718 | (setq grep-highlight-matches |
| @@ -704,7 +731,7 @@ The value depends on `grep-command', `grep-template', | |||
| 704 | (concat (if grep-use-null-device "-n" "-nH") | 731 | (concat (if grep-use-null-device "-n" "-nH") |
| 705 | (if grep-use-null-filename-separator " --null") | 732 | (if grep-use-null-filename-separator " --null") |
| 706 | (when (grep-probe grep-program | 733 | (when (grep-probe grep-program |
| 707 | `(nil nil nil "-e" "foo" ,null-device) | 734 | `(nil nil nil "-e" "foo" ,(null-device)) |
| 708 | nil 1) | 735 | nil 1) |
| 709 | " -e")))) | 736 | " -e")))) |
| 710 | (unless grep-command | 737 | (unless grep-command |
| @@ -712,13 +739,14 @@ The value depends on `grep-command', `grep-template', | |||
| 712 | (format "%s %s %s " grep-program | 739 | (format "%s %s %s " grep-program |
| 713 | (or | 740 | (or |
| 714 | (and grep-highlight-matches | 741 | (and grep-highlight-matches |
| 715 | (grep-probe grep-program | 742 | (grep-probe |
| 716 | `(nil nil nil "--color" "x" ,null-device) | 743 | grep-program |
| 717 | nil 1) | 744 | `(nil nil nil "--color" "x" ,(null-device)) |
| 745 | nil 1) | ||
| 718 | (if (eq grep-highlight-matches 'always) | 746 | (if (eq grep-highlight-matches 'always) |
| 719 | "--color=always" "--color")) | 747 | "--color=always" "--color")) |
| 720 | "") | 748 | "") |
| 721 | grep-options))) | 749 | grep-options))) |
| 722 | (unless grep-template | 750 | (unless grep-template |
| 723 | (setq grep-template | 751 | (setq grep-template |
| 724 | (format "%s <X> <C> %s <R> <F>" grep-program grep-options))) | 752 | (format "%s <X> <C> %s <R> <F>" grep-program grep-options))) |
| @@ -726,11 +754,12 @@ The value depends on `grep-command', `grep-template', | |||
| 726 | (setq grep-find-use-xargs | 754 | (setq grep-find-use-xargs |
| 727 | (cond | 755 | (cond |
| 728 | ((grep-probe find-program | 756 | ((grep-probe find-program |
| 729 | `(nil nil nil ,null-device "-exec" "echo" | 757 | `(nil nil nil ,(null-device) "-exec" "echo" |
| 730 | "{}" "+")) | 758 | "{}" "+")) |
| 731 | 'exec-plus) | 759 | 'exec-plus) |
| 732 | ((and | 760 | ((and |
| 733 | (grep-probe find-program `(nil nil nil ,null-device "-print0")) | 761 | (grep-probe |
| 762 | find-program `(nil nil nil ,(null-device) "-print0")) | ||
| 734 | (grep-probe xargs-program '(nil nil nil "-0" "echo"))) | 763 | (grep-probe xargs-program '(nil nil nil "-0" "echo"))) |
| 735 | 'gnu) | 764 | 'gnu) |
| 736 | (t | 765 | (t |
| @@ -750,12 +779,13 @@ The value depends on `grep-command', `grep-template', | |||
| 750 | (let ((cmd0 (format "%s . -type f -exec %s" | 779 | (let ((cmd0 (format "%s . -type f -exec %s" |
| 751 | find-program grep-command)) | 780 | find-program grep-command)) |
| 752 | (null (if grep-use-null-device | 781 | (null (if grep-use-null-device |
| 753 | (format "%s " null-device) | 782 | (format "%s " (null-device)) |
| 754 | ""))) | 783 | ""))) |
| 755 | (cons | 784 | (cons |
| 756 | (if (eq grep-find-use-xargs 'exec-plus) | 785 | (if (eq grep-find-use-xargs 'exec-plus) |
| 757 | (format "%s %s%s +" cmd0 null quot-braces) | 786 | (format "%s %s%s +" cmd0 null quot-braces) |
| 758 | (format "%s %s %s%s" cmd0 quot-braces null quot-scolon)) | 787 | (format "%s %s %s%s" |
| 788 | cmd0 quot-braces null quot-scolon)) | ||
| 759 | (1+ (length cmd0))))) | 789 | (1+ (length cmd0))))) |
| 760 | (t | 790 | (t |
| 761 | (format "%s . -type f -print | \"%s\" %s" | 791 | (format "%s . -type f -print | \"%s\" %s" |
| @@ -765,7 +795,7 @@ The value depends on `grep-command', `grep-template', | |||
| 765 | (let ((gcmd (format "%s <C> %s <R>" | 795 | (let ((gcmd (format "%s <C> %s <R>" |
| 766 | grep-program grep-options)) | 796 | grep-program grep-options)) |
| 767 | (null (if grep-use-null-device | 797 | (null (if grep-use-null-device |
| 768 | (format "%s " null-device) | 798 | (format "%s " (null-device)) |
| 769 | ""))) | 799 | ""))) |
| 770 | (cond ((eq grep-find-use-xargs 'gnu) | 800 | (cond ((eq grep-find-use-xargs 'gnu) |
| 771 | (format "%s <D> <X> -type f <F> -print0 | \"%s\" -0 %s" | 801 | (format "%s <D> <X> -type f <F> -print0 | \"%s\" -0 %s" |
| @@ -814,7 +844,8 @@ The value depends on `grep-command', `grep-template', | |||
| 814 | (let ((tag-default (shell-quote-argument (grep-tag-default))) | 844 | (let ((tag-default (shell-quote-argument (grep-tag-default))) |
| 815 | ;; This a regexp to match single shell arguments. | 845 | ;; This a regexp to match single shell arguments. |
| 816 | ;; Could someone please add comments explaining it? | 846 | ;; Could someone please add comments explaining it? |
| 817 | (sh-arg-re "\\(\\(?:\"\\(?:[^\"]\\|\\\\\"\\)+\"\\|'[^']+'\\|[^\"' \t\n]\\)+\\)") | 847 | (sh-arg-re |
| 848 | "\\(\\(?:\"\\(?:[^\"]\\|\\\\\"\\)+\"\\|'[^']+'\\|[^\"' \t\n]\\)+\\)") | ||
| 818 | (grep-default (or (car grep-history) grep-command))) | 849 | (grep-default (or (car grep-history) grep-command))) |
| 819 | ;; In the default command, find the arg that specifies the pattern. | 850 | ;; In the default command, find the arg that specifies the pattern. |
| 820 | (when (or (string-match | 851 | (when (or (string-match |
| @@ -909,8 +940,8 @@ list is empty)." | |||
| 909 | (grep--save-buffers) | 940 | (grep--save-buffers) |
| 910 | ;; Setting process-setup-function makes exit-message-function work | 941 | ;; Setting process-setup-function makes exit-message-function work |
| 911 | ;; even when async processes aren't supported. | 942 | ;; even when async processes aren't supported. |
| 912 | (compilation-start (if (and grep-use-null-device null-device) | 943 | (compilation-start (if (and grep-use-null-device null-device (null-device)) |
| 913 | (concat command-args " " null-device) | 944 | (concat command-args " " (null-device)) |
| 914 | command-args) | 945 | command-args) |
| 915 | #'grep-mode)) | 946 | #'grep-mode)) |
| 916 | 947 | ||
| @@ -948,7 +979,7 @@ easily repeat a find command." | |||
| 948 | '(("<C>" . (mapconcat #'identity opts " ")) | 979 | '(("<C>" . (mapconcat #'identity opts " ")) |
| 949 | ("<D>" . (or dir ".")) | 980 | ("<D>" . (or dir ".")) |
| 950 | ("<F>" . files) | 981 | ("<F>" . files) |
| 951 | ("<N>" . null-device) | 982 | ("<N>" . (null-device)) |
| 952 | ("<X>" . excl) | 983 | ("<X>" . excl) |
| 953 | ("<R>" . (shell-quote-argument (or regexp "")))) | 984 | ("<R>" . (shell-quote-argument (or regexp "")))) |
| 954 | "List of substitutions performed by `grep-expand-template'. | 985 | "List of substitutions performed by `grep-expand-template'. |
| @@ -1052,8 +1083,9 @@ REGEXP is used as a string in the prompt." | |||
| 1052 | #'read-file-name-internal | 1083 | #'read-file-name-internal |
| 1053 | nil nil nil 'grep-files-history | 1084 | nil nil nil 'grep-files-history |
| 1054 | (delete-dups | 1085 | (delete-dups |
| 1055 | (delq nil (append (list default default-alias default-extension) | 1086 | (delq nil |
| 1056 | (mapcar #'car grep-files-aliases))))))) | 1087 | (append (list default default-alias default-extension) |
| 1088 | (mapcar #'car grep-files-aliases))))))) | ||
| 1057 | (and files | 1089 | (and files |
| 1058 | (or (cdr (assoc files grep-files-aliases)) | 1090 | (or (cdr (assoc files grep-files-aliases)) |
| 1059 | files)))) | 1091 | files)))) |
| @@ -1105,11 +1137,12 @@ command before it's run." | |||
| 1105 | (if (string= command grep-command) | 1137 | (if (string= command grep-command) |
| 1106 | (setq command nil)) | 1138 | (setq command nil)) |
| 1107 | (setq dir (file-name-as-directory (expand-file-name dir))) | 1139 | (setq dir (file-name-as-directory (expand-file-name dir))) |
| 1108 | (unless (or (not grep-use-directories-skip) (eq grep-use-directories-skip t)) | 1140 | (unless (or (not grep-use-directories-skip) |
| 1141 | (eq grep-use-directories-skip t)) | ||
| 1109 | (setq grep-use-directories-skip | 1142 | (setq grep-use-directories-skip |
| 1110 | (grep-probe grep-program | 1143 | (grep-probe grep-program |
| 1111 | `(nil nil nil "--directories=skip" "foo" | 1144 | `(nil nil nil "--directories=skip" "foo" |
| 1112 | ,null-device) | 1145 | ,(null-device)) |
| 1113 | nil 1))) | 1146 | nil 1))) |
| 1114 | (setq command (grep-expand-template | 1147 | (setq command (grep-expand-template |
| 1115 | grep-template | 1148 | grep-template |
| @@ -1141,10 +1174,11 @@ command before it's run." | |||
| 1141 | ;; Setting process-setup-function makes exit-message-function work | 1174 | ;; Setting process-setup-function makes exit-message-function work |
| 1142 | ;; even when async processes aren't supported. | 1175 | ;; even when async processes aren't supported. |
| 1143 | (grep--save-buffers) | 1176 | (grep--save-buffers) |
| 1144 | (compilation-start (if (and grep-use-null-device null-device) | 1177 | (compilation-start |
| 1145 | (concat command " " null-device) | 1178 | (if (and grep-use-null-device null-device (null-device)) |
| 1146 | command) | 1179 | (concat command " " (null-device)) |
| 1147 | 'grep-mode)) | 1180 | command) |
| 1181 | 'grep-mode)) | ||
| 1148 | ;; Set default-directory if we started lgrep in the *grep* buffer. | 1182 | ;; Set default-directory if we started lgrep in the *grep* buffer. |
| 1149 | (if (eq next-error-last-buffer (current-buffer)) | 1183 | (if (eq next-error-last-buffer (current-buffer)) |
| 1150 | (setq default-directory dir)))))) | 1184 | (setq default-directory dir)))))) |
diff --git a/lisp/progmodes/idlw-help.el b/lisp/progmodes/idlw-help.el index 2d4ea465c42..89296ff5b50 100644 --- a/lisp/progmodes/idlw-help.el +++ b/lisp/progmodes/idlw-help.el | |||
| @@ -1173,17 +1173,16 @@ When DING is non-nil, ring the bell as well." | |||
| 1173 | Useful when source code is displayed as help. See the option | 1173 | Useful when source code is displayed as help. See the option |
| 1174 | `idlwave-help-fontify-source-code'." | 1174 | `idlwave-help-fontify-source-code'." |
| 1175 | (interactive) | 1175 | (interactive) |
| 1176 | (if (featurep 'font-lock) | 1176 | (let ((major-mode 'idlwave-mode) |
| 1177 | (let ((major-mode 'idlwave-mode) | 1177 | (font-lock-verbose |
| 1178 | (font-lock-verbose | 1178 | (if (called-interactively-p 'interactive) font-lock-verbose nil))) |
| 1179 | (if (called-interactively-p 'interactive) font-lock-verbose nil))) | 1179 | (with-syntax-table idlwave-mode-syntax-table |
| 1180 | (with-syntax-table idlwave-mode-syntax-table | 1180 | (set (make-local-variable 'font-lock-defaults) |
| 1181 | (set (make-local-variable 'font-lock-defaults) | 1181 | idlwave-font-lock-defaults) |
| 1182 | idlwave-font-lock-defaults) | 1182 | (if (fboundp 'font-lock-ensure) ; Emacs >= 25.1 |
| 1183 | (if (fboundp 'font-lock-ensure) ; Emacs >= 25.1 | 1183 | (font-lock-ensure) |
| 1184 | (font-lock-ensure) | 1184 | ;; Silence "interactive use only" warning on Emacs >= 25.1. |
| 1185 | ;; Silence "interactive use only" warning on Emacs >= 25.1. | 1185 | (with-no-warnings (font-lock-fontify-buffer)))))) |
| 1186 | (with-no-warnings (font-lock-fontify-buffer))))))) | ||
| 1187 | 1186 | ||
| 1188 | 1187 | ||
| 1189 | (defun idlwave-help-error (name type class keyword) | 1188 | (defun idlwave-help-error (name type class keyword) |
diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el index 38127fccbc3..70b94596e10 100644 --- a/lisp/progmodes/idlw-shell.el +++ b/lisp/progmodes/idlw-shell.el | |||
| @@ -26,8 +26,7 @@ | |||
| 26 | 26 | ||
| 27 | ;;; Commentary: | 27 | ;;; Commentary: |
| 28 | ;; | 28 | ;; |
| 29 | ;; This mode is for IDL version 5 or later. It should work on | 29 | ;; This mode is for IDL version 5 or later. |
| 30 | ;; Emacs>20.3 or XEmacs>20.4. | ||
| 31 | ;; | 30 | ;; |
| 32 | ;; Runs IDL as an inferior process of Emacs, much like the Emacs | 31 | ;; Runs IDL as an inferior process of Emacs, much like the Emacs |
| 33 | ;; `shell' or `telnet' commands. Provides command history and | 32 | ;; `shell' or `telnet' commands. Provides command history and |
| @@ -68,15 +67,6 @@ | |||
| 68 | ;; maintainers webpage (see under SOURCE) | 67 | ;; maintainers webpage (see under SOURCE) |
| 69 | ;; | 68 | ;; |
| 70 | ;; | 69 | ;; |
| 71 | ;; KNOWN PROBLEMS | ||
| 72 | ;; ============== | ||
| 73 | ;; | ||
| 74 | ;; Under XEmacs the Debug menu in the shell does not display the | ||
| 75 | ;; keybindings in the prefix map. There bindings are available anyway - so | ||
| 76 | ;; it is a bug in XEmacs. | ||
| 77 | ;; The Debug menu in source buffers *does* display the bindings correctly. | ||
| 78 | ;; | ||
| 79 | ;; | ||
| 80 | ;; CUSTOMIZATION VARIABLES | 70 | ;; CUSTOMIZATION VARIABLES |
| 81 | ;; ======================= | 71 | ;; ======================= |
| 82 | ;; | 72 | ;; |
| @@ -166,7 +156,6 @@ t Arrows force the cursor back to the current command line and | |||
| 166 | "Non-nil means, use the debugging toolbar in all IDL related buffers. | 156 | "Non-nil means, use the debugging toolbar in all IDL related buffers. |
| 167 | Starting the shell will then add the toolbar to all idlwave-mode buffers. | 157 | Starting the shell will then add the toolbar to all idlwave-mode buffers. |
| 168 | Exiting the shell will removed everywhere. | 158 | Exiting the shell will removed everywhere. |
| 169 | Available on XEmacs and on Emacs 21.x or later. | ||
| 170 | At any time you can toggle the display of the toolbar with | 159 | At any time you can toggle the display of the toolbar with |
| 171 | `C-c C-d C-t' (`idlwave-shell-toggle-toolbar')." | 160 | `C-c C-d C-t' (`idlwave-shell-toggle-toolbar')." |
| 172 | :group 'idlwave-shell-general-setup | 161 | :group 'idlwave-shell-general-setup |
| @@ -606,12 +595,6 @@ the directory stack.") | |||
| 606 | (defvar idlwave-shell-last-save-and-action-file nil | 595 | (defvar idlwave-shell-last-save-and-action-file nil |
| 607 | "The last file which was compiled with `idlwave-shell-save-and-...'.") | 596 | "The last file which was compiled with `idlwave-shell-save-and-...'.") |
| 608 | 597 | ||
| 609 | ;; Highlighting uses overlays. When necessary, require the emulation. | ||
| 610 | (if (not (fboundp 'make-overlay)) | ||
| 611 | (condition-case nil | ||
| 612 | (require 'overlay) | ||
| 613 | (error nil))) | ||
| 614 | |||
| 615 | (defvar idlwave-shell-stop-line-overlay nil | 598 | (defvar idlwave-shell-stop-line-overlay nil |
| 616 | "The overlay for where IDL is currently stopped.") | 599 | "The overlay for where IDL is currently stopped.") |
| 617 | (defvar idlwave-shell-is-stopped nil) | 600 | (defvar idlwave-shell-is-stopped nil) |
| @@ -967,8 +950,6 @@ IDL has currently stepped.") | |||
| 967 | (setq idlwave-shell-default-directory default-directory) | 950 | (setq idlwave-shell-default-directory default-directory) |
| 968 | (setq idlwave-shell-hide-output nil) | 951 | (setq idlwave-shell-hide-output nil) |
| 969 | 952 | ||
| 970 | ;; NB: `make-local-hook' needed for older/alternative Emacs compatibility | ||
| 971 | ;; (make-local-hook 'kill-buffer-hook) | ||
| 972 | (add-hook 'kill-buffer-hook 'idlwave-shell-kill-shell-buffer-confirm | 953 | (add-hook 'kill-buffer-hook 'idlwave-shell-kill-shell-buffer-confirm |
| 973 | nil 'local) | 954 | nil 'local) |
| 974 | (add-hook 'kill-buffer-hook 'idlwave-shell-delete-temp-files nil 'local) | 955 | (add-hook 'kill-buffer-hook 'idlwave-shell-delete-temp-files nil 'local) |
| @@ -1007,8 +988,6 @@ IDL has currently stepped.") | |||
| 1007 | (set (make-local-variable 'comment-start) ";") | 988 | (set (make-local-variable 'comment-start) ";") |
| 1008 | (setq abbrev-mode t) | 989 | (setq abbrev-mode t) |
| 1009 | 990 | ||
| 1010 | ;; NB: `make-local-hook' needed for older/alternative Emacs compatibility | ||
| 1011 | ;; make-local-hook 'post-command-hook) | ||
| 1012 | (add-hook 'post-command-hook 'idlwave-command-hook nil t) | 991 | (add-hook 'post-command-hook 'idlwave-command-hook nil t) |
| 1013 | 992 | ||
| 1014 | ;; Read the command history? | 993 | ;; Read the command history? |
| @@ -2751,6 +2730,7 @@ Runs to the last statement and then steps 1 statement. Use the .out command." | |||
| 2751 | ;; Begin terrible hack section -- XEmacs tests for button2 explicitly | 2730 | ;; Begin terrible hack section -- XEmacs tests for button2 explicitly |
| 2752 | ;; on drag events, calling drag-n-drop code if detected. Ughhh... | 2731 | ;; on drag events, calling drag-n-drop code if detected. Ughhh... |
| 2753 | (defun idlwave-default-mouse-track-event-is-with-button (_event _n) | 2732 | (defun idlwave-default-mouse-track-event-is-with-button (_event _n) |
| 2733 | (declare (obsolete nil "28.1")) | ||
| 2754 | t) | 2734 | t) |
| 2755 | 2735 | ||
| 2756 | (define-obsolete-function-alias 'idlwave-xemacs-hack-mouse-track 'ignore "27.1") | 2736 | (define-obsolete-function-alias 'idlwave-xemacs-hack-mouse-track 'ignore "27.1") |
| @@ -3612,10 +3592,8 @@ Existing overlays are recycled, in order to minimize consumption." | |||
| 3612 | (when use-glyph | 3592 | (when use-glyph |
| 3613 | (if old-buffers | 3593 | (if old-buffers |
| 3614 | (setq old-buffers (delq (current-buffer) old-buffers))) | 3594 | (setq old-buffers (delq (current-buffer) old-buffers))) |
| 3615 | (if (fboundp 'set-specifier) ;; XEmacs | 3595 | (if (< left-margin-width 2) |
| 3616 | (set-specifier left-margin-width (cons (current-buffer) 2)) | 3596 | (setq left-margin-width 2)) |
| 3617 | (if (< left-margin-width 2) | ||
| 3618 | (setq left-margin-width 2))) | ||
| 3619 | (let ((window (get-buffer-window (current-buffer) 0))) | 3597 | (let ((window (get-buffer-window (current-buffer) 0))) |
| 3620 | (if window | 3598 | (if window |
| 3621 | (set-window-margins | 3599 | (set-window-margins |
| @@ -3623,9 +3601,7 @@ Existing overlays are recycled, in order to minimize consumption." | |||
| 3623 | (if use-glyph | 3601 | (if use-glyph |
| 3624 | (while (setq buf (pop old-buffers)) | 3602 | (while (setq buf (pop old-buffers)) |
| 3625 | (with-current-buffer buf | 3603 | (with-current-buffer buf |
| 3626 | (if (fboundp 'set-specifier) ;; XEmacs | 3604 | (setq left-margin-width 0) |
| 3627 | (set-specifier left-margin-width (cons (current-buffer) 0)) | ||
| 3628 | (setq left-margin-width 0)) | ||
| 3629 | (let ((window (get-buffer-window buf 0))) | 3605 | (let ((window (get-buffer-window buf 0))) |
| 3630 | (if window | 3606 | (if window |
| 3631 | (set-window-margins | 3607 | (set-window-margins |
| @@ -4352,21 +4328,19 @@ Shell debugging commands are available as single key sequences." | |||
| 4352 | ["Toggle Toolbar" idlwave-shell-toggle-toolbar t] | 4328 | ["Toggle Toolbar" idlwave-shell-toggle-toolbar t] |
| 4353 | ["Exit IDL" idlwave-shell-quit t])) | 4329 | ["Exit IDL" idlwave-shell-quit t])) |
| 4354 | 4330 | ||
| 4355 | (if (or (featurep 'easymenu) (load "easymenu" t)) | 4331 | (easy-menu-define |
| 4356 | (progn | 4332 | idlwave-mode-debug-menu idlwave-mode-map "IDL debugging menus" |
| 4357 | (easy-menu-define | 4333 | idlwave-shell-menu-def) |
| 4358 | idlwave-mode-debug-menu idlwave-mode-map "IDL debugging menus" | 4334 | (easy-menu-define |
| 4359 | idlwave-shell-menu-def) | 4335 | idlwave-shell-mode-menu idlwave-shell-mode-map "IDL shell menus" |
| 4360 | (easy-menu-define | 4336 | idlwave-shell-menu-def) |
| 4361 | idlwave-shell-mode-menu idlwave-shell-mode-map "IDL shell menus" | 4337 | (save-current-buffer |
| 4362 | idlwave-shell-menu-def) | 4338 | (dolist (buf (buffer-list)) |
| 4363 | (save-current-buffer | 4339 | (set-buffer buf) |
| 4364 | (dolist (buf (buffer-list)) | 4340 | (if (derived-mode-p 'idlwave-mode) |
| 4365 | (set-buffer buf) | 4341 | (progn |
| 4366 | (if (derived-mode-p 'idlwave-mode) | 4342 | (easy-menu-remove idlwave-mode-debug-menu) |
| 4367 | (progn | 4343 | (easy-menu-add idlwave-mode-debug-menu))))) |
| 4368 | (easy-menu-remove idlwave-mode-debug-menu) | ||
| 4369 | (easy-menu-add idlwave-mode-debug-menu))))))) | ||
| 4370 | 4344 | ||
| 4371 | ;; The Breakpoint Glyph ------------------------------------------------------- | 4345 | ;; The Breakpoint Glyph ------------------------------------------------------- |
| 4372 | 4346 | ||
diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el index 86f9f336723..876c38da7e7 100644 --- a/lisp/progmodes/idlwave.el +++ b/lisp/progmodes/idlwave.el | |||
| @@ -1355,8 +1355,8 @@ Normally a space.") | |||
| 1355 | 1355 | ||
| 1356 | (defmacro idlwave-keyword-abbrev (&rest args) | 1356 | (defmacro idlwave-keyword-abbrev (&rest args) |
| 1357 | "Creates a function for abbrev hooks to call `idlwave-check-abbrev' with args." | 1357 | "Creates a function for abbrev hooks to call `idlwave-check-abbrev' with args." |
| 1358 | `(quote (lambda () | 1358 | `(lambda () |
| 1359 | ,(append '(idlwave-check-abbrev) args)))) | 1359 | ,(append '(idlwave-check-abbrev) args))) |
| 1360 | 1360 | ||
| 1361 | ;; If I take the time I can replace idlwave-keyword-abbrev with | 1361 | ;; If I take the time I can replace idlwave-keyword-abbrev with |
| 1362 | ;; idlwave-code-abbrev and remove the quoted abbrev check from | 1362 | ;; idlwave-code-abbrev and remove the quoted abbrev check from |
| @@ -1920,15 +1920,10 @@ The main features of this mode are | |||
| 1920 | 'idlwave-forward-block nil)) | 1920 | 'idlwave-forward-block nil)) |
| 1921 | 1921 | ||
| 1922 | ;; Make a local post-command-hook and add our hook to it | 1922 | ;; Make a local post-command-hook and add our hook to it |
| 1923 | ;; NB: `make-local-hook' needed for older/alternative Emacs compatibility | ||
| 1924 | ;; (make-local-hook 'post-command-hook) | ||
| 1925 | (add-hook 'post-command-hook 'idlwave-command-hook nil 'local) | 1923 | (add-hook 'post-command-hook 'idlwave-command-hook nil 'local) |
| 1926 | 1924 | ||
| 1927 | ;; Make local hooks for buffer updates | 1925 | ;; Make local hooks for buffer updates |
| 1928 | ;; NB: `make-local-hook' needed for older/alternative Emacs compatibility | ||
| 1929 | ;; (make-local-hook 'kill-buffer-hook) | ||
| 1930 | (add-hook 'kill-buffer-hook 'idlwave-kill-buffer-update nil 'local) | 1926 | (add-hook 'kill-buffer-hook 'idlwave-kill-buffer-update nil 'local) |
| 1931 | ;; (make-local-hook 'after-save-hook) | ||
| 1932 | (add-hook 'after-save-hook 'idlwave-save-buffer-update nil 'local) | 1927 | (add-hook 'after-save-hook 'idlwave-save-buffer-update nil 'local) |
| 1933 | (add-hook 'after-save-hook 'idlwave-revoke-license-to-kill nil 'local) | 1928 | (add-hook 'after-save-hook 'idlwave-revoke-license-to-kill nil 'local) |
| 1934 | 1929 | ||
| @@ -2781,10 +2776,7 @@ If the optional argument EXPAND is non-nil then the actions in | |||
| 2781 | ;; Adjust parallel comment | 2776 | ;; Adjust parallel comment |
| 2782 | (end-of-line) | 2777 | (end-of-line) |
| 2783 | (if (idlwave-in-comment) | 2778 | (if (idlwave-in-comment) |
| 2784 | ;; Emacs 21 is too smart with fill-column on comment indent | 2779 | (let ((fill-column (1- (frame-width)))) |
| 2785 | (let ((fill-column (if (fboundp 'comment-indent-new-line) | ||
| 2786 | (1- (frame-width)) | ||
| 2787 | fill-column))) | ||
| 2788 | (indent-for-comment))))) | 2780 | (indent-for-comment))))) |
| 2789 | (goto-char mloc) | 2781 | (goto-char mloc) |
| 2790 | ;; Get rid of marker | 2782 | ;; Get rid of marker |
| @@ -3996,12 +3988,7 @@ blank lines." | |||
| 3996 | ;; skip blank lines | 3988 | ;; skip blank lines |
| 3997 | (skip-chars-forward " \t\n") | 3989 | (skip-chars-forward " \t\n") |
| 3998 | (if (looking-at (concat "[ \t]*\\(" comment-start "+\\)")) | 3990 | (if (looking-at (concat "[ \t]*\\(" comment-start "+\\)")) |
| 3999 | (if (fboundp 'uncomment-region) | 3991 | (uncomment-region beg end) |
| 4000 | (uncomment-region beg end) | ||
| 4001 | (comment-region beg end | ||
| 4002 | (- (length (buffer-substring | ||
| 4003 | (match-beginning 1) | ||
| 4004 | (match-end 1)))))) | ||
| 4005 | (comment-region beg end))))) | 3992 | (comment-region beg end))))) |
| 4006 | 3993 | ||
| 4007 | 3994 | ||
| @@ -4047,11 +4034,6 @@ blank lines." | |||
| 4047 | (defun idlwave-reset-sintern (&optional what) | 4034 | (defun idlwave-reset-sintern (&optional what) |
| 4048 | "Reset all sintern hashes." | 4035 | "Reset all sintern hashes." |
| 4049 | ;; Make sure the hash functions are accessible. | 4036 | ;; Make sure the hash functions are accessible. |
| 4050 | (unless (and (fboundp 'gethash) | ||
| 4051 | (fboundp 'puthash)) | ||
| 4052 | (require 'cl) | ||
| 4053 | (or (fboundp 'puthash) | ||
| 4054 | (defalias 'puthash 'cl-puthash))) | ||
| 4055 | (let ((entries '((idlwave-sint-routines 1000 10) | 4037 | (let ((entries '((idlwave-sint-routines 1000 10) |
| 4056 | (idlwave-sint-keywords 1000 10) | 4038 | (idlwave-sint-keywords 1000 10) |
| 4057 | (idlwave-sint-methods 100 10) | 4039 | (idlwave-sint-methods 100 10) |
| @@ -7642,14 +7624,13 @@ associated TAG, if any." | |||
| 7642 | 7624 | ||
| 7643 | (defun idlwave-completion-fontify-classes () | 7625 | (defun idlwave-completion-fontify-classes () |
| 7644 | "Goto the *Completions* buffer and fontify the class info." | 7626 | "Goto the *Completions* buffer and fontify the class info." |
| 7645 | (when (featurep 'font-lock) | 7627 | (with-current-buffer "*Completions*" |
| 7646 | (with-current-buffer "*Completions*" | 7628 | (save-excursion |
| 7647 | (save-excursion | 7629 | (goto-char (point-min)) |
| 7648 | (goto-char (point-min)) | 7630 | (let ((buffer-read-only nil)) |
| 7649 | (let ((buffer-read-only nil)) | 7631 | (while (re-search-forward "\\.*<[^>]+>" nil t) |
| 7650 | (while (re-search-forward "\\.*<[^>]+>" nil t) | 7632 | (put-text-property (match-beginning 0) (match-end 0) |
| 7651 | (put-text-property (match-beginning 0) (match-end 0) | 7633 | 'face 'font-lock-string-face)))))) |
| 7652 | 'face 'font-lock-string-face))))))) | ||
| 7653 | 7634 | ||
| 7654 | (defun idlwave-uniquify (list) | 7635 | (defun idlwave-uniquify (list) |
| 7655 | (let ((ht (make-hash-table :size (length list) :test 'equal))) | 7636 | (let ((ht (make-hash-table :size (length list) :test 'equal))) |
| @@ -8892,9 +8873,7 @@ Assumes that point is at the beginning of the unit as found by | |||
| 8892 | (let ((begin (point))) | 8873 | (let ((begin (point))) |
| 8893 | (re-search-forward | 8874 | (re-search-forward |
| 8894 | "[a-zA-Z_][a-zA-Z0-9$_]+\\(::[a-zA-Z_][a-zA-Z0-9$_]+\\)?") | 8875 | "[a-zA-Z_][a-zA-Z0-9$_]+\\(::[a-zA-Z_][a-zA-Z0-9$_]+\\)?") |
| 8895 | (if (fboundp 'buffer-substring-no-properties) | 8876 | (buffer-substring-no-properties begin (point)))) |
| 8896 | (buffer-substring-no-properties begin (point)) | ||
| 8897 | (buffer-substring begin (point))))) | ||
| 8898 | 8877 | ||
| 8899 | (defalias 'idlwave-function-menu | 8878 | (defalias 'idlwave-function-menu |
| 8900 | (condition-case nil | 8879 | (condition-case nil |
| @@ -9010,8 +8989,7 @@ Assumes that point is at the beginning of the unit as found by | |||
| 9010 | ("Customize" | 8989 | ("Customize" |
| 9011 | ["Browse IDLWAVE Group" idlwave-customize t] | 8990 | ["Browse IDLWAVE Group" idlwave-customize t] |
| 9012 | "--" | 8991 | "--" |
| 9013 | ["Build Full Customize Menu" idlwave-create-customize-menu | 8992 | ["Build Full Customize Menu" idlwave-create-customize-menu t]) |
| 9014 | (fboundp 'customize-menu-create)]) | ||
| 9015 | ("Documentation" | 8993 | ("Documentation" |
| 9016 | ["Describe Mode" describe-mode t] | 8994 | ["Describe Mode" describe-mode t] |
| 9017 | ["Abbreviation List" idlwave-list-abbrevs t] | 8995 | ["Abbreviation List" idlwave-list-abbrevs t] |
| @@ -9032,14 +9010,12 @@ Assumes that point is at the beginning of the unit as found by | |||
| 9032 | (and (boundp 'idlwave-shell-automatic-start) | 9010 | (and (boundp 'idlwave-shell-automatic-start) |
| 9033 | idlwave-shell-automatic-start)])) | 9011 | idlwave-shell-automatic-start)])) |
| 9034 | 9012 | ||
| 9035 | (if (or (featurep 'easymenu) (load "easymenu" t)) | 9013 | (easy-menu-define idlwave-mode-menu idlwave-mode-map |
| 9036 | (progn | 9014 | "IDL and WAVE CL editing menu" |
| 9037 | (easy-menu-define idlwave-mode-menu idlwave-mode-map | 9015 | idlwave-mode-menu-def) |
| 9038 | "IDL and WAVE CL editing menu" | 9016 | (easy-menu-define idlwave-mode-debug-menu idlwave-mode-map |
| 9039 | idlwave-mode-menu-def) | 9017 | "IDL and WAVE CL editing menu" |
| 9040 | (easy-menu-define idlwave-mode-debug-menu idlwave-mode-map | 9018 | idlwave-mode-debug-menu-def) |
| 9041 | "IDL and WAVE CL editing menu" | ||
| 9042 | idlwave-mode-debug-menu-def))) | ||
| 9043 | 9019 | ||
| 9044 | (defun idlwave-customize () | 9020 | (defun idlwave-customize () |
| 9045 | "Call the customize function with `idlwave' as argument." | 9021 | "Call the customize function with `idlwave' as argument." |
| @@ -9053,24 +9029,21 @@ Assumes that point is at the beginning of the unit as found by | |||
| 9053 | (defun idlwave-create-customize-menu () | 9029 | (defun idlwave-create-customize-menu () |
| 9054 | "Create a full customization menu for IDLWAVE, insert it into the menu." | 9030 | "Create a full customization menu for IDLWAVE, insert it into the menu." |
| 9055 | (interactive) | 9031 | (interactive) |
| 9056 | (if (fboundp 'customize-menu-create) | 9032 | ;; Try to load the code for the shell, so that we can customize it |
| 9057 | (progn | 9033 | ;; as well. |
| 9058 | ;; Try to load the code for the shell, so that we can customize it | 9034 | (or (featurep 'idlw-shell) |
| 9059 | ;; as well. | 9035 | (load "idlw-shell" t)) |
| 9060 | (or (featurep 'idlw-shell) | 9036 | (easy-menu-change |
| 9061 | (load "idlw-shell" t)) | 9037 | '("IDLWAVE") "Customize" |
| 9062 | (easy-menu-change | 9038 | `(["Browse IDLWAVE group" idlwave-customize t] |
| 9063 | '("IDLWAVE") "Customize" | 9039 | "--" |
| 9064 | `(["Browse IDLWAVE group" idlwave-customize t] | 9040 | ,(customize-menu-create 'idlwave) |
| 9065 | "--" | 9041 | ["Set" Custom-set t] |
| 9066 | ,(customize-menu-create 'idlwave) | 9042 | ["Save" Custom-save t] |
| 9067 | ["Set" Custom-set t] | 9043 | ["Reset to Current" Custom-reset-current t] |
| 9068 | ["Save" Custom-save t] | 9044 | ["Reset to Saved" Custom-reset-saved t] |
| 9069 | ["Reset to Current" Custom-reset-current t] | 9045 | ["Reset to Standard Settings" Custom-reset-standard t])) |
| 9070 | ["Reset to Saved" Custom-reset-saved t] | 9046 | (message "\"IDLWAVE\"-menu now contains full customization menu")) |
| 9071 | ["Reset to Standard Settings" Custom-reset-standard t])) | ||
| 9072 | (message "\"IDLWAVE\"-menu now contains full customization menu")) | ||
| 9073 | (error "Cannot expand menu (outdated version of cus-edit.el)"))) | ||
| 9074 | 9047 | ||
| 9075 | (defun idlwave-show-commentary () | 9048 | (defun idlwave-show-commentary () |
| 9076 | "Use the finder to view the file documentation from `idlwave.el'." | 9049 | "Use the finder to view the file documentation from `idlwave.el'." |
diff --git a/lisp/progmodes/make-mode.el b/lisp/progmodes/make-mode.el index 8596d78a604..3e49f84dbce 100644 --- a/lisp/progmodes/make-mode.el +++ b/lisp/progmodes/make-mode.el | |||
| @@ -1370,13 +1370,11 @@ Fill comments, backslashed lines, and variable definitions specially." | |||
| 1370 | (goto-char (point-min)) | 1370 | (goto-char (point-min)) |
| 1371 | (erase-buffer) | 1371 | (erase-buffer) |
| 1372 | (mapconcat | 1372 | (mapconcat |
| 1373 | (function | 1373 | (lambda (item) (insert (makefile-browser-format-target-line (car item) nil) "\n")) |
| 1374 | (lambda (item) (insert (makefile-browser-format-target-line (car item) nil) "\n"))) | ||
| 1375 | targets | 1374 | targets |
| 1376 | "") | 1375 | "") |
| 1377 | (mapconcat | 1376 | (mapconcat |
| 1378 | (function | 1377 | (lambda (item) (insert (makefile-browser-format-macro-line (car item) nil) "\n")) |
| 1379 | (lambda (item) (insert (makefile-browser-format-macro-line (car item) nil) "\n"))) | ||
| 1380 | macros | 1378 | macros |
| 1381 | "") | 1379 | "") |
| 1382 | (sort-lines nil (point-min) (point-max)) | 1380 | (sort-lines nil (point-min) (point-max)) |
diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el index 7265aeee45d..bb19436cdad 100644 --- a/lisp/progmodes/perl-mode.el +++ b/lisp/progmodes/perl-mode.el | |||
| @@ -209,7 +209,7 @@ | |||
| 209 | (eval-and-compile | 209 | (eval-and-compile |
| 210 | (defconst perl--syntax-exp-intro-keywords | 210 | (defconst perl--syntax-exp-intro-keywords |
| 211 | '("split" "if" "unless" "until" "while" "print" | 211 | '("split" "if" "unless" "until" "while" "print" |
| 212 | "grep" "map" "not" "or" "and" "for" "foreach")) | 212 | "grep" "map" "not" "or" "and" "for" "foreach" "return")) |
| 213 | 213 | ||
| 214 | (defconst perl--syntax-exp-intro-regexp | 214 | (defconst perl--syntax-exp-intro-regexp |
| 215 | (concat "\\(?:\\(?:^\\|[^$@&%[:word:]]\\)" | 215 | (concat "\\(?:\\(?:^\\|[^$@&%[:word:]]\\)" |
diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el index 124f652ed69..75e95d9b904 100644 --- a/lisp/progmodes/prolog.el +++ b/lisp/progmodes/prolog.el | |||
| @@ -261,7 +261,6 @@ | |||
| 261 | (require 'comint) | 261 | (require 'comint) |
| 262 | 262 | ||
| 263 | (eval-when-compile | 263 | (eval-when-compile |
| 264 | (require 'font-lock) | ||
| 265 | ;; We need imenu everywhere because of the predicate index! | 264 | ;; We need imenu everywhere because of the predicate index! |
| 266 | (require 'imenu) | 265 | (require 'imenu) |
| 267 | ;) | 266 | ;) |
| @@ -1883,8 +1882,6 @@ Argument BOUND is a buffer position limiting searching." | |||
| 1883 | ;; Set everything up | 1882 | ;; Set everything up |
| 1884 | (defun prolog-font-lock-keywords () | 1883 | (defun prolog-font-lock-keywords () |
| 1885 | "Set up font lock keywords for the current Prolog system." | 1884 | "Set up font lock keywords for the current Prolog system." |
| 1886 | ;;(when window-system | ||
| 1887 | (require 'font-lock) | ||
| 1888 | 1885 | ||
| 1889 | ;; Define Prolog faces | 1886 | ;; Define Prolog faces |
| 1890 | (defface prolog-redo-face | 1887 | (defface prolog-redo-face |
diff --git a/lisp/simple.el b/lisp/simple.el index e96c7c9a6ea..bb28145502b 100644 --- a/lisp/simple.el +++ b/lisp/simple.el | |||
| @@ -5087,11 +5087,20 @@ visual feedback indicating the extent of the region being copied." | |||
| 5087 | (if (called-interactively-p 'interactive) | 5087 | (if (called-interactively-p 'interactive) |
| 5088 | (indicate-copied-region))) | 5088 | (indicate-copied-region))) |
| 5089 | 5089 | ||
| 5090 | (defcustom copy-region-blink-delay 1 | ||
| 5091 | "Time in seconds to delay after showing the other end of the region. | ||
| 5092 | It's used by the command `kill-ring-save' and the function | ||
| 5093 | `indicate-copied-region' to blink the cursor between point and mark. | ||
| 5094 | The value 0 disables blinking." | ||
| 5095 | :type 'number | ||
| 5096 | :group 'killing | ||
| 5097 | :version "28.1") | ||
| 5098 | |||
| 5090 | (defun indicate-copied-region (&optional message-len) | 5099 | (defun indicate-copied-region (&optional message-len) |
| 5091 | "Indicate that the region text has been copied interactively. | 5100 | "Indicate that the region text has been copied interactively. |
| 5092 | If the mark is visible in the selected window, blink the cursor | 5101 | If the mark is visible in the selected window, blink the cursor between |
| 5093 | between point and mark if there is currently no active region | 5102 | point and mark if there is currently no active region highlighting. |
| 5094 | highlighting. | 5103 | The option `copy-region-blink-delay' can disable blinking. |
| 5095 | 5104 | ||
| 5096 | If the mark lies outside the selected window, display an | 5105 | If the mark lies outside the selected window, display an |
| 5097 | informative message containing a sample of the copied text. The | 5106 | informative message containing a sample of the copied text. The |
| @@ -5105,12 +5114,14 @@ of this sample text; it defaults to 40." | |||
| 5105 | (if (pos-visible-in-window-p mark (selected-window)) | 5114 | (if (pos-visible-in-window-p mark (selected-window)) |
| 5106 | ;; Swap point-and-mark quickly so as to show the region that | 5115 | ;; Swap point-and-mark quickly so as to show the region that |
| 5107 | ;; was selected. Don't do it if the region is highlighted. | 5116 | ;; was selected. Don't do it if the region is highlighted. |
| 5108 | (unless (and (region-active-p) | 5117 | (when (and (numberp copy-region-blink-delay) |
| 5109 | (face-background 'region nil t)) | 5118 | (> copy-region-blink-delay 0) |
| 5119 | (or (not (region-active-p)) | ||
| 5120 | (not (face-background 'region nil t)))) | ||
| 5110 | ;; Swap point and mark. | 5121 | ;; Swap point and mark. |
| 5111 | (set-marker (mark-marker) (point) (current-buffer)) | 5122 | (set-marker (mark-marker) (point) (current-buffer)) |
| 5112 | (goto-char mark) | 5123 | (goto-char mark) |
| 5113 | (sit-for blink-matching-delay) | 5124 | (sit-for copy-region-blink-delay) |
| 5114 | ;; Swap back. | 5125 | ;; Swap back. |
| 5115 | (set-marker (mark-marker) mark (current-buffer)) | 5126 | (set-marker (mark-marker) mark (current-buffer)) |
| 5116 | (goto-char point) | 5127 | (goto-char point) |
| @@ -5121,11 +5132,14 @@ of this sample text; it defaults to 40." | |||
| 5121 | (let ((len (min (abs (- mark point)) | 5132 | (let ((len (min (abs (- mark point)) |
| 5122 | (or message-len 40)))) | 5133 | (or message-len 40)))) |
| 5123 | (if (< point mark) | 5134 | (if (< point mark) |
| 5124 | ;; Don't say "killed"; that is misleading. | 5135 | ;; Don't say "killed" or "saved"; that is misleading. |
| 5125 | (message "Saved text until \"%s\"" | 5136 | (message "Copied text until \"%s\"" |
| 5126 | (buffer-substring-no-properties (- mark len) mark)) | 5137 | ;; Don't show newlines literally |
| 5127 | (message "Saved text from \"%s\"" | 5138 | (query-replace-descr |
| 5128 | (buffer-substring-no-properties mark (+ mark len)))))))) | 5139 | (buffer-substring-no-properties (- mark len) mark))) |
| 5140 | (message "Copied text from \"%s\"" | ||
| 5141 | (query-replace-descr | ||
| 5142 | (buffer-substring-no-properties mark (+ mark len))))))))) | ||
| 5129 | 5143 | ||
| 5130 | (defun append-next-kill (&optional interactive) | 5144 | (defun append-next-kill (&optional interactive) |
| 5131 | "Cause following command, if it kills, to add to previous kill. | 5145 | "Cause following command, if it kills, to add to previous kill. |
| @@ -7421,18 +7435,17 @@ are interchanged." | |||
| 7421 | With argument ARG, takes previous line and moves it past ARG lines. | 7435 | With argument ARG, takes previous line and moves it past ARG lines. |
| 7422 | With argument 0, interchanges line point is in with line mark is in." | 7436 | With argument 0, interchanges line point is in with line mark is in." |
| 7423 | (interactive "*p") | 7437 | (interactive "*p") |
| 7424 | (transpose-subr (function | 7438 | (transpose-subr (lambda (arg) |
| 7425 | (lambda (arg) | 7439 | (if (> arg 0) |
| 7426 | (if (> arg 0) | 7440 | (progn |
| 7427 | (progn | 7441 | ;; Move forward over ARG lines, |
| 7428 | ;; Move forward over ARG lines, | 7442 | ;; but create newlines if necessary. |
| 7429 | ;; but create newlines if necessary. | 7443 | (setq arg (forward-line arg)) |
| 7430 | (setq arg (forward-line arg)) | 7444 | (if (/= (preceding-char) ?\n) |
| 7431 | (if (/= (preceding-char) ?\n) | 7445 | (setq arg (1+ arg))) |
| 7432 | (setq arg (1+ arg))) | 7446 | (if (> arg 0) |
| 7433 | (if (> arg 0) | 7447 | (newline arg))) |
| 7434 | (newline arg))) | 7448 | (forward-line arg))) |
| 7435 | (forward-line arg)))) | ||
| 7436 | arg)) | 7449 | arg)) |
| 7437 | 7450 | ||
| 7438 | ;; FIXME seems to leave point BEFORE the current object when ARG = 0, | 7451 | ;; FIXME seems to leave point BEFORE the current object when ARG = 0, |
diff --git a/lisp/subr.el b/lisp/subr.el index 2f351654ab3..f9ca50f95ec 100644 --- a/lisp/subr.el +++ b/lisp/subr.el | |||
| @@ -2611,7 +2611,11 @@ This function is used by the `interactive' code letter `n'." | |||
| 2611 | Any input that is not one of CHARS is ignored. | 2611 | Any input that is not one of CHARS is ignored. |
| 2612 | 2612 | ||
| 2613 | If optional argument INHIBIT-KEYBOARD-QUIT is non-nil, ignore | 2613 | If optional argument INHIBIT-KEYBOARD-QUIT is non-nil, ignore |
| 2614 | keyboard-quit events while waiting for a valid input." | 2614 | keyboard-quit events while waiting for a valid input. |
| 2615 | |||
| 2616 | If you bind the variable `help-form' to a non-nil value | ||
| 2617 | while calling this function, then pressing `help-char' | ||
| 2618 | causes it to evaluate `help-form' and display the result." | ||
| 2615 | (unless (consp chars) | 2619 | (unless (consp chars) |
| 2616 | (error "Called `read-char-choice' without valid char choices")) | 2620 | (error "Called `read-char-choice' without valid char choices")) |
| 2617 | (let (char done show-help (helpbuf " *Char Help*")) | 2621 | (let (char done show-help (helpbuf " *Char Help*")) |
| @@ -2772,8 +2776,11 @@ Optional argument HISTORY, if non-nil, should be a symbol that | |||
| 2772 | specifies the history list variable to use for navigating in input | 2776 | specifies the history list variable to use for navigating in input |
| 2773 | history using `M-p' and `M-n', with `RET' to select a character from | 2777 | history using `M-p' and `M-n', with `RET' to select a character from |
| 2774 | history. | 2778 | history. |
| 2775 | If the caller has set `help-form', there is no need to explicitly add | 2779 | If you bind the variable `help-form' to a non-nil value |
| 2776 | `help-char' to chars. It's bound automatically to `help-form-show'." | 2780 | while calling this function, then pressing `help-char' |
| 2781 | causes it to evaluate `help-form' and display the result. | ||
| 2782 | There is no need to explicitly add `help-char' to CHARS; | ||
| 2783 | `help-char' is bound automatically to `help-form-show'." | ||
| 2777 | (let* ((empty-history '()) | 2784 | (let* ((empty-history '()) |
| 2778 | (map (if (consp chars) | 2785 | (map (if (consp chars) |
| 2779 | (or (gethash (list help-form (cons help-char chars)) | 2786 | (or (gethash (list help-form (cons help-char chars)) |
| @@ -2830,7 +2837,7 @@ If the caller has set `help-form', there is no need to explicitly add | |||
| 2830 | 2837 | ||
| 2831 | (define-key map [remap skip] 'y-or-n-p-insert-n) | 2838 | (define-key map [remap skip] 'y-or-n-p-insert-n) |
| 2832 | 2839 | ||
| 2833 | (dolist (symbol '(help backup undo undo-all edit edit-replacement | 2840 | (dolist (symbol '(backup undo undo-all edit edit-replacement |
| 2834 | delete-and-edit ignore self-insert-command)) | 2841 | delete-and-edit ignore self-insert-command)) |
| 2835 | (define-key map (vector 'remap symbol) 'y-or-n-p-insert-other)) | 2842 | (define-key map (vector 'remap symbol) 'y-or-n-p-insert-other)) |
| 2836 | 2843 | ||
| @@ -2885,6 +2892,12 @@ Return t if answer is \"y\" and nil if it is \"n\". | |||
| 2885 | PROMPT is the string to display to ask the question. It should | 2892 | PROMPT is the string to display to ask the question. It should |
| 2886 | end in a space; `y-or-n-p' adds \"(y or n) \" to it. | 2893 | end in a space; `y-or-n-p' adds \"(y or n) \" to it. |
| 2887 | 2894 | ||
| 2895 | If you bind the variable `help-form' to a non-nil value | ||
| 2896 | while calling this function, then pressing `help-char' | ||
| 2897 | causes it to evaluate `help-form' and display the result. | ||
| 2898 | PROMPT is also updated to show `help-char' like \"(y, n or C-h) \", | ||
| 2899 | where `help-char' is automatically bound to `help-form-show'. | ||
| 2900 | |||
| 2888 | No confirmation of the answer is requested; a single character is | 2901 | No confirmation of the answer is requested; a single character is |
| 2889 | enough. SPC also means yes, and DEL means no. | 2902 | enough. SPC also means yes, and DEL means no. |
| 2890 | 2903 | ||
| @@ -2907,7 +2920,13 @@ is nil and `use-dialog-box' is non-nil." | |||
| 2907 | (concat prompt | 2920 | (concat prompt |
| 2908 | (if (or (zerop l) (eq ?\s (aref prompt (1- l)))) | 2921 | (if (or (zerop l) (eq ?\s (aref prompt (1- l)))) |
| 2909 | "" " ") | 2922 | "" " ") |
| 2910 | (if dialog "" "(y or n) ")))))) | 2923 | (if dialog "" |
| 2924 | (if help-form | ||
| 2925 | (format "(y, n or %s) " | ||
| 2926 | (key-description | ||
| 2927 | (vector help-char))) | ||
| 2928 | "(y or n) " | ||
| 2929 | ))))))) | ||
| 2911 | (cond | 2930 | (cond |
| 2912 | (noninteractive | 2931 | (noninteractive |
| 2913 | (setq prompt (funcall padded prompt)) | 2932 | (setq prompt (funcall padded prompt)) |
| @@ -2916,6 +2935,7 @@ is nil and `use-dialog-box' is non-nil." | |||
| 2916 | (let ((str (read-string temp-prompt))) | 2935 | (let ((str (read-string temp-prompt))) |
| 2917 | (cond ((member str '("y" "Y")) (setq answer 'act)) | 2936 | (cond ((member str '("y" "Y")) (setq answer 'act)) |
| 2918 | ((member str '("n" "N")) (setq answer 'skip)) | 2937 | ((member str '("n" "N")) (setq answer 'skip)) |
| 2938 | ((and (member str '("h" "H")) help-form) (print help-form)) | ||
| 2919 | (t (setq temp-prompt (concat "Please answer y or n. " | 2939 | (t (setq temp-prompt (concat "Please answer y or n. " |
| 2920 | prompt)))))))) | 2940 | prompt)))))))) |
| 2921 | ((and (display-popup-menus-p) | 2941 | ((and (display-popup-menus-p) |
| @@ -2928,10 +2948,20 @@ is nil and `use-dialog-box' is non-nil." | |||
| 2928 | (setq prompt (funcall padded prompt)) | 2948 | (setq prompt (funcall padded prompt)) |
| 2929 | (let* ((empty-history '()) | 2949 | (let* ((empty-history '()) |
| 2930 | (enable-recursive-minibuffers t) | 2950 | (enable-recursive-minibuffers t) |
| 2951 | (msg help-form) | ||
| 2952 | (keymap (let ((map (make-composed-keymap | ||
| 2953 | y-or-n-p-map query-replace-map))) | ||
| 2954 | (when help-form | ||
| 2955 | ;; Create a new map before modifying | ||
| 2956 | (setq map (copy-keymap map)) | ||
| 2957 | (define-key map (vector help-char) | ||
| 2958 | (lambda () | ||
| 2959 | (interactive) | ||
| 2960 | (let ((help-form msg)) ; lexically bound msg | ||
| 2961 | (help-form-show))))) | ||
| 2962 | map)) | ||
| 2931 | (str (read-from-minibuffer | 2963 | (str (read-from-minibuffer |
| 2932 | prompt nil | 2964 | prompt nil keymap nil |
| 2933 | (make-composed-keymap y-or-n-p-map query-replace-map) | ||
| 2934 | nil | ||
| 2935 | (or y-or-n-p-history-variable 'empty-history)))) | 2965 | (or y-or-n-p-history-variable 'empty-history)))) |
| 2936 | (setq answer (if (member str '("y" "Y")) 'act 'skip))))) | 2966 | (setq answer (if (member str '("y" "Y")) 'act 'skip))))) |
| 2937 | (let ((ret (eq answer 'act))) | 2967 | (let ((ret (eq answer 'act))) |
diff --git a/lisp/term.el b/lisp/term.el index 8cbbfff1b63..585232be6c3 100644 --- a/lisp/term.el +++ b/lisp/term.el | |||
| @@ -123,13 +123,12 @@ | |||
| 123 | ;; full advantage of this package | 123 | ;; full advantage of this package |
| 124 | ;; | 124 | ;; |
| 125 | ;; (add-hook 'term-mode-hook | 125 | ;; (add-hook 'term-mode-hook |
| 126 | ;; (function | 126 | ;; (lambda () |
| 127 | ;; (lambda () | 127 | ;; (setq term-prompt-regexp "^[^#$%>\n]*[#$%>] *") |
| 128 | ;; (setq term-prompt-regexp "^[^#$%>\n]*[#$%>] *") | 128 | ;; (setq-local mouse-yank-at-point t) |
| 129 | ;; (setq-local mouse-yank-at-point t) | 129 | ;; (setq-local transient-mark-mode nil) |
| 130 | ;; (setq-local transient-mark-mode nil) | 130 | ;; (auto-fill-mode -1) |
| 131 | ;; (auto-fill-mode -1) | 131 | ;; (setq tab-width 8))) |
| 132 | ;; (setq tab-width 8 )))) | ||
| 133 | ;; | 132 | ;; |
| 134 | ;; ---------------------------------------- | 133 | ;; ---------------------------------------- |
| 135 | ;; | 134 | ;; |
diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el index f15337818b0..375a23e4b14 100644 --- a/lisp/term/w32-win.el +++ b/lisp/term/w32-win.el | |||
| @@ -568,46 +568,45 @@ default font on FRAME, or its best approximation." | |||
| 568 | (x-list-fonts "-*-*-medium-r-normal-*-*-*-*-*-*-iso10646-1" | 568 | (x-list-fonts "-*-*-medium-r-normal-*-*-*-*-*-*-iso10646-1" |
| 569 | 'default frame))) | 569 | 'default frame))) |
| 570 | val) | 570 | val) |
| 571 | (mapc (function | 571 | (mapc (lambda (script-desc) |
| 572 | (lambda (script-desc) | 572 | (let* ((script (car script-desc)) |
| 573 | (let* ((script (car script-desc)) | 573 | (script-chars (vconcat (cdr script-desc))) |
| 574 | (script-chars (vconcat (cdr script-desc))) | 574 | (nchars (length script-chars)) |
| 575 | (nchars (length script-chars)) | 575 | (fntlist all-fonts) |
| 576 | (fntlist all-fonts) | 576 | (entry (list script)) |
| 577 | (entry (list script)) | 577 | fspec ffont font-obj glyphs idx) |
| 578 | fspec ffont font-obj glyphs idx) | 578 | ;; For each font in FNTLIST, determine whether it |
| 579 | ;; For each font in FNTLIST, determine whether it | 579 | ;; supports the representative character(s) of any |
| 580 | ;; supports the representative character(s) of any | 580 | ;; scripts that have no USBs defined for it. |
| 581 | ;; scripts that have no USBs defined for it. | 581 | (dolist (fnt fntlist) |
| 582 | (dolist (fnt fntlist) | 582 | (setq fspec (ignore-errors (font-spec :name fnt))) |
| 583 | (setq fspec (ignore-errors (font-spec :name fnt))) | 583 | (if fspec |
| 584 | (if fspec | 584 | (setq ffont (find-font fspec frame))) |
| 585 | (setq ffont (find-font fspec frame))) | 585 | (when ffont |
| 586 | (when ffont | 586 | (setq font-obj |
| 587 | (setq font-obj | 587 | (open-font ffont size frame)) |
| 588 | (open-font ffont size frame)) | 588 | ;; Ignore fonts for which open-font returns nil: |
| 589 | ;; Ignore fonts for which open-font returns nil: | 589 | ;; they are buggy fonts that we cannot use anyway. |
| 590 | ;; they are buggy fonts that we cannot use anyway. | 590 | (setq glyphs |
| 591 | (setq glyphs | 591 | (if font-obj |
| 592 | (if font-obj | 592 | (font-get-glyphs font-obj |
| 593 | (font-get-glyphs font-obj | 593 | 0 nchars script-chars) |
| 594 | 0 nchars script-chars) | 594 | '[nil])) |
| 595 | '[nil])) | 595 | ;; Does this font support ALL of the script's |
| 596 | ;; Does this font support ALL of the script's | 596 | ;; representative characters? |
| 597 | ;; representative characters? | 597 | (setq idx 0) |
| 598 | (setq idx 0) | 598 | (while (and (< idx nchars) (not (null (aref glyphs idx)))) |
| 599 | (while (and (< idx nchars) (not (null (aref glyphs idx)))) | 599 | (setq idx (1+ idx))) |
| 600 | (setq idx (1+ idx))) | 600 | (if (= idx nchars) |
| 601 | (if (= idx nchars) | 601 | ;; It does; add this font to the script's entry in alist. |
| 602 | ;; It does; add this font to the script's entry in alist. | 602 | (let ((font-family (font-get font-obj :family))) |
| 603 | (let ((font-family (font-get font-obj :family))) | 603 | ;; Unifont is an ugly font, and it is already |
| 604 | ;; Unifont is an ugly font, and it is already | 604 | ;; present in the default fontset. |
| 605 | ;; present in the default fontset. | 605 | (unless (string= (downcase (symbol-name font-family)) |
| 606 | (unless (string= (downcase (symbol-name font-family)) | 606 | "unifont") |
| 607 | "unifont") | 607 | (push font-family entry)))))) |
| 608 | (push font-family entry)))))) | 608 | (if (> (length entry) 1) |
| 609 | (if (> (length entry) 1) | 609 | (push (nreverse entry) val)))) |
| 610 | (push (nreverse entry) val))))) | ||
| 611 | (w32--filter-USB-scripts)) | 610 | (w32--filter-USB-scripts)) |
| 612 | ;; We've opened a lot of fonts, so clear the font caches to free | 611 | ;; We've opened a lot of fonts, so clear the font caches to free |
| 613 | ;; some memory. | 612 | ;; some memory. |
diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el index fcf63ed5ecf..c9e21e58f62 100644 --- a/lisp/textmodes/bibtex.el +++ b/lisp/textmodes/bibtex.el | |||
| @@ -88,6 +88,16 @@ If this is a function, call it to generate the initial field text." | |||
| 88 | (const :tag "Default" t)) | 88 | (const :tag "Default" t)) |
| 89 | :risky t) | 89 | :risky t) |
| 90 | 90 | ||
| 91 | (defcustom bibtex-unify-case-convert #'identity | ||
| 92 | "Function called when unifying case on entry and field names. | ||
| 93 | It is called with one argument, the entry or field name." | ||
| 94 | :version "28.1" | ||
| 95 | :type '(choice (const :tag "Same case as in `bibtex-field-alist'" identity) | ||
| 96 | (const :tag "Downcase" downcase) | ||
| 97 | (const :tag "Capitalize" capitalize) | ||
| 98 | (const :tag "Upcase" upcase) | ||
| 99 | (function :tag "Conversion function"))) | ||
| 100 | |||
| 91 | (defcustom bibtex-user-optional-fields | 101 | (defcustom bibtex-user-optional-fields |
| 92 | '(("annote" "Personal annotation (ignored)")) | 102 | '(("annote" "Personal annotation (ignored)")) |
| 93 | "List of optional fields the user wants to have always present. | 103 | "List of optional fields the user wants to have always present. |
| @@ -122,7 +132,8 @@ last-comma Add or delete comma on end of last field in entry, | |||
| 122 | according to value of `bibtex-comma-after-last-field'. | 132 | according to value of `bibtex-comma-after-last-field'. |
| 123 | delimiters Change delimiters according to variables | 133 | delimiters Change delimiters according to variables |
| 124 | `bibtex-field-delimiters' and `bibtex-entry-delimiters'. | 134 | `bibtex-field-delimiters' and `bibtex-entry-delimiters'. |
| 125 | unify-case Change case of entry types and field names. | 135 | unify-case Change case of entry and field names according to |
| 136 | `bibtex-unify-case-convert'. | ||
| 126 | braces Enclose parts of field entries by braces according to | 137 | braces Enclose parts of field entries by braces according to |
| 127 | `bibtex-field-braces-alist'. | 138 | `bibtex-field-braces-alist'. |
| 128 | strings Replace parts of field entries by string constants | 139 | strings Replace parts of field entries by string constants |
| @@ -2346,7 +2357,7 @@ Formats current entry according to variable `bibtex-entry-format'." | |||
| 2346 | ;; unify case of entry type | 2357 | ;; unify case of entry type |
| 2347 | (when (memq 'unify-case format) | 2358 | (when (memq 'unify-case format) |
| 2348 | (delete-region beg-type end-type) | 2359 | (delete-region beg-type end-type) |
| 2349 | (insert (car entry-list))) | 2360 | (insert (funcall bibtex-unify-case-convert (car entry-list)))) |
| 2350 | 2361 | ||
| 2351 | ;; update left entry delimiter | 2362 | ;; update left entry delimiter |
| 2352 | (when (memq 'delimiters format) | 2363 | (when (memq 'delimiters format) |
| @@ -2549,47 +2560,48 @@ Formats current entry according to variable `bibtex-entry-format'." | |||
| 2549 | (error "Mandatory field `%s' is empty" field-name)) | 2560 | (error "Mandatory field `%s' is empty" field-name)) |
| 2550 | 2561 | ||
| 2551 | ;; unify case of field name | 2562 | ;; unify case of field name |
| 2552 | (if (memq 'unify-case format) | 2563 | (when (memq 'unify-case format) |
| 2553 | (let ((fname (car (assoc-string field-name | 2564 | (let ((fname (car (assoc-string field-name |
| 2554 | default-field-list t)))) | 2565 | default-field-list t))) |
| 2555 | (if fname | 2566 | (curname (buffer-substring beg-name end-name))) |
| 2556 | (progn | 2567 | (delete-region beg-name end-name) |
| 2557 | (delete-region beg-name end-name) | 2568 | (goto-char beg-name) |
| 2558 | (goto-char beg-name) | 2569 | (insert (funcall bibtex-unify-case-convert |
| 2559 | (insert fname)) | 2570 | (or fname curname))))) |
| 2560 | ;; there are no rules we could follow | ||
| 2561 | (downcase-region beg-name end-name)))) | ||
| 2562 | 2571 | ||
| 2563 | ;; update point | 2572 | ;; update point |
| 2564 | (goto-char end-field)))) | 2573 | (goto-char end-field)))) |
| 2565 | 2574 | ||
| 2566 | ;; check whether all required fields are present | 2575 | ;; check whether all required fields are present |
| 2567 | (if (memq 'required-fields format) | 2576 | (when (memq 'required-fields format) |
| 2568 | (let ((alt-expect (make-vector num-alt nil)) | 2577 | (let ((alt-expect (make-vector num-alt nil)) |
| 2569 | (alt-found (make-vector num-alt 0))) | 2578 | (alt-found (make-vector num-alt 0))) |
| 2570 | (dolist (fname req-field-list) | 2579 | (dolist (fname req-field-list) |
| 2571 | (cond ((setq idx (nth 3 fname)) | 2580 | (cond ((setq idx (nth 3 fname)) |
| 2572 | ;; t if field has alternative flag | 2581 | ;; t if field has alternative flag |
| 2573 | (bibtex-vec-push alt-expect idx (car fname)) | 2582 | (bibtex-vec-push alt-expect idx (car fname)) |
| 2574 | (if (member-ignore-case (car fname) field-list) | 2583 | (if (member-ignore-case (car fname) field-list) |
| 2575 | (bibtex-vec-incr alt-found idx))) | 2584 | (bibtex-vec-incr alt-found idx))) |
| 2576 | ((not (member-ignore-case (car fname) field-list)) | 2585 | ((not (member-ignore-case (car fname) field-list)) |
| 2577 | ;; If we use the crossref field, a required field | 2586 | ;; If we use the crossref field, a required field |
| 2578 | ;; can have the OPT prefix. So if it was empty, | 2587 | ;; can have the OPT prefix. So if it was empty, |
| 2579 | ;; we have deleted by now. Nonetheless we can | 2588 | ;; we have deleted by now. Nonetheless we can |
| 2580 | ;; move point on this empty field. | 2589 | ;; move point on this empty field. |
| 2581 | (setq error-field-name (car fname)) | 2590 | (setq error-field-name (car fname)) |
| 2582 | (error "Mandatory field `%s' is missing" (car fname))))) | 2591 | (error "Mandatory field `%s' is missing" |
| 2583 | (dotimes (idx num-alt) | 2592 | (car fname))))) |
| 2584 | (cond ((= 0 (aref alt-found idx)) | 2593 | (dotimes (idx num-alt) |
| 2585 | (setq error-field-name (car (last (aref alt-fields idx)))) | 2594 | (cond ((= 0 (aref alt-found idx)) |
| 2586 | (error "Alternative mandatory field `%s' is missing" | 2595 | (setq error-field-name |
| 2587 | (aref alt-expect idx))) | 2596 | (car (last (aref alt-fields idx)))) |
| 2588 | ((< 1 (aref alt-found idx)) | 2597 | (error "Alternative mandatory field `%s' is missing" |
| 2589 | (setq error-field-name (car (last (aref alt-fields idx)))) | 2598 | (aref alt-expect idx))) |
| 2590 | (error "Alternative fields `%s' are defined %s times" | 2599 | ((< 1 (aref alt-found idx)) |
| 2591 | (aref alt-expect idx) | 2600 | (setq error-field-name |
| 2592 | (length (aref alt-fields idx)))))))) | 2601 | (car (last (aref alt-fields idx)))) |
| 2602 | (error "Alternative fields `%s' are defined %s times" | ||
| 2603 | (aref alt-expect idx) | ||
| 2604 | (length (aref alt-fields idx)))))))) | ||
| 2593 | 2605 | ||
| 2594 | ;; update comma after last field | 2606 | ;; update comma after last field |
| 2595 | (if (memq 'last-comma format) | 2607 | (if (memq 'last-comma format) |
diff --git a/lisp/textmodes/rst.el b/lisp/textmodes/rst.el index adda28cb81b..7a7ac478b76 100644 --- a/lisp/textmodes/rst.el +++ b/lisp/textmodes/rst.el | |||
| @@ -3578,8 +3578,6 @@ Region is from BEG to END. With WITH-EMPTY prefix empty lines too." | |||
| 3578 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 3578 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 3579 | ;; Font lock | 3579 | ;; Font lock |
| 3580 | 3580 | ||
| 3581 | (require 'font-lock) | ||
| 3582 | |||
| 3583 | ;; FIXME: The obsolete variables need to disappear. | 3581 | ;; FIXME: The obsolete variables need to disappear. |
| 3584 | 3582 | ||
| 3585 | ;; The following versions have been done inside Emacs and should not be | 3583 | ;; The following versions have been done inside Emacs and should not be |
diff --git a/lisp/textmodes/table.el b/lisp/textmodes/table.el index 25aa58046f4..065fdd09ccb 100644 --- a/lisp/textmodes/table.el +++ b/lisp/textmodes/table.el | |||
| @@ -3270,34 +3270,33 @@ Currently this method is for LaTeX only." | |||
| 3270 | (let* ((span 1) ;; spanning length | 3270 | (let* ((span 1) ;; spanning length |
| 3271 | (first-p t) ;; first in a row | 3271 | (first-p t) ;; first in a row |
| 3272 | (insert-column ;; a function that processes one column/multicolumn | 3272 | (insert-column ;; a function that processes one column/multicolumn |
| 3273 | (function | 3273 | (lambda (from to) |
| 3274 | (lambda (from to) | 3274 | (let ((line (table--buffer-substring-and-trim |
| 3275 | (let ((line (table--buffer-substring-and-trim | 3275 | (table--goto-coordinate (cons from y)) |
| 3276 | (table--goto-coordinate (cons from y)) | 3276 | (table--goto-coordinate (cons to y))))) |
| 3277 | (table--goto-coordinate (cons to y))))) | 3277 | ;; escape special characters |
| 3278 | ;; escape special characters | 3278 | (with-temp-buffer |
| 3279 | (with-temp-buffer | 3279 | (insert line) |
| 3280 | (insert line) | 3280 | (goto-char (point-min)) |
| 3281 | (goto-char (point-min)) | 3281 | (while (re-search-forward "\\([#$~_^%{}&]\\)\\|\\(\\\\\\)\\|\\([<>|]\\)" nil t) |
| 3282 | (while (re-search-forward "\\([#$~_^%{}&]\\)\\|\\(\\\\\\)\\|\\([<>|]\\)" nil t) | 3282 | (if (match-beginning 1) |
| 3283 | (if (match-beginning 1) | 3283 | (save-excursion |
| 3284 | (save-excursion | 3284 | (goto-char (match-beginning 1)) |
| 3285 | (goto-char (match-beginning 1)) | 3285 | (insert "\\")) |
| 3286 | (insert "\\")) | 3286 | (if (match-beginning 2) |
| 3287 | (if (match-beginning 2) | 3287 | (replace-match "$\\backslash$" t t) |
| 3288 | (replace-match "$\\backslash$" t t) | 3288 | (replace-match (concat "$" (match-string 3) "$")) t t))) |
| 3289 | (replace-match (concat "$" (match-string 3) "$")) t t))) | 3289 | (setq line (buffer-substring (point-min) (point-max)))) |
| 3290 | (setq line (buffer-substring (point-min) (point-max)))) | 3290 | ;; insert a column separator and column/multicolumn contents |
| 3291 | ;; insert a column separator and column/multicolumn contents | 3291 | (with-current-buffer dest-buffer |
| 3292 | (with-current-buffer dest-buffer | 3292 | (unless first-p |
| 3293 | (unless first-p | 3293 | (insert (if (eq (char-before) ?\s) "" " ") "& ")) |
| 3294 | (insert (if (eq (char-before) ?\s) "" " ") "& ")) | 3294 | (if (> span 1) |
| 3295 | (if (> span 1) | 3295 | (insert (format "\\multicolumn{%d}{%sl|}{%s}" span (if first-p "|" "") line)) |
| 3296 | (insert (format "\\multicolumn{%d}{%sl|}{%s}" span (if first-p "|" "") line)) | 3296 | (insert line))) |
| 3297 | (insert line))) | 3297 | (setq first-p nil) |
| 3298 | (setq first-p nil) | 3298 | (setq span 1) |
| 3299 | (setq span 1) | 3299 | (setq start (nth i col-list)))))) |
| 3300 | (setq start (nth i col-list))))))) | ||
| 3301 | (setq start x0) | 3300 | (setq start x0) |
| 3302 | (setq i 1) | 3301 | (setq i 1) |
| 3303 | (while (setq c (nth i border-char-list)) | 3302 | (while (setq c (nth i border-char-list)) |
diff --git a/lisp/time-stamp.el b/lisp/time-stamp.el index 7c64f2903be..c50d68b60af 100644 --- a/lisp/time-stamp.el +++ b/lisp/time-stamp.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; time-stamp.el --- Maintain last change time stamps in files edited by Emacs | 1 | ;;; time-stamp.el --- Maintain last change time stamps in files edited by Emacs -*- lexical-binding: t -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1989, 1993-1995, 1997, 2000-2020 Free Software | 3 | ;; Copyright (C) 1989, 1993-1995, 1997, 2000-2020 Free Software |
| 4 | ;; Foundation, Inc. | 4 | ;; Foundation, Inc. |
| @@ -87,7 +87,6 @@ transitional behavior (again, as shown). | |||
| 87 | The behavior of `%5z' is new in Emacs 27. If your files might be | 87 | The behavior of `%5z' is new in Emacs 27. If your files might be |
| 88 | edited by older versions of Emacs also, do not use this format yet." | 88 | edited by older versions of Emacs also, do not use this format yet." |
| 89 | :type 'string | 89 | :type 'string |
| 90 | :group 'time-stamp | ||
| 91 | :version "27.1") | 90 | :version "27.1") |
| 92 | ;;;###autoload(put 'time-stamp-format 'safe-local-variable 'stringp) | 91 | ;;;###autoload(put 'time-stamp-format 'safe-local-variable 'stringp) |
| 93 | 92 | ||
| @@ -102,8 +101,7 @@ when they are saved, either add this line to your init file: | |||
| 102 | or customize option `before-save-hook'. | 101 | or customize option `before-save-hook'. |
| 103 | 102 | ||
| 104 | See also the variable `time-stamp-warn-inactive'." | 103 | See also the variable `time-stamp-warn-inactive'." |
| 105 | :type 'boolean | 104 | :type 'boolean) |
| 106 | :group 'time-stamp) | ||
| 107 | 105 | ||
| 108 | (defcustom time-stamp-warn-inactive t | 106 | (defcustom time-stamp-warn-inactive t |
| 109 | "Have \\[time-stamp] warn if a buffer did not get time-stamped. | 107 | "Have \\[time-stamp] warn if a buffer did not get time-stamped. |
| @@ -111,7 +109,6 @@ If non-nil, a warning is displayed if `time-stamp-active' has | |||
| 111 | deactivated time stamping and the buffer contains a template that | 109 | deactivated time stamping and the buffer contains a template that |
| 112 | otherwise would have been updated." | 110 | otherwise would have been updated." |
| 113 | :type 'boolean | 111 | :type 'boolean |
| 114 | :group 'time-stamp | ||
| 115 | :version "19.29") | 112 | :version "19.29") |
| 116 | 113 | ||
| 117 | (defcustom time-stamp-time-zone nil | 114 | (defcustom time-stamp-time-zone nil |
| @@ -125,7 +122,6 @@ Its format is that of the ZONE argument of the `format-time-string' function." | |||
| 125 | (integer :tag "Offset (seconds east of UTC)") | 122 | (integer :tag "Offset (seconds east of UTC)") |
| 126 | (string :tag "Time zone abbreviation")) | 123 | (string :tag "Time zone abbreviation")) |
| 127 | (integer :tag "Offset (seconds east of UTC)")) | 124 | (integer :tag "Offset (seconds east of UTC)")) |
| 128 | :group 'time-stamp | ||
| 129 | :version "20.1") | 125 | :version "20.1") |
| 130 | ;;;###autoload(put 'time-stamp-time-zone 'safe-local-variable 'time-stamp-zone-type-p) | 126 | ;;;###autoload(put 'time-stamp-time-zone 'safe-local-variable 'time-stamp-zone-type-p) |
| 131 | 127 | ||
diff --git a/lisp/url/url-auth.el b/lisp/url/url-auth.el index fd800cd9782..bcb48aa455d 100644 --- a/lisp/url/url-auth.el +++ b/lisp/url/url-auth.el | |||
| @@ -23,7 +23,6 @@ | |||
| 23 | 23 | ||
| 24 | (require 'url-vars) | 24 | (require 'url-vars) |
| 25 | (require 'url-parse) | 25 | (require 'url-parse) |
| 26 | (autoload 'url-warn "url") | ||
| 27 | (autoload 'auth-source-search "auth-source") | 26 | (autoload 'auth-source-search "auth-source") |
| 28 | 27 | ||
| 29 | (defsubst url-auth-user-prompt (url realm) | 28 | (defsubst url-auth-user-prompt (url realm) |
| @@ -540,7 +539,7 @@ RATING a rating between 1 and 10 of the strength of the authentication. | |||
| 540 | (t rating))) | 539 | (t rating))) |
| 541 | (node (assoc type url-registered-auth-schemes))) | 540 | (node (assoc type url-registered-auth-schemes))) |
| 542 | (if (not (fboundp function)) | 541 | (if (not (fboundp function)) |
| 543 | (url-warn | 542 | (display-warning |
| 544 | 'security | 543 | 'security |
| 545 | (format-message | 544 | (format-message |
| 546 | "Tried to register `%s' as an auth scheme, but it is not a function!" | 545 | "Tried to register `%s' as an auth scheme, but it is not a function!" |
diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el index 8532da1d1fb..75330d33277 100644 --- a/lisp/url/url-http.el +++ b/lisp/url/url-http.el | |||
| @@ -1119,9 +1119,7 @@ the end of the document." | |||
| 1119 | (beginning-of-line) | 1119 | (beginning-of-line) |
| 1120 | (looking-at regexp)) | 1120 | (looking-at regexp)) |
| 1121 | (add-text-properties (match-beginning 0) (match-end 0) | 1121 | (add-text-properties (match-beginning 0) (match-end 0) |
| 1122 | (list 'start-open t | 1122 | (list 'chunked-encoding t |
| 1123 | 'end-open t | ||
| 1124 | 'chunked-encoding t | ||
| 1125 | 'face 'cursor | 1123 | 'face 'cursor |
| 1126 | 'invisible t)) | 1124 | 'invisible t)) |
| 1127 | (setq url-http-chunked-length (string-to-number (buffer-substring | 1125 | (setq url-http-chunked-length (string-to-number (buffer-substring |
diff --git a/lisp/url/url-news.el b/lisp/url/url-news.el index 9ef17cccd77..78a6aa94839 100644 --- a/lisp/url/url-news.el +++ b/lisp/url/url-news.el | |||
| @@ -25,7 +25,6 @@ | |||
| 25 | (require 'url-util) | 25 | (require 'url-util) |
| 26 | (require 'url-parse) | 26 | (require 'url-parse) |
| 27 | (require 'nntp) | 27 | (require 'nntp) |
| 28 | (autoload 'url-warn "url") | ||
| 29 | (autoload 'gnus-group-read-ephemeral-group "gnus-group") | 28 | (autoload 'gnus-group-read-ephemeral-group "gnus-group") |
| 30 | 29 | ||
| 31 | ;; Unused. | 30 | ;; Unused. |
| @@ -42,7 +41,7 @@ | |||
| 42 | (nntp-send-command "^.*\r?\n" "AUTHINFO USER" user) | 41 | (nntp-send-command "^.*\r?\n" "AUTHINFO USER" user) |
| 43 | (nntp-send-command "^.*\r?\n" "AUTHINFO PASS" pass) | 42 | (nntp-send-command "^.*\r?\n" "AUTHINFO PASS" pass) |
| 44 | (if (not (nntp-server-opened host)) | 43 | (if (not (nntp-server-opened host)) |
| 45 | (url-warn 'url (format "NNTP authentication to `%s' as `%s' failed" | 44 | (display-warning 'url (format "NNTP authentication to `%s' as `%s' failed" |
| 46 | host user)))))) | 45 | host user)))))) |
| 47 | 46 | ||
| 48 | (defun url-news-fetch-message-id (host message-id) | 47 | (defun url-news-fetch-message-id (host message-id) |
diff --git a/lisp/url/url-proxy.el b/lisp/url/url-proxy.el index 9513c3973a1..698a87098ba 100644 --- a/lisp/url/url-proxy.el +++ b/lisp/url/url-proxy.el | |||
| @@ -22,7 +22,6 @@ | |||
| 22 | ;;; Code: | 22 | ;;; Code: |
| 23 | 23 | ||
| 24 | (require 'url-parse) | 24 | (require 'url-parse) |
| 25 | (autoload 'url-warn "url") | ||
| 26 | 25 | ||
| 27 | (defun url-default-find-proxy-for-url (urlobj host) | 26 | (defun url-default-find-proxy-for-url (urlobj host) |
| 28 | (cond | 27 | (cond |
| @@ -60,7 +59,7 @@ | |||
| 60 | ((string-match "^socks +" proxy) | 59 | ((string-match "^socks +" proxy) |
| 61 | (concat "socks://" (substring proxy (match-end 0)))) | 60 | (concat "socks://" (substring proxy (match-end 0)))) |
| 62 | (t | 61 | (t |
| 63 | (url-warn 'url (format "Unknown proxy directive: %s" proxy) 'critical) | 62 | (display-warning 'url (format "Unknown proxy directive: %s" proxy) 'critical) |
| 64 | nil)))) | 63 | nil)))) |
| 65 | 64 | ||
| 66 | (autoload 'url-http "url-http") | 65 | (autoload 'url-http "url-http") |
diff --git a/lisp/url/url.el b/lisp/url/url.el index 33a5ebcdccc..5188007a58b 100644 --- a/lisp/url/url.el +++ b/lisp/url/url.el | |||
| @@ -365,19 +365,7 @@ how long to wait for a response before giving up." | |||
| 365 | (if (buffer-live-p buff) | 365 | (if (buffer-live-p buff) |
| 366 | (kill-buffer buff))))) | 366 | (kill-buffer buff))))) |
| 367 | 367 | ||
| 368 | (cond | 368 | (define-obsolete-function-alias 'url-warn #'display-warning "28.1") |
| 369 | ((fboundp 'display-warning) | ||
| 370 | (defalias 'url-warn 'display-warning)) | ||
| 371 | ((fboundp 'warn) | ||
| 372 | (defun url-warn (class message &optional level) | ||
| 373 | (warn "(%s/%s) %s" class (or level 'warning) message))) | ||
| 374 | (t | ||
| 375 | (defun url-warn (class message &optional level) | ||
| 376 | (with-current-buffer (get-buffer-create "*URL-WARNINGS*") | ||
| 377 | (goto-char (point-max)) | ||
| 378 | (save-excursion | ||
| 379 | (insert (format "(%s/%s) %s\n" class (or level 'warning) message))) | ||
| 380 | (display-buffer (current-buffer)))))) | ||
| 381 | 369 | ||
| 382 | (provide 'url) | 370 | (provide 'url) |
| 383 | 371 | ||
diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 5aeb8feb990..0a906136047 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el | |||
| @@ -403,7 +403,8 @@ well." | |||
| 403 | '((((class color)) | 403 | '((((class color)) |
| 404 | :foreground "red" :background "black" :weight bold) | 404 | :foreground "red" :background "black" :weight bold) |
| 405 | (t :weight bold)) | 405 | (t :weight bold)) |
| 406 | "`diff-mode' face for error messages from diff.") | 406 | "`diff-mode' face for error messages from diff." |
| 407 | :version "28.1") | ||
| 407 | 408 | ||
| 408 | (defconst diff-yank-handler '(diff-yank-function)) | 409 | (defconst diff-yank-handler '(diff-yank-function)) |
| 409 | (defun diff-yank-function (text) | 410 | (defun diff-yank-function (text) |
diff --git a/lisp/vc/ediff-wind.el b/lisp/vc/ediff-wind.el index a23d72070ab..c68dc718843 100644 --- a/lisp/vc/ediff-wind.el +++ b/lisp/vc/ediff-wind.el | |||
| @@ -42,13 +42,6 @@ | |||
| 42 | (require 'ediff-help) | 42 | (require 'ediff-help) |
| 43 | ;; end pacifier | 43 | ;; end pacifier |
| 44 | 44 | ||
| 45 | |||
| 46 | ;; be careful with ediff-tbar | ||
| 47 | (eval-and-compile | ||
| 48 | (if (featurep 'xemacs) | ||
| 49 | (require 'ediff-tbar) | ||
| 50 | (defun ediff-compute-toolbar-width () 0))) | ||
| 51 | |||
| 52 | (defgroup ediff-window nil | 45 | (defgroup ediff-window nil |
| 53 | "Ediff window manipulation." | 46 | "Ediff window manipulation." |
| 54 | :prefix "ediff-" | 47 | :prefix "ediff-" |
| @@ -961,8 +954,7 @@ create a new splittable frame if none is found." | |||
| 961 | ;; 1 more line for the mode line | 954 | ;; 1 more line for the mode line |
| 962 | (setq lines (1+ (count-lines (point-min) (point-max))) | 955 | (setq lines (1+ (count-lines (point-min) (point-max))) |
| 963 | fheight lines | 956 | fheight lines |
| 964 | fwidth (max (+ (ediff-help-message-line-length) 2) | 957 | fwidth (max (+ (ediff-help-message-line-length) 2) 0) |
| 965 | (ediff-compute-toolbar-width)) | ||
| 966 | adjusted-parameters | 958 | adjusted-parameters |
| 967 | (list | 959 | (list |
| 968 | ;; possibly change surrogate minibuffer | 960 | ;; possibly change surrogate minibuffer |
| @@ -1291,6 +1283,9 @@ It assumes that it is called from within the control buffer." | |||
| 1291 | (ediff-multiframe-setup-p) | 1283 | (ediff-multiframe-setup-p) |
| 1292 | ediff-wide-display-p))))))) | 1284 | ediff-wide-display-p))))))) |
| 1293 | 1285 | ||
| 1286 | (defun ediff-compute-toolbar-width () | ||
| 1287 | (declare (obsolete nil "28.1")) | ||
| 1288 | 0) | ||
| 1294 | 1289 | ||
| 1295 | (provide 'ediff-wind) | 1290 | (provide 'ediff-wind) |
| 1296 | ;;; ediff-wind.el ends here | 1291 | ;;; ediff-wind.el ends here |
diff --git a/nt/INSTALL b/nt/INSTALL index 2fe2c8c2673..27fb5f096f7 100644 --- a/nt/INSTALL +++ b/nt/INSTALL | |||
| @@ -502,11 +502,21 @@ build will run on Windows 9X and newer systems). | |||
| 502 | Does Emacs use -lgnutls? yes | 502 | Does Emacs use -lgnutls? yes |
| 503 | Does Emacs use -lxml2? yes | 503 | Does Emacs use -lxml2? yes |
| 504 | Does Emacs use -lfreetype? no | 504 | Does Emacs use -lfreetype? no |
| 505 | Does Emacs use HarfBuzz? yes | ||
| 505 | Does Emacs use -lm17n-flt? no | 506 | Does Emacs use -lm17n-flt? no |
| 506 | Does Emacs use -lotf? no | 507 | Does Emacs use -lotf? no |
| 507 | Does Emacs use -lxft? no | 508 | Does Emacs use -lxft? no |
| 509 | Does Emacs use -lsystemd? no | ||
| 510 | Does Emacs use -ljansson? yes | ||
| 511 | Does Emacs use the GMP library? yes | ||
| 508 | Does Emacs directly use zlib? yes | 512 | Does Emacs directly use zlib? yes |
| 513 | Does Emacs have dynamic modules support? yes | ||
| 509 | Does Emacs use toolkit scroll bars? yes | 514 | Does Emacs use toolkit scroll bars? yes |
| 515 | Does Emacs support Xwidgets? no | ||
| 516 | Does Emacs have threading support in lisp? yes | ||
| 517 | Does Emacs support the portable dumper? yes | ||
| 518 | Does Emacs support the legacy unexec dumping? no | ||
| 519 | Which dumping strategy does Emacs use? pdumper | ||
| 510 | 520 | ||
| 511 | You are almost there, hang on. | 521 | You are almost there, hang on. |
| 512 | 522 | ||
| @@ -815,6 +825,14 @@ build will run on Windows 9X and newer systems). | |||
| 815 | the libjansson DLL (for 32-bit builds of Emacs) are available from | 825 | the libjansson DLL (for 32-bit builds of Emacs) are available from |
| 816 | the ezwinports site and from the MSYS2 project. | 826 | the ezwinports site and from the MSYS2 project. |
| 817 | 827 | ||
| 828 | * Optional support for HarfBuzzz shaping library | ||
| 829 | |||
| 830 | Emacs supports display of complex scripts and Arabic shaping. The | ||
| 831 | preferred library for that is HarfBuzz; prebuilt binaries are | ||
| 832 | available from the ezwinports site (for 32-bit builds of Emacs) and | ||
| 833 | from the MSYS2 project. If HarfBuzz is not available, Emacs will | ||
| 834 | use the Uniscribe shaping engine that is part of MS-Windows. | ||
| 835 | |||
| 818 | 836 | ||
| 819 | This file is part of GNU Emacs. | 837 | This file is part of GNU Emacs. |
| 820 | 838 | ||
diff --git a/nt/INSTALL.W64 b/nt/INSTALL.W64 index 0a0e0330a24..4724116ebcc 100644 --- a/nt/INSTALL.W64 +++ b/nt/INSTALL.W64 | |||
| @@ -55,14 +55,16 @@ packages (you can copy and paste it into the shell with Shift + Insert): | |||
| 55 | mingw-w64-x86_64-jansson \ | 55 | mingw-w64-x86_64-jansson \ |
| 56 | mingw-w64-x86_64-libxml2 \ | 56 | mingw-w64-x86_64-libxml2 \ |
| 57 | mingw-w64-x86_64-gnutls \ | 57 | mingw-w64-x86_64-gnutls \ |
| 58 | mingw-w64-x86_64-zlib | 58 | mingw-w64-x86_64-zlib \ |
| 59 | mingw-w64-x86_64-harfbuzz | ||
| 59 | 60 | ||
| 60 | The packages include the base developer tools (autoconf, grep, make, etc.), | 61 | The packages include the base developer tools (autoconf, grep, make, etc.), |
| 61 | the compiler toolchain (gcc, gdb, etc.), several image libraries, an XML | 62 | the compiler toolchain (gcc, gdb, etc.), several image libraries, an XML |
| 62 | library, the GnuTLS (transport layer security) library, and zlib for | 63 | library, the GnuTLS (transport layer security) library, zlib for |
| 63 | decompressing text. Only the first three packages are required (base-devel, | 64 | decompressing text, and HarfBuzz for use as the shaping engine. Only the |
| 64 | toolchain, xpm-nox); the rest are optional. You can select only part of the | 65 | first three packages are required (base-devel, toolchain, xpm-nox); the |
| 65 | libraries if you don't need them all. | 66 | rest are optional. You can select only part of the libraries if you don't |
| 67 | need them all. | ||
| 66 | 68 | ||
| 67 | You now have a complete build environment for Emacs. | 69 | You now have a complete build environment for Emacs. |
| 68 | 70 | ||
diff --git a/src/buffer.c b/src/buffer.c index 4fd2b0c8b17..360dd348e05 100644 --- a/src/buffer.c +++ b/src/buffer.c | |||
| @@ -297,11 +297,6 @@ bset_mark (struct buffer *b, Lisp_Object val) | |||
| 297 | b->mark_ = val; | 297 | b->mark_ = val; |
| 298 | } | 298 | } |
| 299 | static void | 299 | static void |
| 300 | bset_minor_modes (struct buffer *b, Lisp_Object val) | ||
| 301 | { | ||
| 302 | b->minor_modes_ = val; | ||
| 303 | } | ||
| 304 | static void | ||
| 305 | bset_mode_line_format (struct buffer *b, Lisp_Object val) | 300 | bset_mode_line_format (struct buffer *b, Lisp_Object val) |
| 306 | { | 301 | { |
| 307 | b->mode_line_format_ = val; | 302 | b->mode_line_format_ = val; |
| @@ -1004,7 +999,6 @@ reset_buffer_local_variables (struct buffer *b, bool permanent_too) | |||
| 1004 | bset_major_mode (b, Qfundamental_mode); | 999 | bset_major_mode (b, Qfundamental_mode); |
| 1005 | bset_keymap (b, Qnil); | 1000 | bset_keymap (b, Qnil); |
| 1006 | bset_mode_name (b, QSFundamental); | 1001 | bset_mode_name (b, QSFundamental); |
| 1007 | bset_minor_modes (b, Qnil); | ||
| 1008 | 1002 | ||
| 1009 | /* If the standard case table has been altered and invalidated, | 1003 | /* If the standard case table has been altered and invalidated, |
| 1010 | fix up its insides first. */ | 1004 | fix up its insides first. */ |
| @@ -5180,7 +5174,6 @@ init_buffer_once (void) | |||
| 5180 | bset_upcase_table (&buffer_local_flags, make_fixnum (0)); | 5174 | bset_upcase_table (&buffer_local_flags, make_fixnum (0)); |
| 5181 | bset_case_canon_table (&buffer_local_flags, make_fixnum (0)); | 5175 | bset_case_canon_table (&buffer_local_flags, make_fixnum (0)); |
| 5182 | bset_case_eqv_table (&buffer_local_flags, make_fixnum (0)); | 5176 | bset_case_eqv_table (&buffer_local_flags, make_fixnum (0)); |
| 5183 | bset_minor_modes (&buffer_local_flags, make_fixnum (0)); | ||
| 5184 | bset_width_table (&buffer_local_flags, make_fixnum (0)); | 5177 | bset_width_table (&buffer_local_flags, make_fixnum (0)); |
| 5185 | bset_pt_marker (&buffer_local_flags, make_fixnum (0)); | 5178 | bset_pt_marker (&buffer_local_flags, make_fixnum (0)); |
| 5186 | bset_begv_marker (&buffer_local_flags, make_fixnum (0)); | 5179 | bset_begv_marker (&buffer_local_flags, make_fixnum (0)); |
diff --git a/src/buffer.h b/src/buffer.h index 3da49414bb8..fe549c5dac1 100644 --- a/src/buffer.h +++ b/src/buffer.h | |||
| @@ -419,9 +419,6 @@ struct buffer | |||
| 419 | /* Non-nil means show ... at end of line followed by invisible lines. */ | 419 | /* Non-nil means show ... at end of line followed by invisible lines. */ |
| 420 | Lisp_Object selective_display_ellipses_; | 420 | Lisp_Object selective_display_ellipses_; |
| 421 | 421 | ||
| 422 | /* Alist of (FUNCTION . STRING) for each minor mode enabled in buffer. */ | ||
| 423 | Lisp_Object minor_modes_; | ||
| 424 | |||
| 425 | /* t if "self-insertion" should overwrite; `binary' if it should also | 422 | /* t if "self-insertion" should overwrite; `binary' if it should also |
| 426 | overwrite newlines and tabs - for editing executables and the like. */ | 423 | overwrite newlines and tabs - for editing executables and the like. */ |
| 427 | Lisp_Object overwrite_mode_; | 424 | Lisp_Object overwrite_mode_; |
diff --git a/src/data.c b/src/data.c index c6629dd5f29..1435cb03779 100644 --- a/src/data.c +++ b/src/data.c | |||
| @@ -1501,10 +1501,14 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where, | |||
| 1501 | { | 1501 | { |
| 1502 | int offset = XBUFFER_OBJFWD (innercontents)->offset; | 1502 | int offset = XBUFFER_OBJFWD (innercontents)->offset; |
| 1503 | int idx = PER_BUFFER_IDX (offset); | 1503 | int idx = PER_BUFFER_IDX (offset); |
| 1504 | if (idx > 0 | 1504 | if (idx > 0 && bindflag == SET_INTERNAL_SET |
| 1505 | && bindflag == SET_INTERNAL_SET | 1505 | && !PER_BUFFER_VALUE_P (buf, idx)) |
| 1506 | && !let_shadows_buffer_binding_p (sym)) | 1506 | { |
| 1507 | SET_PER_BUFFER_VALUE_P (buf, idx, 1); | 1507 | if (let_shadows_buffer_binding_p (sym)) |
| 1508 | set_default_internal (symbol, newval, bindflag); | ||
| 1509 | else | ||
| 1510 | SET_PER_BUFFER_VALUE_P (buf, idx, 1); | ||
| 1511 | } | ||
| 1508 | } | 1512 | } |
| 1509 | 1513 | ||
| 1510 | if (voide) | 1514 | if (voide) |
diff --git a/src/dispnew.c b/src/dispnew.c index 479fccb45e0..89dd32ad0fb 100644 --- a/src/dispnew.c +++ b/src/dispnew.c | |||
| @@ -2558,11 +2558,15 @@ build_frame_matrix_from_leaf_window (struct glyph_matrix *frame_matrix, struct w | |||
| 2558 | the corresponding frame row to be updated. */ | 2558 | the corresponding frame row to be updated. */ |
| 2559 | frame_row->enabled_p = true; | 2559 | frame_row->enabled_p = true; |
| 2560 | 2560 | ||
| 2561 | /* Maybe insert a vertical border between horizontally adjacent | 2561 | /* Maybe insert a vertical border between horizontally adjacent |
| 2562 | windows. */ | 2562 | windows. */ |
| 2563 | if (GLYPH_CHAR (right_border_glyph) != 0) | 2563 | if (GLYPH_CHAR (right_border_glyph) != 0) |
| 2564 | { | 2564 | { |
| 2565 | struct glyph *border = window_row->glyphs[LAST_AREA] - 1; | 2565 | struct glyph *border = window_row->glyphs[LAST_AREA] - 1; |
| 2566 | /* It's a subtle bug if we are overwriting some non-char | ||
| 2567 | glyph with the vertical border glyph. */ | ||
| 2568 | eassert (border->type == CHAR_GLYPH); | ||
| 2569 | border->type = CHAR_GLYPH; | ||
| 2566 | SET_CHAR_GLYPH_FROM_GLYPH (*border, right_border_glyph); | 2570 | SET_CHAR_GLYPH_FROM_GLYPH (*border, right_border_glyph); |
| 2567 | } | 2571 | } |
| 2568 | 2572 | ||
| @@ -5502,25 +5502,32 @@ Case is always significant and text properties are ignored. */) | |||
| 5502 | haybytes = SBYTES (haystack) - start_byte; | 5502 | haybytes = SBYTES (haystack) - start_byte; |
| 5503 | 5503 | ||
| 5504 | /* We can do a direct byte-string search if both strings have the | 5504 | /* We can do a direct byte-string search if both strings have the |
| 5505 | same multibyteness, or if at least one of them consists of ASCII | 5505 | same multibyteness, or if the needle consists of ASCII characters only. */ |
| 5506 | characters only. */ | ||
| 5507 | if (STRING_MULTIBYTE (haystack) | 5506 | if (STRING_MULTIBYTE (haystack) |
| 5508 | ? (STRING_MULTIBYTE (needle) | 5507 | ? (STRING_MULTIBYTE (needle) |
| 5509 | || SCHARS (haystack) == SBYTES (haystack) || string_ascii_p (needle)) | 5508 | || SCHARS (haystack) == SBYTES (haystack) || string_ascii_p (needle)) |
| 5510 | : (!STRING_MULTIBYTE (needle) | 5509 | : (!STRING_MULTIBYTE (needle) |
| 5511 | || SCHARS (needle) == SBYTES (needle) || string_ascii_p (haystack))) | 5510 | || SCHARS (needle) == SBYTES (needle))) |
| 5512 | res = memmem (haystart, haybytes, | 5511 | { |
| 5513 | SSDATA (needle), SBYTES (needle)); | 5512 | if (STRING_MULTIBYTE (haystack) && STRING_MULTIBYTE (needle) |
| 5514 | else if (STRING_MULTIBYTE (haystack)) /* unibyte needle */ | 5513 | && SCHARS (haystack) == SBYTES (haystack) |
| 5514 | && SCHARS (needle) != SBYTES (needle)) | ||
| 5515 | /* Multibyte non-ASCII needle, multibyte ASCII haystack: impossible. */ | ||
| 5516 | return Qnil; | ||
| 5517 | else | ||
| 5518 | res = memmem (haystart, haybytes, | ||
| 5519 | SSDATA (needle), SBYTES (needle)); | ||
| 5520 | } | ||
| 5521 | else if (STRING_MULTIBYTE (haystack)) /* unibyte non-ASCII needle */ | ||
| 5515 | { | 5522 | { |
| 5516 | Lisp_Object multi_needle = string_to_multibyte (needle); | 5523 | Lisp_Object multi_needle = string_to_multibyte (needle); |
| 5517 | res = memmem (haystart, haybytes, | 5524 | res = memmem (haystart, haybytes, |
| 5518 | SSDATA (multi_needle), SBYTES (multi_needle)); | 5525 | SSDATA (multi_needle), SBYTES (multi_needle)); |
| 5519 | } | 5526 | } |
| 5520 | else /* unibyte haystack, multibyte needle */ | 5527 | else /* unibyte haystack, multibyte non-ASCII needle */ |
| 5521 | { | 5528 | { |
| 5522 | /* The only possible way we can find the multibyte needle in the | 5529 | /* The only possible way we can find the multibyte needle in the |
| 5523 | unibyte stack (since we know that neither are pure-ASCII) is | 5530 | unibyte stack (since we know that the needle is non-ASCII) is |
| 5524 | if they contain "raw bytes" (and no other non-ASCII chars.) */ | 5531 | if they contain "raw bytes" (and no other non-ASCII chars.) */ |
| 5525 | ptrdiff_t nbytes = SBYTES (needle); | 5532 | ptrdiff_t nbytes = SBYTES (needle); |
| 5526 | for (ptrdiff_t i = 0; i < nbytes; i++) | 5533 | for (ptrdiff_t i = 0; i < nbytes; i++) |
diff --git a/src/image.c b/src/image.c index 3858f3c41f3..5eb41322950 100644 --- a/src/image.c +++ b/src/image.c | |||
| @@ -9551,10 +9551,9 @@ DEF_DLL_FN (void, rsvg_handle_get_intrinsic_dimensions, | |||
| 9551 | DEF_DLL_FN (gboolean, rsvg_handle_get_geometry_for_layer, | 9551 | DEF_DLL_FN (gboolean, rsvg_handle_get_geometry_for_layer, |
| 9552 | (RsvgHandle *, const char *, const RsvgRectangle *, | 9552 | (RsvgHandle *, const char *, const RsvgRectangle *, |
| 9553 | RsvgRectangle *, RsvgRectangle *, GError **)); | 9553 | RsvgRectangle *, RsvgRectangle *, GError **)); |
| 9554 | # else | 9554 | # endif |
| 9555 | DEF_DLL_FN (void, rsvg_handle_get_dimensions, | 9555 | DEF_DLL_FN (void, rsvg_handle_get_dimensions, |
| 9556 | (RsvgHandle *, RsvgDimensionData *)); | 9556 | (RsvgHandle *, RsvgDimensionData *)); |
| 9557 | # endif | ||
| 9558 | DEF_DLL_FN (GdkPixbuf *, rsvg_handle_get_pixbuf, (RsvgHandle *)); | 9557 | DEF_DLL_FN (GdkPixbuf *, rsvg_handle_get_pixbuf, (RsvgHandle *)); |
| 9559 | DEF_DLL_FN (int, gdk_pixbuf_get_width, (const GdkPixbuf *)); | 9558 | DEF_DLL_FN (int, gdk_pixbuf_get_width, (const GdkPixbuf *)); |
| 9560 | DEF_DLL_FN (int, gdk_pixbuf_get_height, (const GdkPixbuf *)); | 9559 | DEF_DLL_FN (int, gdk_pixbuf_get_height, (const GdkPixbuf *)); |
| @@ -9604,9 +9603,8 @@ init_svg_functions (void) | |||
| 9604 | #if LIBRSVG_CHECK_VERSION (2, 46, 0) | 9603 | #if LIBRSVG_CHECK_VERSION (2, 46, 0) |
| 9605 | LOAD_DLL_FN (library, rsvg_handle_get_intrinsic_dimensions); | 9604 | LOAD_DLL_FN (library, rsvg_handle_get_intrinsic_dimensions); |
| 9606 | LOAD_DLL_FN (library, rsvg_handle_get_geometry_for_layer); | 9605 | LOAD_DLL_FN (library, rsvg_handle_get_geometry_for_layer); |
| 9607 | #else | ||
| 9608 | LOAD_DLL_FN (library, rsvg_handle_get_dimensions); | ||
| 9609 | #endif | 9606 | #endif |
| 9607 | LOAD_DLL_FN (library, rsvg_handle_get_dimensions); | ||
| 9610 | LOAD_DLL_FN (library, rsvg_handle_get_pixbuf); | 9608 | LOAD_DLL_FN (library, rsvg_handle_get_pixbuf); |
| 9611 | 9609 | ||
| 9612 | LOAD_DLL_FN (gdklib, gdk_pixbuf_get_width); | 9610 | LOAD_DLL_FN (gdklib, gdk_pixbuf_get_width); |
| @@ -9644,9 +9642,8 @@ init_svg_functions (void) | |||
| 9644 | # if LIBRSVG_CHECK_VERSION (2, 46, 0) | 9642 | # if LIBRSVG_CHECK_VERSION (2, 46, 0) |
| 9645 | # undef rsvg_handle_get_intrinsic_dimensions | 9643 | # undef rsvg_handle_get_intrinsic_dimensions |
| 9646 | # undef rsvg_handle_get_geometry_for_layer | 9644 | # undef rsvg_handle_get_geometry_for_layer |
| 9647 | # else | ||
| 9648 | # undef rsvg_handle_get_dimensions | ||
| 9649 | # endif | 9645 | # endif |
| 9646 | # undef rsvg_handle_get_dimensions | ||
| 9650 | # undef rsvg_handle_get_pixbuf | 9647 | # undef rsvg_handle_get_pixbuf |
| 9651 | # if LIBRSVG_CHECK_VERSION (2, 32, 0) | 9648 | # if LIBRSVG_CHECK_VERSION (2, 32, 0) |
| 9652 | # undef g_file_new_for_path | 9649 | # undef g_file_new_for_path |
| @@ -9677,9 +9674,8 @@ init_svg_functions (void) | |||
| 9677 | fn_rsvg_handle_get_intrinsic_dimensions | 9674 | fn_rsvg_handle_get_intrinsic_dimensions |
| 9678 | # define rsvg_handle_get_geometry_for_layer \ | 9675 | # define rsvg_handle_get_geometry_for_layer \ |
| 9679 | fn_rsvg_handle_get_geometry_for_layer | 9676 | fn_rsvg_handle_get_geometry_for_layer |
| 9680 | # else | ||
| 9681 | # define rsvg_handle_get_dimensions fn_rsvg_handle_get_dimensions | ||
| 9682 | # endif | 9677 | # endif |
| 9678 | # define rsvg_handle_get_dimensions fn_rsvg_handle_get_dimensions | ||
| 9683 | # define rsvg_handle_get_pixbuf fn_rsvg_handle_get_pixbuf | 9679 | # define rsvg_handle_get_pixbuf fn_rsvg_handle_get_pixbuf |
| 9684 | # if LIBRSVG_CHECK_VERSION (2, 32, 0) | 9680 | # if LIBRSVG_CHECK_VERSION (2, 32, 0) |
| 9685 | # define g_file_new_for_path fn_g_file_new_for_path | 9681 | # define g_file_new_for_path fn_g_file_new_for_path |
| @@ -9903,30 +9899,21 @@ svg_load_image (struct frame *f, struct image *img, char *contents, | |||
| 9903 | viewbox_width = viewbox.x + viewbox.width; | 9899 | viewbox_width = viewbox.x + viewbox.width; |
| 9904 | viewbox_height = viewbox.y + viewbox.height; | 9900 | viewbox_height = viewbox.y + viewbox.height; |
| 9905 | } | 9901 | } |
| 9906 | #else | ||
| 9907 | /* The function used above to get the geometry of the visible area | ||
| 9908 | of the SVG are only available in librsvg 2.46 and above, so in | ||
| 9909 | certain circumstances this code path can result in some parts of | ||
| 9910 | the SVG being cropped. */ | ||
| 9911 | RsvgDimensionData dimension_data; | ||
| 9912 | 9902 | ||
| 9913 | rsvg_handle_get_dimensions (rsvg_handle, &dimension_data); | 9903 | if (viewbox_width == 0 || viewbox_height == 0) |
| 9914 | |||
| 9915 | viewbox_width = dimension_data.width; | ||
| 9916 | viewbox_height = dimension_data.height; | ||
| 9917 | #endif | 9904 | #endif |
| 9905 | { | ||
| 9906 | /* The functions used above to get the geometry of the visible | ||
| 9907 | area of the SVG are only available in librsvg 2.46 and above, | ||
| 9908 | so in certain circumstances this code path can result in some | ||
| 9909 | parts of the SVG being cropped. */ | ||
| 9910 | RsvgDimensionData dimension_data; | ||
| 9918 | 9911 | ||
| 9919 | if (viewbox_width == 0 || viewbox_height == 0) | 9912 | rsvg_handle_get_dimensions (rsvg_handle, &dimension_data); |
| 9920 | { | 9913 | |
| 9921 | /* We do not have any usable dimensions, so make some up. The | 9914 | viewbox_width = dimension_data.width; |
| 9922 | values below are supposedly the default values most web | 9915 | viewbox_height = dimension_data.height; |
| 9923 | browsers use for SVGs with no set size. */ | 9916 | } |
| 9924 | /* FIXME: At this stage we should perhaps consider rendering the | ||
| 9925 | image out to a bitmap and getting the dimensions from | ||
| 9926 | that. */ | ||
| 9927 | viewbox_width = 300; | ||
| 9928 | viewbox_height = 150; | ||
| 9929 | } | ||
| 9930 | 9917 | ||
| 9931 | compute_image_size (viewbox_width, viewbox_height, img->spec, | 9918 | compute_image_size (viewbox_width, viewbox_height, img->spec, |
| 9932 | &width, &height); | 9919 | &width, &height); |
diff --git a/src/keyboard.c b/src/keyboard.c index 49a0a8bd236..49261fcc3e8 100644 --- a/src/keyboard.c +++ b/src/keyboard.c | |||
| @@ -2122,7 +2122,7 @@ read_char_help_form_unwind (void) | |||
| 2122 | Lisp_Object window_config = XCAR (help_form_saved_window_configs); | 2122 | Lisp_Object window_config = XCAR (help_form_saved_window_configs); |
| 2123 | help_form_saved_window_configs = XCDR (help_form_saved_window_configs); | 2123 | help_form_saved_window_configs = XCDR (help_form_saved_window_configs); |
| 2124 | if (!NILP (window_config)) | 2124 | if (!NILP (window_config)) |
| 2125 | Fset_window_configuration (window_config); | 2125 | Fset_window_configuration (window_config, Qnil); |
| 2126 | } | 2126 | } |
| 2127 | 2127 | ||
| 2128 | #define STOP_POLLING \ | 2128 | #define STOP_POLLING \ |
| @@ -3736,9 +3736,6 @@ discard_mouse_events (void) | |||
| 3736 | if (sp->kind == MOUSE_CLICK_EVENT | 3736 | if (sp->kind == MOUSE_CLICK_EVENT |
| 3737 | || sp->kind == WHEEL_EVENT | 3737 | || sp->kind == WHEEL_EVENT |
| 3738 | || sp->kind == HORIZ_WHEEL_EVENT | 3738 | || sp->kind == HORIZ_WHEEL_EVENT |
| 3739 | #ifdef HAVE_GPM | ||
| 3740 | || sp->kind == GPM_CLICK_EVENT | ||
| 3741 | #endif | ||
| 3742 | || sp->kind == SCROLL_BAR_CLICK_EVENT | 3739 | || sp->kind == SCROLL_BAR_CLICK_EVENT |
| 3743 | || sp->kind == HORIZONTAL_SCROLL_BAR_CLICK_EVENT) | 3740 | || sp->kind == HORIZONTAL_SCROLL_BAR_CLICK_EVENT) |
| 3744 | { | 3741 | { |
| @@ -5542,9 +5539,6 @@ make_lispy_event (struct input_event *event) | |||
| 5542 | /* A mouse click. Figure out where it is, decide whether it's | 5539 | /* A mouse click. Figure out where it is, decide whether it's |
| 5543 | a press, click or drag, and build the appropriate structure. */ | 5540 | a press, click or drag, and build the appropriate structure. */ |
| 5544 | case MOUSE_CLICK_EVENT: | 5541 | case MOUSE_CLICK_EVENT: |
| 5545 | #ifdef HAVE_GPM | ||
| 5546 | case GPM_CLICK_EVENT: | ||
| 5547 | #endif | ||
| 5548 | #ifndef USE_TOOLKIT_SCROLL_BARS | 5542 | #ifndef USE_TOOLKIT_SCROLL_BARS |
| 5549 | case SCROLL_BAR_CLICK_EVENT: | 5543 | case SCROLL_BAR_CLICK_EVENT: |
| 5550 | case HORIZONTAL_SCROLL_BAR_CLICK_EVENT: | 5544 | case HORIZONTAL_SCROLL_BAR_CLICK_EVENT: |
| @@ -5559,11 +5553,7 @@ make_lispy_event (struct input_event *event) | |||
| 5559 | position = Qnil; | 5553 | position = Qnil; |
| 5560 | 5554 | ||
| 5561 | /* Build the position as appropriate for this mouse click. */ | 5555 | /* Build the position as appropriate for this mouse click. */ |
| 5562 | if (event->kind == MOUSE_CLICK_EVENT | 5556 | if (event->kind == MOUSE_CLICK_EVENT) |
| 5563 | #ifdef HAVE_GPM | ||
| 5564 | || event->kind == GPM_CLICK_EVENT | ||
| 5565 | #endif | ||
| 5566 | ) | ||
| 5567 | { | 5557 | { |
| 5568 | struct frame *f = XFRAME (event->frame_or_window); | 5558 | struct frame *f = XFRAME (event->frame_or_window); |
| 5569 | int row, column; | 5559 | int row, column; |
diff --git a/src/keymap.c b/src/keymap.c index 181dcdad3ad..e22eb411f63 100644 --- a/src/keymap.c +++ b/src/keymap.c | |||
| @@ -3085,6 +3085,7 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix, Lisp_Object args, | |||
| 3085 | for (i = from; ; i++) | 3085 | for (i = from; ; i++) |
| 3086 | { | 3086 | { |
| 3087 | bool this_shadowed = 0; | 3087 | bool this_shadowed = 0; |
| 3088 | Lisp_Object shadowed_by = Qnil; | ||
| 3088 | int range_beg, range_end; | 3089 | int range_beg, range_end; |
| 3089 | Lisp_Object val; | 3090 | Lisp_Object val; |
| 3090 | 3091 | ||
| @@ -3127,11 +3128,9 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix, Lisp_Object args, | |||
| 3127 | /* If this binding is shadowed by some other map, ignore it. */ | 3128 | /* If this binding is shadowed by some other map, ignore it. */ |
| 3128 | if (!NILP (shadow)) | 3129 | if (!NILP (shadow)) |
| 3129 | { | 3130 | { |
| 3130 | Lisp_Object tem; | 3131 | shadowed_by = shadow_lookup (shadow, kludge, Qt, 0); |
| 3131 | |||
| 3132 | tem = shadow_lookup (shadow, kludge, Qt, 0); | ||
| 3133 | 3132 | ||
| 3134 | if (!NILP (tem)) | 3133 | if (!NILP (shadowed_by) && !EQ (shadowed_by, definition)) |
| 3135 | { | 3134 | { |
| 3136 | if (mention_shadow) | 3135 | if (mention_shadow) |
| 3137 | this_shadowed = 1; | 3136 | this_shadowed = 1; |
| @@ -3186,6 +3185,21 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix, Lisp_Object args, | |||
| 3186 | && !NILP (Fequal (tem2, definition))) | 3185 | && !NILP (Fequal (tem2, definition))) |
| 3187 | i++; | 3186 | i++; |
| 3188 | 3187 | ||
| 3188 | /* Make sure found consecutive keys are either not shadowed or, | ||
| 3189 | if they are, that they are shadowed by the same command. */ | ||
| 3190 | if (CHAR_TABLE_P (vector) && i != starting_i) | ||
| 3191 | { | ||
| 3192 | Lisp_Object tem; | ||
| 3193 | Lisp_Object key = make_nil_vector (1); | ||
| 3194 | for (int j = starting_i + 1; j <= i; j++) | ||
| 3195 | { | ||
| 3196 | ASET (key, 0, make_fixnum (j)); | ||
| 3197 | tem = shadow_lookup (shadow, key, Qt, 0); | ||
| 3198 | if (NILP (Fequal (tem, shadowed_by))) | ||
| 3199 | i = j - 1; | ||
| 3200 | } | ||
| 3201 | } | ||
| 3202 | |||
| 3189 | /* If we have a range of more than one character, | 3203 | /* If we have a range of more than one character, |
| 3190 | print where the range reaches to. */ | 3204 | print where the range reaches to. */ |
| 3191 | 3205 | ||
| @@ -3209,7 +3223,13 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix, Lisp_Object args, | |||
| 3209 | if (this_shadowed) | 3223 | if (this_shadowed) |
| 3210 | { | 3224 | { |
| 3211 | SET_PT (PT - 1); | 3225 | SET_PT (PT - 1); |
| 3212 | insert_string (" (binding currently shadowed)"); | 3226 | static char const fmt[] = " (currently shadowed by `%s')"; |
| 3227 | USE_SAFE_ALLOCA; | ||
| 3228 | char *buffer = SAFE_ALLOCA (sizeof fmt + | ||
| 3229 | SBYTES (SYMBOL_NAME (shadowed_by))); | ||
| 3230 | esprintf (buffer, fmt, SDATA (SYMBOL_NAME (shadowed_by))); | ||
| 3231 | insert_string (buffer); | ||
| 3232 | SAFE_FREE(); | ||
| 3213 | SET_PT (PT + 1); | 3233 | SET_PT (PT + 1); |
| 3214 | } | 3234 | } |
| 3215 | } | 3235 | } |
diff --git a/src/minibuf.c b/src/minibuf.c index c4adca15365..464e3018f7d 100644 --- a/src/minibuf.c +++ b/src/minibuf.c | |||
| @@ -501,14 +501,15 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, | |||
| 501 | record_unwind_protect_void (choose_minibuf_frame); | 501 | record_unwind_protect_void (choose_minibuf_frame); |
| 502 | 502 | ||
| 503 | record_unwind_protect (restore_window_configuration, | 503 | record_unwind_protect (restore_window_configuration, |
| 504 | Fcurrent_window_configuration (Qnil)); | 504 | Fcons (Qt, Fcurrent_window_configuration (Qnil))); |
| 505 | 505 | ||
| 506 | /* If the minibuffer window is on a different frame, save that | 506 | /* If the minibuffer window is on a different frame, save that |
| 507 | frame's configuration too. */ | 507 | frame's configuration too. */ |
| 508 | mini_frame = WINDOW_FRAME (XWINDOW (minibuf_window)); | 508 | mini_frame = WINDOW_FRAME (XWINDOW (minibuf_window)); |
| 509 | if (!EQ (mini_frame, selected_frame)) | 509 | if (!EQ (mini_frame, selected_frame)) |
| 510 | record_unwind_protect (restore_window_configuration, | 510 | record_unwind_protect (restore_window_configuration, |
| 511 | Fcurrent_window_configuration (mini_frame)); | 511 | Fcons (Qt, |
| 512 | Fcurrent_window_configuration (mini_frame))); | ||
| 512 | 513 | ||
| 513 | /* If the minibuffer is on an iconified or invisible frame, | 514 | /* If the minibuffer is on an iconified or invisible frame, |
| 514 | make it visible now. */ | 515 | make it visible now. */ |
diff --git a/src/term.c b/src/term.c index a0738594bfc..fee3b555751 100644 --- a/src/term.c +++ b/src/term.c | |||
| @@ -2481,7 +2481,7 @@ term_mouse_click (struct input_event *result, Gpm_Event *event, | |||
| 2481 | { | 2481 | { |
| 2482 | int i, j; | 2482 | int i, j; |
| 2483 | 2483 | ||
| 2484 | result->kind = GPM_CLICK_EVENT; | 2484 | result->kind = MOUSE_CLICK_EVENT; |
| 2485 | for (i = 0, j = GPM_B_LEFT; i < 3; i++, j >>= 1 ) | 2485 | for (i = 0, j = GPM_B_LEFT; i < 3; i++, j >>= 1 ) |
| 2486 | { | 2486 | { |
| 2487 | if (event->buttons & j) { | 2487 | if (event->buttons & j) { |
| @@ -2567,11 +2567,11 @@ handle_one_term_event (struct tty_display_info *tty, Gpm_Event *event) | |||
| 2567 | { | 2567 | { |
| 2568 | f->mouse_moved = 0; | 2568 | f->mouse_moved = 0; |
| 2569 | term_mouse_click (&ie, event, f); | 2569 | term_mouse_click (&ie, event, f); |
| 2570 | /* eassert (ie.kind == GPM_CLICK_EVENT); */ | 2570 | /* eassert (ie.kind == MOUSE_CLICK_EVENT); */ |
| 2571 | if (tty_handle_tab_bar_click (f, event->x, event->y, | 2571 | if (tty_handle_tab_bar_click (f, event->x, event->y, |
| 2572 | (ie.modifiers & down_modifier) != 0, &ie)) | 2572 | (ie.modifiers & down_modifier) != 0, &ie)) |
| 2573 | { | 2573 | { |
| 2574 | /* eassert (ie.kind == GPM_CLICK_EVENT | 2574 | /* eassert (ie.kind == MOUSE_CLICK_EVENT |
| 2575 | * || ie.kind == TAB_BAR_EVENT); */ | 2575 | * || ie.kind == TAB_BAR_EVENT); */ |
| 2576 | /* tty_handle_tab_bar_click stores 2 events in the event | 2576 | /* tty_handle_tab_bar_click stores 2 events in the event |
| 2577 | queue, so we are done here. */ | 2577 | queue, so we are done here. */ |
| @@ -2581,7 +2581,7 @@ handle_one_term_event (struct tty_display_info *tty, Gpm_Event *event) | |||
| 2581 | count += 2; | 2581 | count += 2; |
| 2582 | return count; | 2582 | return count; |
| 2583 | } | 2583 | } |
| 2584 | /* eassert (ie.kind == GPM_CLICK_EVENT); */ | 2584 | /* eassert (ie.kind == MOUSE_CLICK_EVENT); */ |
| 2585 | kbd_buffer_store_event (&ie); | 2585 | kbd_buffer_store_event (&ie); |
| 2586 | count++; | 2586 | count++; |
| 2587 | } | 2587 | } |
diff --git a/src/termhooks.h b/src/termhooks.h index 6ab06ceff94..44ab14225fd 100644 --- a/src/termhooks.h +++ b/src/termhooks.h | |||
| @@ -220,10 +220,6 @@ enum event_kind | |||
| 220 | save yourself before shutdown. */ | 220 | save yourself before shutdown. */ |
| 221 | SAVE_SESSION_EVENT | 221 | SAVE_SESSION_EVENT |
| 222 | 222 | ||
| 223 | #ifdef HAVE_GPM | ||
| 224 | , GPM_CLICK_EVENT | ||
| 225 | #endif | ||
| 226 | |||
| 227 | #ifdef HAVE_DBUS | 223 | #ifdef HAVE_DBUS |
| 228 | , DBUS_EVENT | 224 | , DBUS_EVENT |
| 229 | #endif | 225 | #endif |
diff --git a/src/w32term.c b/src/w32term.c index e0618e4f52d..23cb380040b 100644 --- a/src/w32term.c +++ b/src/w32term.c | |||
| @@ -7165,15 +7165,21 @@ w32_initialize_display_info (Lisp_Object display_name) | |||
| 7165 | memset (dpyinfo, 0, sizeof (*dpyinfo)); | 7165 | memset (dpyinfo, 0, sizeof (*dpyinfo)); |
| 7166 | 7166 | ||
| 7167 | dpyinfo->name_list_element = Fcons (display_name, Qnil); | 7167 | dpyinfo->name_list_element = Fcons (display_name, Qnil); |
| 7168 | static char const title[] = "GNU Emacs"; | ||
| 7168 | if (STRINGP (Vsystem_name)) | 7169 | if (STRINGP (Vsystem_name)) |
| 7169 | { | 7170 | { |
| 7170 | dpyinfo->w32_id_name = xmalloc (SCHARS (Vinvocation_name) | 7171 | static char const at[] = " at "; |
| 7171 | + SCHARS (Vsystem_name) + 2); | 7172 | ptrdiff_t nbytes = sizeof (title) + sizeof (at); |
| 7172 | sprintf (dpyinfo->w32_id_name, "%s@%s", | 7173 | if (INT_ADD_WRAPV (nbytes, SCHARS (Vsystem_name), &nbytes)) |
| 7173 | SDATA (Vinvocation_name), SDATA (Vsystem_name)); | 7174 | memory_full (SIZE_MAX); |
| 7175 | dpyinfo->w32_id_name = xmalloc (nbytes); | ||
| 7176 | sprintf (dpyinfo->w32_id_name, "%s%s%s", title, at, SDATA (Vsystem_name)); | ||
| 7174 | } | 7177 | } |
| 7175 | else | 7178 | else |
| 7176 | dpyinfo->w32_id_name = xlispstrdup (Vinvocation_name); | 7179 | { |
| 7180 | dpyinfo->w32_id_name = xmalloc (sizeof (title)); | ||
| 7181 | strcpy (dpyinfo->w32_id_name, title); | ||
| 7182 | } | ||
| 7177 | 7183 | ||
| 7178 | /* Default Console mode values - overridden when running in GUI mode | 7184 | /* Default Console mode values - overridden when running in GUI mode |
| 7179 | with values obtained from system metrics. */ | 7185 | with values obtained from system metrics. */ |
diff --git a/src/window.c b/src/window.c index a6de34f3db6..6cd3122b43b 100644 --- a/src/window.c +++ b/src/window.c | |||
| @@ -6824,19 +6824,25 @@ DEFUN ("window-configuration-frame", Fwindow_configuration_frame, Swindow_config | |||
| 6824 | } | 6824 | } |
| 6825 | 6825 | ||
| 6826 | DEFUN ("set-window-configuration", Fset_window_configuration, | 6826 | DEFUN ("set-window-configuration", Fset_window_configuration, |
| 6827 | Sset_window_configuration, 1, 1, 0, | 6827 | Sset_window_configuration, 1, 2, 0, |
| 6828 | doc: /* Set the configuration of windows and buffers as specified by CONFIGURATION. | 6828 | doc: /* Set the configuration of windows and buffers as specified by CONFIGURATION. |
| 6829 | CONFIGURATION must be a value previously returned | 6829 | CONFIGURATION must be a value previously returned |
| 6830 | by `current-window-configuration' (which see). | 6830 | by `current-window-configuration' (which see). |
| 6831 | |||
| 6832 | Normally, this function selects the frame of the CONFIGURATION, but if | ||
| 6833 | DONT-SET-FRAME is non-nil, it leaves selected the frame which was | ||
| 6834 | current at the start of the function. | ||
| 6835 | |||
| 6831 | If CONFIGURATION was made from a frame that is now deleted, | 6836 | If CONFIGURATION was made from a frame that is now deleted, |
| 6832 | only frame-independent values can be restored. In this case, | 6837 | only frame-independent values can be restored. In this case, |
| 6833 | the return value is nil. Otherwise the value is t. */) | 6838 | the return value is nil. Otherwise the value is t. */) |
| 6834 | (Lisp_Object configuration) | 6839 | (Lisp_Object configuration, Lisp_Object dont_set_frame) |
| 6835 | { | 6840 | { |
| 6836 | register struct save_window_data *data; | 6841 | register struct save_window_data *data; |
| 6837 | struct Lisp_Vector *saved_windows; | 6842 | struct Lisp_Vector *saved_windows; |
| 6838 | Lisp_Object new_current_buffer; | 6843 | Lisp_Object new_current_buffer; |
| 6839 | Lisp_Object frame; | 6844 | Lisp_Object frame; |
| 6845 | Lisp_Object old_frame = selected_frame; | ||
| 6840 | struct frame *f; | 6846 | struct frame *f; |
| 6841 | ptrdiff_t old_point = -1; | 6847 | ptrdiff_t old_point = -1; |
| 6842 | USE_SAFE_ALLOCA; | 6848 | USE_SAFE_ALLOCA; |
| @@ -7153,7 +7159,10 @@ the return value is nil. Otherwise the value is t. */) | |||
| 7153 | select_window above totally superfluous; it still sets f's | 7159 | select_window above totally superfluous; it still sets f's |
| 7154 | selected window. */ | 7160 | selected window. */ |
| 7155 | if (FRAME_LIVE_P (XFRAME (data->selected_frame))) | 7161 | if (FRAME_LIVE_P (XFRAME (data->selected_frame))) |
| 7156 | do_switch_frame (data->selected_frame, 0, 0, Qnil); | 7162 | do_switch_frame (NILP (dont_set_frame) |
| 7163 | ? data->selected_frame | ||
| 7164 | : old_frame | ||
| 7165 | , 0, 0, Qnil); | ||
| 7157 | } | 7166 | } |
| 7158 | 7167 | ||
| 7159 | FRAME_WINDOW_CHANGE (f) = true; | 7168 | FRAME_WINDOW_CHANGE (f) = true; |
| @@ -7187,11 +7196,13 @@ the return value is nil. Otherwise the value is t. */) | |||
| 7187 | return FRAME_LIVE_P (f) ? Qt : Qnil; | 7196 | return FRAME_LIVE_P (f) ? Qt : Qnil; |
| 7188 | } | 7197 | } |
| 7189 | 7198 | ||
| 7190 | |||
| 7191 | void | 7199 | void |
| 7192 | restore_window_configuration (Lisp_Object configuration) | 7200 | restore_window_configuration (Lisp_Object configuration) |
| 7193 | { | 7201 | { |
| 7194 | Fset_window_configuration (configuration); | 7202 | if (CONSP (configuration)) |
| 7203 | Fset_window_configuration (XCDR (configuration), XCAR (configuration)); | ||
| 7204 | else | ||
| 7205 | Fset_window_configuration (configuration, Qnil); | ||
| 7195 | } | 7206 | } |
| 7196 | 7207 | ||
| 7197 | 7208 | ||
diff --git a/src/xdisp.c b/src/xdisp.c index 2344fe70601..e49cc433308 100644 --- a/src/xdisp.c +++ b/src/xdisp.c | |||
| @@ -22272,14 +22272,15 @@ extend_face_to_end_of_line (struct it *it) | |||
| 22272 | default_face->id : face->id); | 22272 | default_face->id : face->id); |
| 22273 | 22273 | ||
| 22274 | /* Display fill-column indicator if needed. */ | 22274 | /* Display fill-column indicator if needed. */ |
| 22275 | /* We need to subtract 1 to the indicator_column here because we | 22275 | const int indicator_column = fill_column_indicator_column (it, 1); |
| 22276 | will add the indicator IN the column indicator number, not | 22276 | |
| 22277 | after it. We compare the variable it->current_x before | 22277 | /* Make sure our idea of current_x is in sync with the glyphs |
| 22278 | producing the glyph. When FRAME_WINDOW_P we subtract | 22278 | actually in the glyph row. They might differ because |
| 22279 | CHAR_WIDTH calculating STRETCH_WIDTH for the same reason. */ | 22279 | append_space_for_newline can insert one glyph without |
| 22280 | const int indicator_column = | 22280 | updating current_x. */ |
| 22281 | fill_column_indicator_column (it, 1) - 1; | 22281 | it->current_x = it->glyph_row->used[TEXT_AREA]; |
| 22282 | do | 22282 | |
| 22283 | while (it->current_x <= it->last_visible_x) | ||
| 22283 | { | 22284 | { |
| 22284 | if (it->current_x != indicator_column) | 22285 | if (it->current_x != indicator_column) |
| 22285 | PRODUCE_GLYPHS (it); | 22286 | PRODUCE_GLYPHS (it); |
| @@ -22297,7 +22298,6 @@ extend_face_to_end_of_line (struct it *it) | |||
| 22297 | it->c = it->char_to_display = ' '; | 22298 | it->c = it->char_to_display = ' '; |
| 22298 | } | 22299 | } |
| 22299 | } | 22300 | } |
| 22300 | while (it->current_x <= it->last_visible_x); | ||
| 22301 | 22301 | ||
| 22302 | if (WINDOW_RIGHT_MARGIN_WIDTH (it->w) > 0 | 22302 | if (WINDOW_RIGHT_MARGIN_WIDTH (it->w) > 0 |
| 22303 | && (it->glyph_row->used[RIGHT_MARGIN_AREA] | 22303 | && (it->glyph_row->used[RIGHT_MARGIN_AREA] |
diff --git a/src/xterm.c b/src/xterm.c index 98bb0ea8917..0d2452de929 100644 --- a/src/xterm.c +++ b/src/xterm.c | |||
| @@ -12928,19 +12928,23 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) | |||
| 12928 | #endif | 12928 | #endif |
| 12929 | 12929 | ||
| 12930 | Lisp_Object system_name = Fsystem_name (); | 12930 | Lisp_Object system_name = Fsystem_name (); |
| 12931 | 12931 | static char const title[] = "GNU Emacs"; | |
| 12932 | ptrdiff_t nbytes = SBYTES (Vinvocation_name) + 1; | ||
| 12933 | if (STRINGP (system_name) | ||
| 12934 | && INT_ADD_WRAPV (nbytes, SBYTES (system_name) + 1, &nbytes)) | ||
| 12935 | memory_full (SIZE_MAX); | ||
| 12936 | dpyinfo->x_id = ++x_display_id; | ||
| 12937 | dpyinfo->x_id_name = xmalloc (nbytes); | ||
| 12938 | char *nametail = lispstpcpy (dpyinfo->x_id_name, Vinvocation_name); | ||
| 12939 | if (STRINGP (system_name)) | 12932 | if (STRINGP (system_name)) |
| 12940 | { | 12933 | { |
| 12941 | *nametail++ = '@'; | 12934 | static char const at[] = " at "; |
| 12942 | lispstpcpy (nametail, system_name); | 12935 | ptrdiff_t nbytes = sizeof (title) + sizeof (at); |
| 12936 | if (INT_ADD_WRAPV (nbytes, SBYTES (system_name), &nbytes)) | ||
| 12937 | memory_full (SIZE_MAX); | ||
| 12938 | dpyinfo->x_id_name = xmalloc (nbytes); | ||
| 12939 | sprintf (dpyinfo->x_id_name, "%s%s%s", title, at, SDATA (system_name)); | ||
| 12943 | } | 12940 | } |
| 12941 | else | ||
| 12942 | { | ||
| 12943 | dpyinfo->x_id_name = xmalloc (sizeof (title)); | ||
| 12944 | strcpy (dpyinfo->x_id_name, title); | ||
| 12945 | } | ||
| 12946 | |||
| 12947 | dpyinfo->x_id = ++x_display_id; | ||
| 12944 | 12948 | ||
| 12945 | /* Figure out which modifier bits mean what. */ | 12949 | /* Figure out which modifier bits mean what. */ |
| 12946 | x_find_modifier_meanings (dpyinfo); | 12950 | x_find_modifier_meanings (dpyinfo); |
diff --git a/test/lisp/cedet/semantic-utest.el b/test/lisp/cedet/semantic-utest.el index e537871528c..bcbd7d686e3 100644 --- a/test/lisp/cedet/semantic-utest.el +++ b/test/lisp/cedet/semantic-utest.el | |||
| @@ -38,14 +38,9 @@ | |||
| 38 | (defvar semantic-utest-test-directory (expand-file-name "tests" cedet-utest-directory) | 38 | (defvar semantic-utest-test-directory (expand-file-name "tests" cedet-utest-directory) |
| 39 | "Location of test files.") | 39 | "Location of test files.") |
| 40 | 40 | ||
| 41 | (defvar semantic-utest-temp-directory (if (fboundp 'temp-directory) | ||
| 42 | (temp-directory) | ||
| 43 | temporary-file-directory) | ||
| 44 | "Temporary directory to use when creating files.") | ||
| 45 | |||
| 46 | (defun semantic-utest-fname (name) | 41 | (defun semantic-utest-fname (name) |
| 47 | "Create a filename for NAME in /tmp." | 42 | "Create a filename for NAME in /tmp." |
| 48 | (expand-file-name name semantic-utest-temp-directory)) | 43 | (expand-file-name name temporary-file-directory)) |
| 49 | 44 | ||
| 50 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 45 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 51 | ;; Data for C tests | 46 | ;; Data for C tests |
diff --git a/test/lisp/cus-edit-tests.el b/test/lisp/cus-edit-tests.el new file mode 100644 index 00000000000..bb88b8dd9fa --- /dev/null +++ b/test/lisp/cus-edit-tests.el | |||
| @@ -0,0 +1,80 @@ | |||
| 1 | ;;; cus-edit-tests.el --- Tests for cus-edit.el -*- lexical-binding: t -*- | ||
| 2 | |||
| 3 | ;; Copyright (C) 2020 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 | ;;; Commentary: | ||
| 21 | |||
| 22 | ;;; Code: | ||
| 23 | |||
| 24 | (require 'ert) | ||
| 25 | (require 'ert-x) | ||
| 26 | (eval-when-compile (require 'cl-lib)) | ||
| 27 | (require 'cus-edit) | ||
| 28 | |||
| 29 | (defmacro with-cus-edit-test (buffer &rest body) | ||
| 30 | (declare (indent 1)) | ||
| 31 | `(save-window-excursion | ||
| 32 | (unwind-protect | ||
| 33 | (progn ,@body) | ||
| 34 | (when-let ((buf (get-buffer ,buffer))) | ||
| 35 | (kill-buffer buf))))) | ||
| 36 | |||
| 37 | |||
| 38 | ;;;; showing/hiding obsolete options | ||
| 39 | |||
| 40 | (defgroup cus-edit-tests nil "test" | ||
| 41 | :group 'test-group) | ||
| 42 | |||
| 43 | (defcustom cus-edit-tests--obsolete-option-tag nil | ||
| 44 | "This should never be removed; it is obsolete for testing purposes." | ||
| 45 | :type 'boolean | ||
| 46 | :version "917.10") ; a super high version number | ||
| 47 | (make-obsolete-variable 'cus-edit-tests--obsolete-option-tag nil "X.X-test") | ||
| 48 | (defconst cus-edit-tests--obsolete-option-tag | ||
| 49 | (custom-unlispify-tag-name 'cus-edit-tests--obsolete-option-tag)) | ||
| 50 | |||
| 51 | (ert-deftest cus-edit-tests-customize-apropos/hide-obsolete () | ||
| 52 | (with-cus-edit-test "*Customize Apropos*" | ||
| 53 | (customize-apropos "cus-edit-tests") | ||
| 54 | (should-not (search-forward cus-edit-tests--obsolete-option-tag nil t)))) | ||
| 55 | |||
| 56 | (ert-deftest cus-edit-tests-customize-changed-options/hide-obsolete () | ||
| 57 | (with-cus-edit-test "*Customize Changed Options*" | ||
| 58 | (customize-changed-options "917.2") ; some future version | ||
| 59 | (should-not (search-forward cus-edit-tests--obsolete-option-tag nil t)))) | ||
| 60 | |||
| 61 | (ert-deftest cus-edit-tests-customize-group/hide-obsolete () | ||
| 62 | "Check that obsolete variables do not show up." | ||
| 63 | (with-cus-edit-test "*Customize Group: Cus Edit Tests*" | ||
| 64 | (customize-group 'cus-edit-tests) | ||
| 65 | (should-not (search-forward cus-edit-tests--obsolete-option-tag nil t)))) | ||
| 66 | |||
| 67 | (ert-deftest cus-edit-tests-customize-option/show-obsolete () | ||
| 68 | (with-cus-edit-test "*Customize Option: Cus Edit Tests Obsolete Option Tag*" | ||
| 69 | (customize-option 'cus-edit-tests--obsolete-option-tag) | ||
| 70 | (goto-char (point-min)) | ||
| 71 | (should (search-forward cus-edit-tests--obsolete-option-tag nil t)))) | ||
| 72 | |||
| 73 | (ert-deftest cus-edit-tests-customize-saved/show-obsolete () | ||
| 74 | (with-cus-edit-test "*Customize Saved*" | ||
| 75 | (cl-letf (((get 'cus-edit-tests--obsolete-option-tag 'saved-value) '(t))) | ||
| 76 | (customize-saved) | ||
| 77 | (should (search-forward cus-edit-tests--obsolete-option-tag nil t))))) | ||
| 78 | |||
| 79 | (provide 'cus-edit-tests) | ||
| 80 | ;;; cus-edit-tests.el ends here | ||
diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index 13cbedfe1f7..680aa514a27 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el | |||
| @@ -516,19 +516,25 @@ Subtests signal errors if something goes wrong." | |||
| 516 | ;; Should not warn that mt--test2 is not known to be defined. | 516 | ;; Should not warn that mt--test2 is not known to be defined. |
| 517 | (should-not (re-search-forward "my--test2" nil t)))) | 517 | (should-not (re-search-forward "my--test2" nil t)))) |
| 518 | 518 | ||
| 519 | (defmacro bytecomp--with-warning-test (re-warning &rest form) | ||
| 520 | (declare (indent 1)) | ||
| 521 | `(with-current-buffer (get-buffer-create "*Compile-Log*") | ||
| 522 | (let ((inhibit-read-only t)) (erase-buffer)) | ||
| 523 | (byte-compile ,@form) | ||
| 524 | (ert-info ((buffer-string) :prefix "buffer: ") | ||
| 525 | (should (re-search-forward ,re-warning))))) | ||
| 526 | |||
| 519 | (ert-deftest bytecomp-warn-wrong-args () | 527 | (ert-deftest bytecomp-warn-wrong-args () |
| 520 | (with-current-buffer (get-buffer-create "*Compile-Log*") | 528 | (bytecomp--with-warning-test "remq.*3.*2" |
| 521 | (let ((inhibit-read-only t)) (erase-buffer)) | 529 | '(remq 1 2 3))) |
| 522 | (byte-compile '(remq 1 2 3)) | ||
| 523 | (ert-info ((buffer-string) :prefix "buffer: ") | ||
| 524 | (should (re-search-forward "remq.*3.*2"))))) | ||
| 525 | 530 | ||
| 526 | (ert-deftest bytecomp-warn-wrong-args-subr () | 531 | (ert-deftest bytecomp-warn-wrong-args-subr () |
| 527 | (with-current-buffer (get-buffer-create "*Compile-Log*") | 532 | (bytecomp--with-warning-test "safe-length.*3.*1" |
| 528 | (let ((inhibit-read-only t)) (erase-buffer)) | 533 | '(safe-length 1 2 3))) |
| 529 | (byte-compile '(safe-length 1 2 3)) | 534 | |
| 530 | (ert-info ((buffer-string) :prefix "buffer: ") | 535 | (ert-deftest bytecomp-warn-variable-lacks-prefix () |
| 531 | (should (re-search-forward "safe-length.*3.*1"))))) | 536 | (bytecomp--with-warning-test "foo.*lacks a prefix" |
| 537 | '(defvar foo nil))) | ||
| 532 | 538 | ||
| 533 | (ert-deftest test-eager-load-macro-expansion () | 539 | (ert-deftest test-eager-load-macro-expansion () |
| 534 | (test-byte-comp-compile-and-load nil | 540 | (test-byte-comp-compile-and-load nil |
| @@ -810,6 +816,12 @@ literals (Bug#20852)." | |||
| 810 | 816 | ||
| 811 | (test-suppression | 817 | (test-suppression |
| 812 | '(defun zot () | 818 | '(defun zot () |
| 819 | (next-line)) | ||
| 820 | '((interactive-only next-line)) | ||
| 821 | "interactive use only") | ||
| 822 | |||
| 823 | (test-suppression | ||
| 824 | '(defun zot () | ||
| 813 | (mapcar #'list '(1 2 3)) | 825 | (mapcar #'list '(1 2 3)) |
| 814 | nil) | 826 | nil) |
| 815 | '((mapcar mapcar)) | 827 | '((mapcar mapcar)) |
diff --git a/test/lisp/help-tests.el b/test/lisp/help-tests.el index 42be0296c4f..49cb40b29d9 100644 --- a/test/lisp/help-tests.el +++ b/test/lisp/help-tests.el | |||
| @@ -392,6 +392,12 @@ C-b undefined | |||
| 392 | (define-key global-map (kbd "C-c C-l r") nil) | 392 | (define-key global-map (kbd "C-c C-l r") nil) |
| 393 | (define-key global-map (kbd "C-c C-l") nil))) | 393 | (define-key global-map (kbd "C-c C-l") nil))) |
| 394 | 394 | ||
| 395 | (ert-deftest help-substitute-command-keys/preserves-text-properties () | ||
| 396 | "Check that we preserve text properties (Bug#17052)." | ||
| 397 | (should (equal (substitute-command-keys | ||
| 398 | (propertize "foo \\[save-buffer]" 'face 'bold)) | ||
| 399 | (propertize "foo C-x C-s" 'face 'bold)))) | ||
| 400 | |||
| 395 | (provide 'help-tests) | 401 | (provide 'help-tests) |
| 396 | 402 | ||
| 397 | ;;; help-tests.el ends here | 403 | ;;; help-tests.el ends here |
diff --git a/test/lisp/progmodes/cperl-mode-resources/cperl-bug-26850.pl b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-26850.pl new file mode 100644 index 00000000000..a02ea29fe9d --- /dev/null +++ b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-26850.pl | |||
| @@ -0,0 +1,16 @@ | |||
| 1 | sub interesting { | ||
| 2 | $_ = shift; | ||
| 3 | return | ||
| 4 | />Today is .+\'s birthday\.</ | ||
| 5 | || / like[ds]? your post in </ | ||
| 6 | || /like[ds] your new subscription\. </ | ||
| 7 | || / likes? that you're interested in </ | ||
| 8 | || /> likes? your comment: / | ||
| 9 | || /&birthdays=.*birthdays?\.<\/a>/; | ||
| 10 | } | ||
| 11 | |||
| 12 | sub boring { | ||
| 13 | return | ||
| 14 | / likes? your post in </ | ||
| 15 | || / likes? that you're interested in </ | ||
| 16 | } | ||
diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el index a0dd391840f..896160bb883 100644 --- a/test/lisp/progmodes/cperl-mode-tests.el +++ b/test/lisp/progmodes/cperl-mode-tests.el | |||
| @@ -228,6 +228,21 @@ documentation it does the right thing anyway." | |||
| 228 | (cperl-indent-command) | 228 | (cperl-indent-command) |
| 229 | (forward-line 1)))) | 229 | (forward-line 1)))) |
| 230 | 230 | ||
| 231 | (ert-deftest cperl-test-bug-28650 () | ||
| 232 | "Verify that regular expressions are recognized after 'return'. | ||
| 233 | The test uses the syntax property \"inside a string\" for the | ||
| 234 | text in regular expressions, which is non-nil for both cperl-mode | ||
| 235 | and perl-mode." | ||
| 236 | (with-temp-buffer | ||
| 237 | (insert-file-contents (ert-resource-file "cperl-bug-26850.pl")) | ||
| 238 | (goto-char (point-min)) | ||
| 239 | (re-search-forward "sub interesting {[^}]*}") | ||
| 240 | (should-not (equal (nth 3 (cperl-test-ppss (match-string 0) "Today")) | ||
| 241 | nil)) | ||
| 242 | (re-search-forward "sub boring {[^}]*}") | ||
| 243 | (should-not (equal (nth 3 (cperl-test-ppss (match-string 0) "likes\\?")) | ||
| 244 | nil)))) | ||
| 245 | |||
| 231 | (ert-deftest cperl-test-bug-30393 () | 246 | (ert-deftest cperl-test-bug-30393 () |
| 232 | "Verify that indentation is not disturbed by an open paren in col 0. | 247 | "Verify that indentation is not disturbed by an open paren in col 0. |
| 233 | Perl is not Lisp: An open paren in column 0 does not start a function." | 248 | Perl is not Lisp: An open paren in column 0 does not start a function." |
diff --git a/test/manual/etags/ETAGS.good_1 b/test/manual/etags/ETAGS.good_1 index 5451a79efaa..3de15514e79 100644 --- a/test/manual/etags/ETAGS.good_1 +++ b/test/manual/etags/ETAGS.good_1 | |||
| @@ -3153,13 +3153,13 @@ tex-src/gzip.texi,303 | |||
| 3153 | @node Top,62,2139 | 3153 | @node Top,62,2139 |
| 3154 | @node Copying,80,2652 | 3154 | @node Copying,80,2652 |
| 3155 | @node Overview,83,2705 | 3155 | @node Overview,83,2705 |
| 3156 | @node Sample,166,7272 | 3156 | @node Sample,166,7273 |
| 3157 | @node Invoking gzip,Invoking gzip210,8828 | 3157 | @node Invoking gzip,Invoking gzip210,8829 |
| 3158 | @node Advanced usage,Advanced usage357,13496 | 3158 | @node Advanced usage,Advanced usage357,13497 |
| 3159 | @node Environment,420,15208 | 3159 | @node Environment,420,15209 |
| 3160 | @node Tapes,437,15769 | 3160 | @node Tapes,437,15770 |
| 3161 | @node Problems,460,16768 | 3161 | @node Problems,460,16769 |
| 3162 | @node Concept Index,Concept Index473,17288 | 3162 | @node Concept Index,Concept Index473,17289 |
| 3163 | 3163 | ||
| 3164 | tex-src/texinfo.tex,30627 | 3164 | tex-src/texinfo.tex,30627 |
| 3165 | \def\texinfoversion{\texinfoversion26,1035 | 3165 | \def\texinfoversion{\texinfoversion26,1035 |
diff --git a/test/manual/etags/ETAGS.good_2 b/test/manual/etags/ETAGS.good_2 index ab2111eafb2..ddb8d19540b 100644 --- a/test/manual/etags/ETAGS.good_2 +++ b/test/manual/etags/ETAGS.good_2 | |||
| @@ -3726,13 +3726,13 @@ tex-src/gzip.texi,303 | |||
| 3726 | @node Top,62,2139 | 3726 | @node Top,62,2139 |
| 3727 | @node Copying,80,2652 | 3727 | @node Copying,80,2652 |
| 3728 | @node Overview,83,2705 | 3728 | @node Overview,83,2705 |
| 3729 | @node Sample,166,7272 | 3729 | @node Sample,166,7273 |
| 3730 | @node Invoking gzip,Invoking gzip210,8828 | 3730 | @node Invoking gzip,Invoking gzip210,8829 |
| 3731 | @node Advanced usage,Advanced usage357,13496 | 3731 | @node Advanced usage,Advanced usage357,13497 |
| 3732 | @node Environment,420,15208 | 3732 | @node Environment,420,15209 |
| 3733 | @node Tapes,437,15769 | 3733 | @node Tapes,437,15770 |
| 3734 | @node Problems,460,16768 | 3734 | @node Problems,460,16769 |
| 3735 | @node Concept Index,Concept Index473,17288 | 3735 | @node Concept Index,Concept Index473,17289 |
| 3736 | 3736 | ||
| 3737 | tex-src/texinfo.tex,30627 | 3737 | tex-src/texinfo.tex,30627 |
| 3738 | \def\texinfoversion{\texinfoversion26,1035 | 3738 | \def\texinfoversion{\texinfoversion26,1035 |
diff --git a/test/manual/etags/ETAGS.good_3 b/test/manual/etags/ETAGS.good_3 index e53fb9629c5..40be768aacb 100644 --- a/test/manual/etags/ETAGS.good_3 +++ b/test/manual/etags/ETAGS.good_3 | |||
| @@ -3560,13 +3560,13 @@ tex-src/gzip.texi,303 | |||
| 3560 | @node Top,62,2139 | 3560 | @node Top,62,2139 |
| 3561 | @node Copying,80,2652 | 3561 | @node Copying,80,2652 |
| 3562 | @node Overview,83,2705 | 3562 | @node Overview,83,2705 |
| 3563 | @node Sample,166,7272 | 3563 | @node Sample,166,7273 |
| 3564 | @node Invoking gzip,Invoking gzip210,8828 | 3564 | @node Invoking gzip,Invoking gzip210,8829 |
| 3565 | @node Advanced usage,Advanced usage357,13496 | 3565 | @node Advanced usage,Advanced usage357,13497 |
| 3566 | @node Environment,420,15208 | 3566 | @node Environment,420,15209 |
| 3567 | @node Tapes,437,15769 | 3567 | @node Tapes,437,15770 |
| 3568 | @node Problems,460,16768 | 3568 | @node Problems,460,16769 |
| 3569 | @node Concept Index,Concept Index473,17288 | 3569 | @node Concept Index,Concept Index473,17289 |
| 3570 | 3570 | ||
| 3571 | tex-src/texinfo.tex,30627 | 3571 | tex-src/texinfo.tex,30627 |
| 3572 | \def\texinfoversion{\texinfoversion26,1035 | 3572 | \def\texinfoversion{\texinfoversion26,1035 |
diff --git a/test/manual/etags/ETAGS.good_4 b/test/manual/etags/ETAGS.good_4 index 5a4b5b4b8ba..15f67c5d28a 100644 --- a/test/manual/etags/ETAGS.good_4 +++ b/test/manual/etags/ETAGS.good_4 | |||
| @@ -3317,13 +3317,13 @@ tex-src/gzip.texi,303 | |||
| 3317 | @node Top,62,2139 | 3317 | @node Top,62,2139 |
| 3318 | @node Copying,80,2652 | 3318 | @node Copying,80,2652 |
| 3319 | @node Overview,83,2705 | 3319 | @node Overview,83,2705 |
| 3320 | @node Sample,166,7272 | 3320 | @node Sample,166,7273 |
| 3321 | @node Invoking gzip,Invoking gzip210,8828 | 3321 | @node Invoking gzip,Invoking gzip210,8829 |
| 3322 | @node Advanced usage,Advanced usage357,13496 | 3322 | @node Advanced usage,Advanced usage357,13497 |
| 3323 | @node Environment,420,15208 | 3323 | @node Environment,420,15209 |
| 3324 | @node Tapes,437,15769 | 3324 | @node Tapes,437,15770 |
| 3325 | @node Problems,460,16768 | 3325 | @node Problems,460,16769 |
| 3326 | @node Concept Index,Concept Index473,17288 | 3326 | @node Concept Index,Concept Index473,17289 |
| 3327 | 3327 | ||
| 3328 | tex-src/texinfo.tex,30627 | 3328 | tex-src/texinfo.tex,30627 |
| 3329 | \def\texinfoversion{\texinfoversion26,1035 | 3329 | \def\texinfoversion{\texinfoversion26,1035 |
diff --git a/test/manual/etags/ETAGS.good_5 b/test/manual/etags/ETAGS.good_5 index f89cfefc388..583de5cbe22 100644 --- a/test/manual/etags/ETAGS.good_5 +++ b/test/manual/etags/ETAGS.good_5 | |||
| @@ -4297,13 +4297,13 @@ tex-src/gzip.texi,303 | |||
| 4297 | @node Top,62,2139 | 4297 | @node Top,62,2139 |
| 4298 | @node Copying,80,2652 | 4298 | @node Copying,80,2652 |
| 4299 | @node Overview,83,2705 | 4299 | @node Overview,83,2705 |
| 4300 | @node Sample,166,7272 | 4300 | @node Sample,166,7273 |
| 4301 | @node Invoking gzip,Invoking gzip210,8828 | 4301 | @node Invoking gzip,Invoking gzip210,8829 |
| 4302 | @node Advanced usage,Advanced usage357,13496 | 4302 | @node Advanced usage,Advanced usage357,13497 |
| 4303 | @node Environment,420,15208 | 4303 | @node Environment,420,15209 |
| 4304 | @node Tapes,437,15769 | 4304 | @node Tapes,437,15770 |
| 4305 | @node Problems,460,16768 | 4305 | @node Problems,460,16769 |
| 4306 | @node Concept Index,Concept Index473,17288 | 4306 | @node Concept Index,Concept Index473,17289 |
| 4307 | 4307 | ||
| 4308 | tex-src/texinfo.tex,30627 | 4308 | tex-src/texinfo.tex,30627 |
| 4309 | \def\texinfoversion{\texinfoversion26,1035 | 4309 | \def\texinfoversion{\texinfoversion26,1035 |
diff --git a/test/manual/etags/ETAGS.good_6 b/test/manual/etags/ETAGS.good_6 index 0a31ed078e8..86df93afab1 100644 --- a/test/manual/etags/ETAGS.good_6 +++ b/test/manual/etags/ETAGS.good_6 | |||
| @@ -4297,13 +4297,13 @@ tex-src/gzip.texi,303 | |||
| 4297 | @node Top,62,2139 | 4297 | @node Top,62,2139 |
| 4298 | @node Copying,80,2652 | 4298 | @node Copying,80,2652 |
| 4299 | @node Overview,83,2705 | 4299 | @node Overview,83,2705 |
| 4300 | @node Sample,166,7272 | 4300 | @node Sample,166,7273 |
| 4301 | @node Invoking gzip,Invoking gzip210,8828 | 4301 | @node Invoking gzip,Invoking gzip210,8829 |
| 4302 | @node Advanced usage,Advanced usage357,13496 | 4302 | @node Advanced usage,Advanced usage357,13497 |
| 4303 | @node Environment,420,15208 | 4303 | @node Environment,420,15209 |
| 4304 | @node Tapes,437,15769 | 4304 | @node Tapes,437,15770 |
| 4305 | @node Problems,460,16768 | 4305 | @node Problems,460,16769 |
| 4306 | @node Concept Index,Concept Index473,17288 | 4306 | @node Concept Index,Concept Index473,17289 |
| 4307 | 4307 | ||
| 4308 | tex-src/texinfo.tex,30627 | 4308 | tex-src/texinfo.tex,30627 |
| 4309 | \def\texinfoversion{\texinfoversion26,1035 | 4309 | \def\texinfoversion{\texinfoversion26,1035 |
diff --git a/test/manual/indent/tcl.tcl b/test/manual/indent/tcl.tcl index c3781533ca4..f055be19663 100644 --- a/test/manual/indent/tcl.tcl +++ b/test/manual/indent/tcl.tcl | |||
| @@ -20,3 +20,7 @@ proc foo3 {} { | |||
| 20 | puts a""b"; # And that won't either! | 20 | puts a""b"; # And that won't either! |
| 21 | puts "a""b"; # But this will! | 21 | puts "a""b"; # But this will! |
| 22 | } | 22 | } |
| 23 | |||
| 24 | # FIXME: The [..] interpolation within "..." strings is not properly | ||
| 25 | # handled by the current `syntax-propertize-function`! | ||
| 26 | set a "Testing: [split "192.168.1.1/24" "/"] address"; | ||
diff --git a/test/src/data-tests.el b/test/src/data-tests.el index ed092039078..1312683c848 100644 --- a/test/src/data-tests.el +++ b/test/src/data-tests.el | |||
| @@ -345,6 +345,25 @@ comparing the subr with a much slower lisp implementation." | |||
| 345 | (setq-default binding-test-some-local 'new-default)) | 345 | (setq-default binding-test-some-local 'new-default)) |
| 346 | (should (eq binding-test-some-local 'some)))) | 346 | (should (eq binding-test-some-local 'some)))) |
| 347 | 347 | ||
| 348 | (ert-deftest data-tests--let-buffer-local () | ||
| 349 | (let ((blvar (make-symbol "blvar"))) | ||
| 350 | (set-default blvar nil) | ||
| 351 | (make-variable-buffer-local blvar) | ||
| 352 | |||
| 353 | (dolist (var (list blvar 'left-margin)) | ||
| 354 | (let ((def (default-value var))) | ||
| 355 | (with-temp-buffer | ||
| 356 | (should (equal def (symbol-value var))) | ||
| 357 | (cl-progv (list var) (list 42) | ||
| 358 | (should (equal (symbol-value var) 42)) | ||
| 359 | (should (equal (default-value var) (symbol-value var))) | ||
| 360 | (set var 123) | ||
| 361 | (should (equal (symbol-value var) 123)) | ||
| 362 | (should (equal (default-value var) (symbol-value var)))) ;bug#44733 | ||
| 363 | (should (equal (symbol-value var) def)) | ||
| 364 | (should (equal (default-value var) (symbol-value var)))) | ||
| 365 | (should (equal (default-value var) def)))))) | ||
| 366 | |||
| 348 | (ert-deftest binding-test-makunbound () | 367 | (ert-deftest binding-test-makunbound () |
| 349 | "Tests of makunbound, from the manual." | 368 | "Tests of makunbound, from the manual." |
| 350 | (with-current-buffer binding-test-buffer-B | 369 | (with-current-buffer binding-test-buffer-B |
| @@ -381,6 +400,37 @@ comparing the subr with a much slower lisp implementation." | |||
| 381 | "Test setting a keyword to itself" | 400 | "Test setting a keyword to itself" |
| 382 | (with-no-warnings (should (setq :keyword :keyword)))) | 401 | (with-no-warnings (should (setq :keyword :keyword)))) |
| 383 | 402 | ||
| 403 | (ert-deftest data-tests--set-default-per-buffer () | ||
| 404 | :expected-result t ;; Not fixed yet! | ||
| 405 | ;; FIXME: Performance tests are inherently unreliable. | ||
| 406 | ;; Using wall-clock time makes it even worse, so don't bother unless | ||
| 407 | ;; we have the primitive to measure cpu-time. | ||
| 408 | (skip-unless (fboundp 'current-cpu-time)) | ||
| 409 | ;; Test performance of set-default on DEFVAR_PER_BUFFER variables. | ||
| 410 | ;; More specifically, test the problem seen in bug#41029 where setting | ||
| 411 | ;; the default value of a variable takes time proportional to the | ||
| 412 | ;; number of buffers. | ||
| 413 | (let* ((fun #'error) | ||
| 414 | (test (lambda () | ||
| 415 | (with-temp-buffer | ||
| 416 | (let ((st (car (current-cpu-time)))) | ||
| 417 | (dotimes (_ 1000) | ||
| 418 | (let ((case-fold-search 'data-test)) | ||
| 419 | ;; Use an indirection through a mutable var | ||
| 420 | ;; to try and make sure the byte-compiler | ||
| 421 | ;; doesn't optimize away the let bindings. | ||
| 422 | (funcall fun))) | ||
| 423 | ;; FIXME: Handle the wraparound, if any. | ||
| 424 | (- (car (current-cpu-time)) st))))) | ||
| 425 | (_ (setq fun #'ignore)) | ||
| 426 | (time1 (funcall test)) | ||
| 427 | (bufs (mapcar (lambda (_) (generate-new-buffer " data-test")) | ||
| 428 | (make-list 1000 nil))) | ||
| 429 | (time2 (funcall test))) | ||
| 430 | (mapc #'kill-buffer bufs) | ||
| 431 | ;; Don't divide one time by the other since they may be 0. | ||
| 432 | (should (< time2 (* time1 5))))) | ||
| 433 | |||
| 384 | ;; More tests to write - | 434 | ;; More tests to write - |
| 385 | ;; kill-local-variable | 435 | ;; kill-local-variable |
| 386 | ;; defconst; can modify | 436 | ;; defconst; can modify |
diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el index d3c22f966e6..86b8d655d26 100644 --- a/test/src/fns-tests.el +++ b/test/src/fns-tests.el | |||
| @@ -938,6 +938,13 @@ | |||
| 938 | (should (equal (string-search "\303" "aøb") nil)) | 938 | (should (equal (string-search "\303" "aøb") nil)) |
| 939 | (should (equal (string-search "\270" "aøb") nil)) | 939 | (should (equal (string-search "\270" "aøb") nil)) |
| 940 | (should (equal (string-search "ø" "\303\270") nil)) | 940 | (should (equal (string-search "ø" "\303\270") nil)) |
| 941 | (should (equal (string-search "ø" (make-string 32 ?a)) nil)) | ||
| 942 | (should (equal (string-search "ø" (string-to-multibyte (make-string 32 ?a))) | ||
| 943 | nil)) | ||
| 944 | (should (equal (string-search "o" (string-to-multibyte | ||
| 945 | (apply #'string | ||
| 946 | (number-sequence ?a ?z)))) | ||
| 947 | 14)) | ||
| 941 | 948 | ||
| 942 | (should (equal (string-search "a\U00010f98z" "a\U00010f98a\U00010f98z") 2)) | 949 | (should (equal (string-search "a\U00010f98z" "a\U00010f98a\U00010f98z") 2)) |
| 943 | 950 | ||
diff --git a/test/src/keymap-tests.el b/test/src/keymap-tests.el index e3dd8420d7b..6411cd1f0d4 100644 --- a/test/src/keymap-tests.el +++ b/test/src/keymap-tests.el | |||
| @@ -54,6 +54,15 @@ | |||
| 54 | (ert-deftest keymap-copy-keymap/is-not-eq () | 54 | (ert-deftest keymap-copy-keymap/is-not-eq () |
| 55 | (should-not (eq (copy-keymap help-mode-map) help-mode-map))) | 55 | (should-not (eq (copy-keymap help-mode-map) help-mode-map))) |
| 56 | 56 | ||
| 57 | (ert-deftest keymap---get-keyelt/runs-menu-item-filter () | ||
| 58 | (let* (menu-item-filter-ran | ||
| 59 | (object `(menu-item "2" identity | ||
| 60 | :filter ,(lambda (cmd) | ||
| 61 | (setq menu-item-filter-ran t) | ||
| 62 | cmd)))) | ||
| 63 | (keymap--get-keyelt object t) | ||
| 64 | (should menu-item-filter-ran))) | ||
| 65 | |||
| 57 | (ert-deftest keymap-lookup-key () | 66 | (ert-deftest keymap-lookup-key () |
| 58 | (let ((map (make-keymap))) | 67 | (let ((map (make-keymap))) |
| 59 | (define-key map [?a] 'foo) | 68 | (define-key map [?a] 'foo) |
| @@ -72,6 +81,26 @@ https://debbugs.gnu.org/39149#31" | |||
| 72 | (with-temp-buffer | 81 | (with-temp-buffer |
| 73 | (should (eq (describe-buffer-bindings (current-buffer)) nil)))) | 82 | (should (eq (describe-buffer-bindings (current-buffer)) nil)))) |
| 74 | 83 | ||
| 84 | (defun keymap-tests--test-menu-item-filter (show filter-fun) | ||
| 85 | (unwind-protect | ||
| 86 | (progn | ||
| 87 | (define-key global-map (kbd "C-c C-l r") | ||
| 88 | `(menu-item "2" identity :filter ,filter-fun)) | ||
| 89 | (with-temp-buffer | ||
| 90 | (describe-buffer-bindings (current-buffer)) | ||
| 91 | (goto-char (point-min)) | ||
| 92 | (if (eq show 'show) | ||
| 93 | (should (search-forward "C-c C-l r" nil t)) | ||
| 94 | (should-not (search-forward "C-c C-l r" nil t))))) | ||
| 95 | (define-key global-map (kbd "C-c C-l r") nil) | ||
| 96 | (define-key global-map (kbd "C-c C-l") nil))) | ||
| 97 | |||
| 98 | (ert-deftest describe-buffer-bindings/menu-item-filter-show-binding () | ||
| 99 | (keymap-tests--test-menu-item-filter 'show (lambda (cmd) cmd))) | ||
| 100 | |||
| 101 | (ert-deftest describe-buffer-bindings/menu-item-filter-hide-binding () | ||
| 102 | (keymap-tests--test-menu-item-filter 'hide (lambda (_) nil))) | ||
| 103 | |||
| 75 | (ert-deftest keymap-store_in_keymap-XFASTINT-on-non-characters () | 104 | (ert-deftest keymap-store_in_keymap-XFASTINT-on-non-characters () |
| 76 | "Check for bug fixed in \"Fix assertion violation in define-key\", | 105 | "Check for bug fixed in \"Fix assertion violation in define-key\", |
| 77 | commit 86c19714b097aa477d339ed99ffb5136c755a046." | 106 | commit 86c19714b097aa477d339ed99ffb5136c755a046." |
| @@ -170,6 +199,58 @@ commit 86c19714b097aa477d339ed99ffb5136c755a046." | |||
| 170 | (where-is-internal 'execute-extended-command global-map t)) | 199 | (where-is-internal 'execute-extended-command global-map t)) |
| 171 | [#x8000078]))) | 200 | [#x8000078]))) |
| 172 | 201 | ||
| 202 | |||
| 203 | ;;;; describe_vector | ||
| 204 | |||
| 205 | (ert-deftest help--describe-vector/bug-9293-one-shadowed-in-range () | ||
| 206 | "Check that we only show a range if shadowed by the same command." | ||
| 207 | (let ((orig-map (let ((map (make-keymap))) | ||
| 208 | (define-key map "e" 'foo) | ||
| 209 | (define-key map "f" 'foo) | ||
| 210 | (define-key map "g" 'foo) | ||
| 211 | (define-key map "h" 'foo) | ||
| 212 | map)) | ||
| 213 | (shadow-map (let ((map (make-keymap))) | ||
| 214 | (define-key map "f" 'bar) | ||
| 215 | map)) | ||
| 216 | (text-quoting-style 'grave)) | ||
| 217 | (with-temp-buffer | ||
| 218 | (help--describe-vector (cadr orig-map) nil #'help--describe-command | ||
| 219 | t shadow-map orig-map t) | ||
| 220 | (should (equal (buffer-string) | ||
| 221 | " | ||
| 222 | e foo | ||
| 223 | f foo (currently shadowed by `bar') | ||
| 224 | g .. h foo | ||
| 225 | "))))) | ||
| 226 | |||
| 227 | (ert-deftest help--describe-vector/bug-9293-same-command-does-not-shadow () | ||
| 228 | "Check that a command can't be shadowed by the same command." | ||
| 229 | (let ((range-map | ||
| 230 | (let ((map (make-keymap))) | ||
| 231 | (define-key map "0" 'foo) | ||
| 232 | (define-key map "1" 'foo) | ||
| 233 | (define-key map "2" 'foo) | ||
| 234 | (define-key map "3" 'foo) | ||
| 235 | map)) | ||
| 236 | (shadow-map | ||
| 237 | (let ((map (make-keymap))) | ||
| 238 | (define-key map "0" 'foo) | ||
| 239 | (define-key map "1" 'foo) | ||
| 240 | (define-key map "2" 'foo) | ||
| 241 | (define-key map "3" 'foo) | ||
| 242 | map))) | ||
| 243 | (with-temp-buffer | ||
| 244 | (help--describe-vector (cadr range-map) nil #'help--describe-command | ||
| 245 | t shadow-map range-map t) | ||
| 246 | (should (equal (buffer-string) | ||
| 247 | " | ||
| 248 | 0 .. 3 foo | ||
| 249 | "))))) | ||
| 250 | |||
| 251 | |||
| 252 | ;;;; apropos-internal | ||
| 253 | |||
| 173 | (ert-deftest keymap-apropos-internal () | 254 | (ert-deftest keymap-apropos-internal () |
| 174 | (should (equal (apropos-internal "^next-line$") '(next-line))) | 255 | (should (equal (apropos-internal "^next-line$") '(next-line))) |
| 175 | (should (>= (length (apropos-internal "^help")) 100)) | 256 | (should (>= (length (apropos-internal "^help")) 100)) |
diff --git a/test/src/syntax-resources/syntax-comments.txt b/test/src/syntax-resources/syntax-comments.txt index 6f595e4d8dc..a292d816b9d 100644 --- a/test/src/syntax-resources/syntax-comments.txt +++ b/test/src/syntax-resources/syntax-comments.txt | |||
| @@ -62,7 +62,33 @@ | |||
| 62 | 33; \ | 62 | 33; \ |
| 63 | 33 | 63 | 33 |
| 64 | 64 | ||
| 65 | /* Lisp comments within lists */ | ||
| 66 | 40)40 | ||
| 67 | 41(;90 comment | ||
| 68 | 91)41 | ||
| 69 | 42(;92\ | ||
| 70 | 93)42 | ||
| 71 | 43( ;94 | ||
| 72 | 95 | ||
| 73 | |||
| 74 | /* Nested Lisp comments */ | ||
| 75 | 100|#100 | ||
| 76 | 101#|# | ||
| 77 | 102#||#102 | ||
| 78 | 103#| Comment |#103 | ||
| 79 | 104#| Comment | ||
| 80 | |#104 | ||
| 81 | 105#|#|#105 | ||
| 82 | 106#| #| Comment |# |#106 | ||
| 83 | 107#|#|#|#|#|#|#|#|#| Comment |#|#|#|#|#|#|#|#|#107 | ||
| 84 | |||
| 85 | /* Mixed Lisp comments */ | ||
| 86 | 110; #| | ||
| 87 | 110 | ||
| 88 | 111#| ; |#111 | ||
| 89 | |||
| 65 | Local Variables: | 90 | Local Variables: |
| 66 | mode: fundamental | 91 | mode: fundamental |
| 67 | eval: (set-syntax-table (make-syntax-table)) | 92 | eval: (set-syntax-table (make-syntax-table)) |
| 68 | End: | 93 | End: |
| 94 | 999 \ No newline at end of file | ||
diff --git a/test/src/syntax-tests.el b/test/src/syntax-tests.el index 4b9c3f277aa..edee01ec585 100644 --- a/test/src/syntax-tests.el +++ b/test/src/syntax-tests.el | |||
| @@ -220,7 +220,7 @@ missing or nil, the value of -START- is assumed for it." | |||
| 220 | (cond | 220 | (cond |
| 221 | ((eq -dir- 'forward) t) | 221 | ((eq -dir- 'forward) t) |
| 222 | ((eq -dir- 'backward) nil) | 222 | ((eq -dir- 'backward) nil) |
| 223 | (t (error "Invalid -dir- argument \"%s\" to `syntax-comments'" -dir-)))) | 223 | (t (error "Invalid -dir- argument \"%s\" to `syntax-br-comments'" -dir-)))) |
| 224 | (start -start-) | 224 | (start -start-) |
| 225 | (start-str (format "%d" (abs start))) | 225 | (start-str (format "%d" (abs start))) |
| 226 | (type -type-)) | 226 | (type -type-)) |
| @@ -338,10 +338,14 @@ the `parse-partial-sexp's are expected to stop. See | |||
| 338 | (setq parse-sexp-ignore-comments t) | 338 | (setq parse-sexp-ignore-comments t) |
| 339 | (setq comment-end-can-be-escaped nil) | 339 | (setq comment-end-can-be-escaped nil) |
| 340 | (modify-syntax-entry ?\n ">") | 340 | (modify-syntax-entry ?\n ">") |
| 341 | (modify-syntax-entry ?\; "<")) | 341 | (modify-syntax-entry ?\; "<") |
| 342 | (modify-syntax-entry ?{ ".") | ||
| 343 | (modify-syntax-entry ?} ".")) | ||
| 342 | (defun \;-out () | 344 | (defun \;-out () |
| 343 | (modify-syntax-entry ?\n " ") | 345 | (modify-syntax-entry ?\n " ") |
| 344 | (modify-syntax-entry ?\; ".")) | 346 | (modify-syntax-entry ?\; ".") |
| 347 | (modify-syntax-entry ?{ "(}") | ||
| 348 | (modify-syntax-entry ?} "){")) | ||
| 345 | (eval-and-compile | 349 | (eval-and-compile |
| 346 | (setq syntax-comments-section "lisp")) | 350 | (setq syntax-comments-section "lisp")) |
| 347 | 351 | ||
| @@ -353,6 +357,62 @@ the `parse-partial-sexp's are expected to stop. See | |||
| 353 | (syntax-comments \; forward t 33) | 357 | (syntax-comments \; forward t 33) |
| 354 | (syntax-comments \; backward t 33) | 358 | (syntax-comments \; backward t 33) |
| 355 | 359 | ||
| 360 | ;; "Lisp" style comments inside lists. | ||
| 361 | (syntax-br-comments \; backward nil 40) | ||
| 362 | (syntax-br-comments \; forward t 41) | ||
| 363 | (syntax-br-comments \; backward t 41) | ||
| 364 | (syntax-br-comments \; forward t 42) | ||
| 365 | (syntax-br-comments \; backward t 42) | ||
| 366 | (syntax-br-comments \; forward nil 43) | ||
| 367 | |||
| 368 | ;; "Lisp" style comments parsed by `parse-partial-sexp'. | ||
| 369 | (syntax-pps-comments \; 41 90 91) | ||
| 370 | (syntax-pps-comments \; 42 92 93) | ||
| 371 | (syntax-pps-comments \; 43 94 95 -999) | ||
| 372 | |||
| 373 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||
| 374 | ;; "Lisp" style nested comments: between delimiters #| |#. | ||
| 375 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||
| 376 | (defun \#|-in () | ||
| 377 | (setq parse-sexp-ignore-comments t) | ||
| 378 | (modify-syntax-entry ?# ". 14") | ||
| 379 | (modify-syntax-entry ?| ". 23n") | ||
| 380 | (modify-syntax-entry ?\; "< b") | ||
| 381 | (modify-syntax-entry ?\n "> b")) | ||
| 382 | (defun \#|-out () | ||
| 383 | (modify-syntax-entry ?# ".") | ||
| 384 | (modify-syntax-entry ?| ".") | ||
| 385 | (modify-syntax-entry ?\; ".") | ||
| 386 | (modify-syntax-entry ?\n " ")) | ||
| 387 | (eval-and-compile | ||
| 388 | (setq syntax-comments-section "lisp-n")) | ||
| 389 | |||
| 390 | (syntax-comments \#| forward nil 100 0) | ||
| 391 | (syntax-comments \#| backward nil 100 0) | ||
| 392 | (syntax-comments \#| forward nil 101 -999) | ||
| 393 | (syntax-comments \#| forward t 102) | ||
| 394 | (syntax-comments \#| backward t 102) | ||
| 395 | |||
| 396 | (syntax-comments \#| forward t 103) | ||
| 397 | (syntax-comments \#| backward t 103) | ||
| 398 | (syntax-comments \#| forward t 104) | ||
| 399 | (syntax-comments \#| backward t 104) | ||
| 400 | |||
| 401 | (syntax-comments \#| forward nil 105 -999) | ||
| 402 | (syntax-comments \#| backward t 105) | ||
| 403 | (syntax-comments \#| forward t 106) | ||
| 404 | (syntax-comments \#| backward t 106) | ||
| 405 | (syntax-comments \#| forward t 107) | ||
| 406 | (syntax-comments \#| backward t 107) | ||
| 407 | |||
| 408 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||
| 409 | ;; Mixed "Lisp" style (nested and unnested) comments. | ||
| 410 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||
| 411 | (syntax-comments \#| forward t 110) | ||
| 412 | (syntax-comments \#| backward t 110) | ||
| 413 | (syntax-comments \#| forward t 111) | ||
| 414 | (syntax-comments \#| backward t 111) | ||
| 415 | |||
| 356 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 416 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 357 | ;; Emacs 27 "C" style comments - `comment-end-can-be-escaped' is non-nil. | 417 | ;; Emacs 27 "C" style comments - `comment-end-can-be-escaped' is non-nil. |
| 358 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 418 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |