procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge remote-tracking branch 'savannah/master' into HEAD

Browse source
This commit is contained in:
Andrea Corallo 2020-11-22 22:23:16 +01:00
commit 033e96055c
185 changed files with 3227 additions and 2809 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
.gitignore vendored
View file

@ -199,7 +199,6 @@ src/bootstrap-emacs
src/emacs
src/emacs-[0-9]*
src/temacs
src/fingerprint.c
src/dmpstruct.h
src/*.pdmp

28
INSTALL
View file

@ -117,19 +117,25 @@ ADDITIONAL DISTRIBUTION FILES
* Complex Text Layout support libraries
On GNU and Unix systems, Emacs needs the optional libraries "m17n-db",
"libm17n-flt", "libotf" to correctly display such complex scripts as
Indic and Khmer, and also for scripts that require Arabic shaping
support (Arabic and Farsi). On some systems, particularly GNU/Linux,
these libraries may be already present or available as additional
packages. Note that if there is a separate 'dev' or 'devel' package,
for use at compilation time rather than run time, you will need that
as well as the corresponding run time package; typically the dev
package will contain header files and a library archive. Otherwise,
you can download the libraries from <https://www.nongnu.org/m17n/>.
On GNU and Unix systems, Emacs needs optional libraries to correctly
display such complex scripts as Indic and Khmer, and also for scripts
that require Arabic shaping support (Arabic and Farsi). If the
HarfBuzz library is installed, Emacs will build with it and use it for
this purpose. HarfBuzz is the preferred shaping engine, both on Posix
hosts and on MS-Windows, so we recommend installing it before building
Emacs. The alternative for GNU/Linux and Posix systems is to use the
"m17n-db", "libm17n-flt", and "libotf" libraries. (On some systems,
particularly GNU/Linux, these libraries may be already present or
available as additional packages.) Note that if there is a separate
'dev' or 'devel' package, for use at compilation time rather than run
time, you will need that as well as the corresponding run time
package; typically the dev package will contain header files and a
library archive. On MS-Windows, if HarfBuzz is not available, Emacs
will use the Uniscribe shaping engine that is part of the OS.
Note that Emacs cannot support complex scripts on a TTY, unless the
terminal includes such a support.
terminal includes such a support. However, most modern terminal
emulators, such as xterm, do support such scripts.
* intlfonts-VERSION.tar.gz

6
doc/emacs/mule.texi
View file

@ -563,6 +563,12 @@ method's keys by defining key bindings in the keymap returned by the
function @code{quail-translation-keymap}, using @code{define-key}.
@xref{Init Rebinding}.
Input methods are inhibited when the text in the buffer is read-only
for some reason. This is so single-character key bindings work in
modes that make buffer text or parts of it read-only, such as
@code{read-only-mode} and @code{image-mode}, even when an input method
is active.
Another facility for typing characters not on your keyboard is by
using @kbd{C-x 8 @key{RET}} (@code{insert-char}) to insert a single
character based on its Unicode name or code-point; see @ref{Inserting

16
doc/emacs/package.texi
View file

@ -187,6 +187,14 @@ Filter package list by archive (@code{package-menu-filter-by-archive}).
This prompts for a package archive (e.g., @samp{gnu}), then shows only
packages from that archive.
@item / d
@kindex / d @r{(Package Menu)}
@findex package-menu-filter-by-description
Filter package list by description
(@code{package-menu-filter-by-description}). This prompts for a
regular expression, then shows only packages with descriptions
matching that regexp.
@item / k
@kindex / k @r{(Package Menu)}
@findex package-menu-filter-by-keyword
@ -194,6 +202,14 @@ Filter package list by keyword (@code{package-menu-filter-by-keyword}).
This prompts for a keyword (e.g., @samp{games}), then shows only
packages with that keyword.
@item / N
@kindex / N @r{(Package Menu)}
@findex package-menu-filter-by-name-or-description
Filter package list by name or description
(@code{package-menu-filter-by-name-or-description}). This prompts for
a regular expression, then shows only packages with a name or
description matching that regexp.
@item / n
@kindex / n @r{(Package Menu)}
@findex package-menu-filter-by-name

8
doc/lispref/edebug.texi
View file

@ -425,7 +425,8 @@ arrange to deinstrument it.
@item ?
Display the help message for Edebug (@code{edebug-help}).
@item C-]
@item a
@itemx C-]
Abort one level back to the previous command level
(@code{abort-recursive-edit}).
@ -446,7 +447,7 @@ Redisplay the most recently known expression result in the echo area
@item d
Display a backtrace, excluding Edebug's own functions for clarity
(@code{edebug-backtrace}).
(@code{edebug-pop-to-backtrace}).
@xref{Backtraces}, for a description of backtraces
and the commands which work on them.
@ -640,7 +641,8 @@ configuration is the collection of windows and contents that were in
effect outside of Edebug.
@table @kbd
@item v
@item P
@itemx v
Switch to viewing the outside window configuration
(@code{edebug-view-outside}). Type @kbd{C-x X w} to return to Edebug.

5
doc/lispref/help.texi
View file

@ -676,8 +676,9 @@ If this variable is non-@code{nil}, its value is a form to evaluate
whenever the character @code{help-char} is read. If evaluating the form
produces a string, that string is displayed.
A command that calls @code{read-event}, @code{read-char-choice}, or
@code{read-char} probably should bind @code{help-form} to a
A command that calls @code{read-event}, @code{read-char-choice},
@code{read-char}, @code{read-char-from-minibuffer}, or
@code{y-or-n-p} probably should bind @code{help-form} to a
non-@code{nil} expression while it does input. (The time when you
should not do this is when @kbd{C-h} has some other meaning.)
Evaluating this expression should result in a string that explains

10
doc/lispref/minibuf.texi
View file

@ -2109,6 +2109,11 @@ special responses @code{recenter}, @code{scroll-up},
@kbd{C-v}, @kbd{M-v}, @kbd{C-M-v} and @kbd{C-M-S-v} in
@code{query-replace-map}), this function performs the specified window
recentering or scrolling operation, and poses the question again.
If you bind @code{help-form} (@pxref{Help Functions}) to
a non-@code{nil} value while calling @code{y-or-n-p}, then pressing
@code{help-char} causes it to evaluate @code{help-form} and display
the result. @code{help-char} is automatically added to @var{prompt}.
@end defun
@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
@var{chars}, a list of accepted characters. The @var{history}
argument specifies the history list symbol to use; if it is omitted or
@code{nil}, this function doesn't use the history.
If you bind @code{help-form} (@pxref{Help Functions}) to
a non-@code{nil} value while calling @code{read-char-from-minibuffer},
then pressing @code{help-char} causes it to evaluate @code{help-form}
and display the result.
@end defun
@node Reading a Password

22
doc/lispref/os.texi
View file

@ -1077,12 +1077,19 @@ directories in a search path (as found in an environment variable). Its
value is @code{":"} for Unix and GNU systems, and @code{";"} for MS systems.
@end defvar
@defun path-separator
This function returns the connection-local value of variable
@code{path-separator}. That is @code{";"} for MS systems and a local
@code{default-directory}, and @code{":"} for Unix and GNU systems, or
a remote @code{default-directory}.
@end defun
@defun parse-colon-path path
This function takes a search path string such as the value of
the @env{PATH} environment variable, and splits it at the separators,
returning a list of directories. @code{nil} in this list means
the current directory. Although the function's name says
``colon'', it actually uses the value of @code{path-separator}.
``colon'', it actually uses the value of variable @code{path-separator}.
@example
(parse-colon-path ":/foo:/bar")
@ -1155,6 +1162,19 @@ in the system's terminal driver, before Emacs was started.
@c The value is @code{nil} if Emacs is running under a window system.
@end defvar
@defvar null-device
This variable holds the system null device. Its value is
@code{"/dev/null"} for Unix and GNU systems, and @code{"NUL"} for MS
systems.
@end defvar
@defun null-device
This function returns the connection-local value of variable
@code{null-device}. That is @code{"NUL"} for MS systems and a local
@code{default-directory}, and @code{"/dev/null"} for Unix and GNU
systems, or a remote @code{default-directory}.
@end defun
@node User Identification
@section User Identification
@cindex user identification

7
doc/lispref/windows.texi
View file

@ -5869,13 +5869,16 @@ which window parameters (if any) are saved by this function.
@xref{Window Parameters}.
@end defun
@defun set-window-configuration configuration
@defun set-window-configuration configuration &optional dont-set-frame
This function restores the configuration of windows and buffers as
specified by @var{configuration}, for the frame that
@var{configuration} was created for, regardless of whether that frame
is selected or not. The argument @var{configuration} must be a value
that was previously returned by @code{current-window-configuration}
for that frame.
for that frame. Normally the function also selects the frame which is
recorded in the configuration, but if @var{dont-set-frame} is
non-@code{nil}, it leaves selected the frame which was current at the
start of the function.
If the frame from which @var{configuration} was saved is dead, all
this function does is to restore the value of the variable

59
etc/NEWS
View file

@ -103,7 +103,7 @@ unsystematic behavior, which mixed these two is no longer available.
+++
** New system for displaying documentation for groups of functions.
This can either be used by saying 'M-x shortdoc-display-group' and
choosing a group, or clicking a button in the *Help* buffers when
choosing a group, or clicking a button in the "*Help*" buffers when
looking at the doc string of a function that belongs to one of these
groups.
@ -187,6 +187,11 @@ space characters.
freenode IRC network for years now. Occurrences of "irc.freenode.net"
have been replaced with "chat.freenode.net" throughout Emacs.
+++
** New functions 'null-device' and 'path-separator'.
These functions return the connection local value of the respective
variables. This can be used for remote hosts.
* Editing Changes in Emacs 28.1
@ -203,6 +208,12 @@ This command would previously not redefine values defined by these
forms, but this command has now been changed to work more like
'eval-defun', and reset the values as specified.
---
** New user options 'copy-region-blink-delay' and 'delete-pair-blink-delay'.
'copy-region-blink-delay' specifies a delay to indicate the region
copied by 'kill-ring-save'. 'delete-pair-blink-delay' specifies
a delay to show a paired character to delete.
+++
** New command 'undo-redo'.
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.
When a warning is displayed to the user, the resulting buffer now has
buttons which allow making permanent changes to the treatment of that
warning. Automatic showing of the warning can be disabled (although
it is still logged to the *Messages* buffer), or the warning can be
it is still logged to the "*Messages*" buffer), or the warning can be
disabled entirely.
** mspool.el
@ -471,13 +482,13 @@ tags to be considered as well.
** Gnus
+++
*** New gnus-search library
*** New gnus-search library.
A new unified search syntax which can be used across multiple
supported search engines. Set 'gnus-search-use-parsed-queries' to
non-nil to enable.
+++
*** New value for user option 'smiley-style'
*** New value for user option 'smiley-style'.
Smileys can now be rendered with emojis instead of small images when
using the new 'emoji' value in 'smiley-style'.
@ -706,6 +717,16 @@ This file was a compatibility kludge which is no longer needed.
To revert to the previous behavior,
'(setq lisp-indent-function 'lisp-indent-function)' from 'lisp-mode-hook'.
** Customize
*** Most customize commands now hide obsolete user options.
Obsolete user options are no longer shown in the listings produced by
the commands 'customize', 'customize-group', 'customize-apropos' and
'customize-changed-options'.
To customize obsolete user options, use 'customize-option' or
'customize-saved'.
** Edebug
+++
@ -825,12 +846,14 @@ equivalent to '(map (:sym sym))'.
+++
*** New commands to filter the package list.
The filter command key bindings are as follows:
The filter commands are bound to the following keys:
key binding
--- -------
/ a package-menu-filter-by-archive
/ d package-menu-filter-by-description
/ k package-menu-filter-by-keyword
/ N package-menu-filter-by-name-or-description
/ n package-menu-filter-by-name
/ s package-menu-filter-by-status
/ v package-menu-filter-by-version
@ -872,7 +895,7 @@ Customize 'gdb-max-source-window-count' to use more than one window.
Control source file display by 'gdb-display-source-buffer-action'.
+++
*** The default value of gdb-mi-decode-strings is now t.
*** The default value of 'gdb-mi-decode-strings' is now t.
This means that the default coding-system is now used to decode strings
and source file names from GDB.
@ -1141,8 +1164,8 @@ project's root directory, respectively.
** xref
---
*** Prefix arg of 'xref-goto-xref' quits the *xref* buffer.
So typing 'C-u RET' in the *xref* buffer quits its window
*** Prefix arg of 'xref-goto-xref' quits the "*xref*" buffer.
So typing 'C-u RET' in the "*xref*" buffer quits its window
before navigating to the selected location.
** json.el
@ -1305,6 +1328,11 @@ This new command (bound to 'C-c C-l') regenerates the current hunk.
** Miscellaneous
---
*** New user option 'bibtex-unify-case-convert'.
This new option allows the user to customize how case is converted
when unifying entries.
+++
*** 'format-seconds' can now be used for sub-second times.
The new optional "," parameter has been added, and
@ -1320,7 +1348,7 @@ buffers. This can be controlled by customizing the variable
---
*** New user option 'compilation-search-all-directories'.
When doing parallel builds, directories and compilation errors may
arrive in the *compilation* buffer out-of-order. If this variable is
arrive in the "*compilation*" buffer out-of-order. If this variable is
non-nil (the default), Emacs will now search backwards in the buffer
for any directory the file with errors may be in. If nil, this won't
be done (and this restores how this previously worked).
@ -1749,6 +1777,17 @@ ledit.el, lmenu.el, lucid.el and old-whitespace.el.
* Lisp Changes in Emacs 28.1
+++
** 'read-char-from-minibuffer' and 'y-or-n-p' support 'help-form'.
If you bind 'help-form' to a non-nil value while calling these functions,
then pressing 'C-h' (help-char) causes the function to evaluate 'help-form'
and display the result.
+++
** 'set-window-configuration' now takes an optional 'dont-set-frame'
parameter which, when non-nil, instructs the function not to select
the frame recorded in the configuration.
+++
** 'define-globalized-minor-mode' now takes a ':predicate' parameter.
This can be used to control which major modes the minor mode should be
@ -1992,7 +2031,7 @@ image API via 'M-x report-emacs-bug'.
--
** On macOS, 's-<left>' and 's-<right>' are now bound to
'move-beginning-of-line' and 'move-end-of-line' respectively. The commands
'move-beginning-of-line' and 'move-end-of-line' respectively. The commands
to select previous/next frame are still bound to 's-~' and 's-`'.

6
etc/PROBLEMS
View file

@ -352,11 +352,11 @@ is the current directory.
*** Set find-function-C-source-directory accordingly.
Once you have installed the source package, for example at
/home/myself/deb-src/emacs-26.3, add the following line to your
/home/myself/deb-src/emacs-27.1, add the following line to your
startup file:
(setq find-function-C-source-directory
"/home/myself/deb-src/emacs-26.3/src/")
"/home/myself/deb-src/emacs-27.1/src/")
The installation directory of the Emacs source package will contain
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
add something like the following to your startup file:
(setq find-function-C-source-directory
"/usr/src/debug/emacs-26.3-1.fc31.x86_64/src/")
"/usr/src/debug/emacs-27.1-1.fc31.x86_64/src/")
However, the exact directory name will depend on the system, and you
will need to both upgrade source and debug info when your system

36
lib-src/etags.c
View file

@ -1974,14 +1974,13 @@ make_tag (const char *name, /* tag name, or NULL if unnamed */
/* Record a tag. */
static void
pfnote (char *name, bool is_func, char *linestart, ptrdiff_t linelen,
intmax_t lno, intmax_t cno)
/* tag name, or NULL if unnamed */
/* tag is a function */
/* start of the line where tag is */
/* length of the line where tag is */
/* line number */
/* character number */
pfnote (char *name, /* tag name, or NULL if unnamed */
bool is_func, /* tag is a function */
char *linestart, /* start of the line where tag is */
ptrdiff_t linelen, /* length of the line where tag is */
intmax_t lno, /* line number */
intmax_t cno) /* character number */
{
register node *np;
@ -2905,15 +2904,13 @@ static void make_C_tag (bool);
*/
static bool
consider_token (char *str, ptrdiff_t len, int c, int *c_extp,
ptrdiff_t bracelev, ptrdiff_t parlev, bool *is_func_or_var)
/* IN: token pointer */
/* IN: token length */
/* IN: first char after the token */
/* IN, OUT: C extensions mask */
/* IN: brace level */
/* IN: parenthesis level */
/* OUT: function or variable found */
consider_token (char *str, /* IN: token pointer */
ptrdiff_t len, /* IN: token length */
int c, /* IN: first char after the token */
int *c_extp, /* IN, OUT: C extensions mask */
ptrdiff_t bracelev, /* IN: brace level */
ptrdiff_t parlev, /* IN: parenthesis level */
bool *is_func_or_var) /* OUT: function or variable found */
{
/* When structdef is stagseen, scolonseen, or snone with bracelev > 0,
structtype is the type of the preceding struct-like keyword, and
@ -3312,9 +3309,8 @@ perhaps_more_input (FILE *inf)
* C syntax and adds them to the list.
*/
static void
C_entries (int c_ext, FILE *inf)
/* extension of C */
/* input file */
C_entries (int c_ext, /* extension of C */
FILE *inf) /* input file */
{
char c; /* latest char read; '\0' for end of line */
char *lp; /* pointer one beyond the character `c' */

9
lib-src/make-fingerprint.c
View file

@ -19,9 +19,12 @@ You should have received a copy of the GNU General Public License
along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
/* The arguments given to this program are all the object files that
go into building GNU Emacs. There is no special search logic to find
the files. */
/* The argument given to this program is the initial version of the
temacs executable file used when building GNU Emacs. This program computes
a digest fingerprint for the executable, and modifies the binary in
place, replacing all instances of the existing fingerprint (normally
the default fingerprint from libgnu's lib/fingerprint.c) with the
new value. With option -r, it just prints the digest. */
#include <config.h>

11
lisp/allout.el
View file

@ -5583,12 +5583,11 @@ used verbatim."
"Return copy of STRING for literal reproduction across LaTeX processing.
Expresses the original characters (including carriage returns) of the
string across LaTeX processing."
(mapconcat (function
(lambda (char)
(cond ((memq char '(?\\ ?$ ?% ?# ?& ?{ ?} ?_ ?^ ?- ?*))
(concat "\\char" (number-to-string char) "{}"))
((= char ?\n) "\\\\")
(t (char-to-string char)))))
(mapconcat (lambda (char)
(cond ((memq char '(?\\ ?$ ?% ?# ?& ?{ ?} ?_ ?^ ?- ?*))
(concat "\\char" (number-to-string char) "{}"))
((= char ?\n) "\\\\")
(t (char-to-string char))))
string
""))
;;;_ > allout-latex-verbatim-quote-curr-line ()

35
lisp/calc/calc-aent.el
View file

@ -76,8 +76,8 @@
(calc-refresh-evaltos (nth 2 (nth 1 (car alg-exp))))
(setq alg-exp (list (nth 2 (car alg-exp)))))
(setq calc-quick-prev-results alg-exp
buf (mapconcat (function (lambda (x)
(math-format-value x 1000)))
buf (mapconcat (lambda (x)
(math-format-value x 1000))
alg-exp
" ")
shortbuf buf)
@ -197,18 +197,17 @@
(calc-language (if (memq calc-language '(nil big))
'flat calc-language))
(calc-dollar-values (mapcar
(function
(lambda (x)
(if (stringp x)
(progn
(setq x (math-read-exprs x))
(if (eq (car-safe x)
'error)
(throw 'calc-error
(calc-eval-error
(cdr x)))
(car x)))
x)))
(lambda (x)
(if (stringp x)
(progn
(setq x (math-read-exprs x))
(if (eq (car-safe x)
'error)
(throw 'calc-error
(calc-eval-error
(cdr x)))
(car x)))
x))
args))
(calc-dollar-used 0)
(res (if (stringp str)
@ -640,10 +639,10 @@ in Calc algebraic input.")
(math-find-user-tokens (car (car p)))
(setq p (cdr p)))
(setq calc-user-tokens (mapconcat 'identity
(sort (mapcar 'car math-toks)
(function (lambda (x y)
(> (length x)
(length y)))))
(sort (mapcar #'car math-toks)
(lambda (x y)
(> (length x)
(length y))))
"\\|")
calc-last-main-parse-table mtab
calc-last-user-lang-parse-table ltab

7
lisp/calc/calc-alg.el
View file

@ -1785,7 +1785,7 @@ and should return the simplified expression to use (or nil)."
(cons (nth 2 expr) math-poly-neg-powers))))
(not (Math-zerop (nth 2 expr)))
(let ((p1 (math-is-poly-rec (nth 1 expr) negpow)))
(mapcar (function (lambda (x) (math-div x (nth 2 expr))))
(mapcar (lambda (x) (math-div x (nth 2 expr)))
p1))))
((and (eq (car expr) 'calcFunc-exp)
(equal math-var '(var e var-e)))
@ -1838,8 +1838,9 @@ and should return the simplified expression to use (or nil)."
(defun math-polynomial-base (top-expr &optional pred)
"Find the variable (or sub-expression) which is the base of polynomial expr."
(let ((math-poly-base-pred
(or pred (function (lambda (base) (math-polynomial-p
top-expr base))))))
(or pred (lambda (base)
(math-polynomial-p
top-expr base)))))
(or (let ((math-poly-base-const-ok nil))
(math-polynomial-base-rec top-expr))
(let ((math-poly-base-const-ok t))

10
lisp/calc/calc-arith.el
View file

@ -2390,7 +2390,7 @@
(math-trunc (nth 3 a)))))
((math-provably-integerp a) a)
((Math-vectorp a)
(math-map-vec (function (lambda (x) (math-trunc x math-trunc-prec))) a))
(math-map-vec (lambda (x) (math-trunc x math-trunc-prec)) a))
((math-infinitep a)
(if (or (math-posp a) (math-negp a))
a
@ -2453,7 +2453,7 @@
(math-add (math-floor (nth 3 a)) -1)
(math-floor (nth 3 a)))))
((Math-vectorp a)
(math-map-vec (function (lambda (x) (math-floor x math-floor-prec))) a))
(math-map-vec (lambda (x) (math-floor x math-floor-prec)) a))
((math-infinitep a)
(if (or (math-posp a) (math-negp a))
a
@ -2520,7 +2520,7 @@
(math-ceiling (nth 2 a)))
(math-ceiling (nth 3 a))))
((Math-vectorp a)
(math-map-vec (function (lambda (x) (math-ceiling x prec))) a))
(math-map-vec (lambda (x) (math-ceiling x prec)) a))
((math-infinitep a)
(if (or (math-posp a) (math-negp a))
a
@ -2573,7 +2573,7 @@
((eq (car a) 'intv)
(math-floor (math-add a '(frac 1 2))))
((Math-vectorp a)
(math-map-vec (function (lambda (x) (math-round x prec))) a))
(math-map-vec (lambda (x) (math-round x prec)) a))
((math-infinitep a)
(if (or (math-posp a) (math-negp a))
a
@ -2656,7 +2656,7 @@
(calcFunc-scf (nth 2 x) n)
(calcFunc-scf (nth 3 x) n))))
((eq (car x) 'vec)
(math-map-vec (function (lambda (x) (calcFunc-scf x n))) x))
(math-map-vec (lambda (x) (calcFunc-scf x n)) x))
((math-infinitep x)
x)
(t

38
lisp/calc/calc-ext.el
View file

@ -678,14 +678,13 @@
(calc-init-prefixes)
(mapc (function
(lambda (x)
(mapc (lambda (x)
(define-key calc-mode-map (format "c%c" x) 'calc-clean-num)
(define-key calc-mode-map (format "j%c" x) 'calc-select-part)
(define-key calc-mode-map (format "r%c" x) 'calc-recall-quick)
(define-key calc-mode-map (format "s%c" x) 'calc-store-quick)
(define-key calc-mode-map (format "t%c" x) 'calc-store-into-quick)
(define-key calc-mode-map (format "u%c" x) 'calc-quick-units)))
(define-key calc-mode-map (format "u%c" x) 'calc-quick-units))
"0123456789")
(let ((i ?A))
@ -711,9 +710,9 @@
(define-key calc-alg-map "\e\177" 'calc-pop-above)
;;;; (Autoloads here)
(mapc (function (lambda (x)
(mapcar (function (lambda (func) (autoload func (car x))))
(cdr x))))
(mapc (lambda (x)
(mapcar (lambda (func) (autoload func (car x)))
(cdr x)))
'(
("calc-alg" calc-has-rules math-defsimplify
@ -980,9 +979,9 @@ calc-force-refresh calc-locate-cursor-element calc-show-edit-buffer)
))
(mapcar (function (lambda (x)
(mapcar (function (lambda (cmd) (autoload cmd (car x) nil t)))
(cdr x))))
(mapcar (lambda (x)
(mapcar (lambda (cmd) (autoload cmd (car x) nil t))
(cdr x)))
'(
("calc-alg" calc-alg-evaluate calc-apart calc-collect calc-expand
@ -1358,7 +1357,7 @@ calc-kill calc-kill-region calc-yank))))
calc-redo-list nil)
(let (calc-stack calc-user-parse-tables calc-standard-date-formats
calc-invocation-macro)
(mapc (function (lambda (v) (set v nil))) calc-local-var-list)
(mapc (lambda (v) (set v nil)) calc-local-var-list)
(if (and arg (<= arg 0))
(calc-mode-var-list-restore-default-values)
(calc-mode-var-list-restore-saved-values)))
@ -1658,7 +1657,7 @@ calc-kill calc-kill-region calc-yank))))
(calc-pop-stack n 1 t)
(calc-push-list (mapcar #'car entries)
1
(mapcar (function (lambda (x) (nth 2 x)))
(mapcar (lambda (x) (nth 2 x))
entries)))))))
(defvar calc-refreshing-evaltos nil)
@ -1924,11 +1923,10 @@ calc-kill calc-kill-region calc-yank))))
(let* ((calc-z-prefix-msgs nil)
(calc-z-prefix-buf "")
(kmap (sort (copy-sequence (calc-user-key-map))
(function (lambda (x y) (< (car x) (car y))))))
(lambda (x y) (< (car x) (car y)))))
(flags (apply #'logior
(mapcar (function
(lambda (k)
(calc-user-function-classify (car k))))
(mapcar (lambda (k)
(calc-user-function-classify (car k)))
kmap))))
(if (= (logand flags 8) 0)
(calc-user-function-list kmap 7)
@ -2633,9 +2631,8 @@ If X is not an error form, return 1."
(let ((rhs (calc-top-n 1)))
(calc-enter-result (- 1 n)
name
(mapcar (function
(lambda (x)
(list func x rhs)))
(mapcar (lambda (x)
(list func x rhs))
(calc-top-list-n (- n) 2))))))))
(defun calc-unary-op-fancy (name func arg)
@ -2644,9 +2641,8 @@ If X is not an error form, return 1."
(cond ((> n 0)
(calc-enter-result n
name
(mapcar (function
(lambda (x)
(list func x)))
(mapcar (lambda (x)
(list func x))
(calc-top-list-n n))))
((< n 0)
(calc-enter-result 1

2
lisp/calc/calc-forms.el
View file

@ -2129,7 +2129,7 @@ and ends on the last Sunday of October at 2 a.m."
((memq (car n) '(+ - / vec neg))
(math-normalize
(cons (car n)
(mapcar (function (lambda (x) (math-make-mod x m)))
(mapcar (lambda (x) (math-make-mod x m))
(cdr n)))))
((and (eq (car n) '*) (Math-anglep (nth 1 n)))
(math-mul (math-make-mod (nth 1 n) m) (nth 2 n)))

5
lisp/calc/calc-frac.el
View file

@ -132,9 +132,8 @@
(cond ((Math-ratp a)
a)
((memq (car a) '(cplx polar vec hms date sdev intv mod))
(cons (car a) (mapcar (function
(lambda (x)
(calcFunc-frac x tol)))
(cons (car a) (mapcar (lambda (x)
(calcFunc-frac x tol))
(cdr a))))
((Math-messy-integerp a)
(math-trunc a))

11
lisp/calc/calc-funcs.el
View file

@ -797,12 +797,11 @@
(math-reduce-vec
'math-add
(cons 'vec
(mapcar (function
(lambda (c)
(setq k (1+ k))
(math-mul (math-mul fac c)
(math-sub (math-pow x1 k)
(math-pow x2 k)))))
(mapcar (lambda (c)
(setq k (1+ k))
(math-mul (math-mul fac c)
(math-sub (math-pow x1 k)
(math-pow x2 k))))
coefs)))
x)))
(math-mul (math-pow 2 n)

50
lisp/calc/calc-help.el
View file

@ -402,32 +402,32 @@ C-w Describe how there is no warranty for Calc."
"Or type `h i' to read the full Calc manual on-line.\n\n"))
(princ "Basic keys:\n")
(let* ((calc-full-help-flag t))
(mapc (function (lambda (x) (princ (format
" %s\n"
(substitute-command-keys x)))))
(mapc (lambda (x)
(princ (format
" %s\n"
(substitute-command-keys x))))
(nreverse (cdr (reverse (cdr (calc-help))))))
(mapc (function (lambda (prefix)
(let ((msgs (ignore-errors (funcall prefix))))
(if (car msgs)
(princ
(if (eq (nth 2 msgs) ?v)
(format-message
"\n`v' or `V' prefix (vector/matrix) keys: \n")
(if (nth 2 msgs)
(format-message
"\n`%c' prefix (%s) keys:\n"
(nth 2 msgs)
(or (cdr (assq (nth 2 msgs)
calc-help-long-names))
(nth 1 msgs)))
(format "\n%s-modified keys:\n"
(capitalize (nth 1 msgs)))))))
(mapcar (function
(lambda (x)
(princ (format
" %s\n"
(substitute-command-keys x)))))
(car msgs)))))
(mapc (lambda (prefix)
(let ((msgs (ignore-errors (funcall prefix))))
(if (car msgs)
(princ
(if (eq (nth 2 msgs) ?v)
(format-message
"\n`v' or `V' prefix (vector/matrix) keys: \n")
(if (nth 2 msgs)
(format-message
"\n`%c' prefix (%s) keys:\n"
(nth 2 msgs)
(or (cdr (assq (nth 2 msgs)
calc-help-long-names))
(nth 1 msgs)))
(format "\n%s-modified keys:\n"
(capitalize (nth 1 msgs)))))))
(mapcar (lambda (x)
(princ (format
" %s\n"
(substitute-command-keys x))))
(car msgs))))
'(calc-inverse-prefix-help
calc-hyperbolic-prefix-help
calc-inv-hyp-prefix-help

362
lisp/calc/calc-lang.el
View file

@ -175,20 +175,19 @@
(put 'c 'math-vector-brackets "{}")
(put 'c 'math-radix-formatter
(function (lambda (r s)
(if (= r 16) (format "0x%s" s)
(if (= r 8) (format "0%s" s)
(format "%d#%s" r s))))))
(lambda (r s)
(if (= r 16) (format "0x%s" s)
(if (= r 8) (format "0%s" s)
(format "%d#%s" r s)))))
(put 'c 'math-compose-subscr
(function
(lambda (a)
(let ((args (cdr (cdr a))))
(list 'horiz
(math-compose-expr (nth 1 a) 1000)
"["
(math-compose-vector args ", " 0)
"]")))))
(lambda (a)
(let ((args (cdr (cdr a))))
(list 'horiz
(math-compose-expr (nth 1 a) 1000)
"["
(math-compose-vector args ", " 0)
"]"))))
(add-to-list 'calc-lang-slash-idiv 'c)
(add-to-list 'calc-lang-allow-underscores 'c)
@ -238,9 +237,9 @@
(put 'pascal 'math-output-filter 'calc-output-case-filter)
(put 'pascal 'math-radix-formatter
(function (lambda (r s)
(if (= r 16) (format "$%s" s)
(format "%d#%s" r s)))))
(lambda (r s)
(if (= r 16) (format "$%s" s)
(format "%d#%s" r s))))
(put 'pascal 'math-lang-read-symbol
'((?\$
@ -253,17 +252,16 @@
math-exp-pos (match-end 1)))))
(put 'pascal 'math-compose-subscr
(function
(lambda (a)
(let ((args (cdr (cdr a))))
(while (eq (car-safe (nth 1 a)) 'calcFunc-subscr)
(setq args (append (cdr (cdr (nth 1 a))) args)
a (nth 1 a)))
(list 'horiz
(math-compose-expr (nth 1 a) 1000)
"["
(math-compose-vector args ", " 0)
"]")))))
(lambda (a)
(let ((args (cdr (cdr a))))
(while (eq (car-safe (nth 1 a)) 'calcFunc-subscr)
(setq args (append (cdr (cdr (nth 1 a))) args)
a (nth 1 a)))
(list 'horiz
(math-compose-expr (nth 1 a) 1000)
"["
(math-compose-vector args ", " 0)
"]"))))
(add-to-list 'calc-lang-allow-underscores 'pascal)
(add-to-list 'calc-lang-brackets-are-subscripts 'pascal)
@ -350,17 +348,16 @@
math-exp-pos (match-end 0)))))
(put 'fortran 'math-compose-subscr
(function
(lambda (a)
(let ((args (cdr (cdr a))))
(while (eq (car-safe (nth 1 a)) 'calcFunc-subscr)
(setq args (append (cdr (cdr (nth 1 a))) args)
a (nth 1 a)))
(list 'horiz
(math-compose-expr (nth 1 a) 1000)
"("
(math-compose-vector args ", " 0)
")")))))
(lambda (a)
(let ((args (cdr (cdr a))))
(while (eq (car-safe (nth 1 a)) 'calcFunc-subscr)
(setq args (append (cdr (cdr (nth 1 a))) args)
a (nth 1 a)))
(list 'horiz
(math-compose-expr (nth 1 a) 1000)
"("
(math-compose-vector args ", " 0)
")"))))
(add-to-list 'calc-lang-slash-idiv 'fortran)
(add-to-list 'calc-lang-allow-underscores 'fortran)
@ -598,18 +595,17 @@
(put 'tex 'math-input-filter 'math-tex-input-filter)
(put 'tex 'math-matrix-formatter
(function
(lambda (a)
(if (and (integerp calc-language-option)
(or (= calc-language-option 0)
(> calc-language-option 1)
(< calc-language-option -1)))
(append '(vleft 0 "\\matrix{")
(math-compose-tex-matrix (cdr a))
'("}"))
(append '(horiz "\\matrix{ ")
(math-compose-tex-matrix (cdr a))
'(" }"))))))
(lambda (a)
(if (and (integerp calc-language-option)
(or (= calc-language-option 0)
(> calc-language-option 1)
(< calc-language-option -1)))
(append '(vleft 0 "\\matrix{")
(math-compose-tex-matrix (cdr a))
'("}"))
(append '(horiz "\\matrix{ ")
(math-compose-tex-matrix (cdr a))
'(" }")))))
(put 'tex 'math-var-formatter 'math-compose-tex-var)
@ -839,18 +835,17 @@
(put 'latex 'math-complex-format 'i)
(put 'latex 'math-matrix-formatter
(function
(lambda (a)
(if (and (integerp calc-language-option)
(or (= calc-language-option 0)
(> calc-language-option 1)
(< calc-language-option -1)))
(append '(vleft 0 "\\begin{pmatrix}")
(math-compose-tex-matrix (cdr a) t)
'("\\end{pmatrix}"))
(append '(horiz "\\begin{pmatrix} ")
(math-compose-tex-matrix (cdr a) t)
'(" \\end{pmatrix}"))))))
(lambda (a)
(if (and (integerp calc-language-option)
(or (= calc-language-option 0)
(> calc-language-option 1)
(< calc-language-option -1)))
(append '(vleft 0 "\\begin{pmatrix}")
(math-compose-tex-matrix (cdr a) t)
'("\\end{pmatrix}"))
(append '(horiz "\\begin{pmatrix} ")
(math-compose-tex-matrix (cdr a) t)
'(" \\end{pmatrix}")))))
(put 'latex 'math-var-formatter 'math-compose-tex-var)
@ -1023,36 +1018,34 @@
(put 'eqn 'math-evalto '("evalto " . " -> "))
(put 'eqn 'math-matrix-formatter
(function
(lambda (a)
(append '(horiz "matrix { ")
(math-compose-eqn-matrix
(cdr (math-transpose a)))
'("}")))))
(lambda (a)
(append '(horiz "matrix { ")
(math-compose-eqn-matrix
(cdr (math-transpose a)))
'("}"))))
(put 'eqn 'math-var-formatter
(function
(lambda (a prec)
(let (v)
(if (and math-compose-hash-args
(let ((p calc-arg-values))
(setq v 1)
(while (and p (not (equal (car p) a)))
(setq p (and (eq math-compose-hash-args t) (cdr p))
v (1+ v)))
p))
(if (eq math-compose-hash-args 1)
"#"
(format "#%d" v))
(if (string-match ".'\\'" (symbol-name (nth 2 a)))
(math-compose-expr
(list 'calcFunc-Prime
(list
'var
(intern (substring (symbol-name (nth 1 a)) 0 -1))
(intern (substring (symbol-name (nth 2 a)) 0 -1))))
prec)
(symbol-name (nth 1 a))))))))
(lambda (a prec)
(let (v)
(if (and math-compose-hash-args
(let ((p calc-arg-values))
(setq v 1)
(while (and p (not (equal (car p) a)))
(setq p (and (eq math-compose-hash-args t) (cdr p))
v (1+ v)))
p))
(if (eq math-compose-hash-args 1)
"#"
(format "#%d" v))
(if (string-match ".'\\'" (symbol-name (nth 2 a)))
(math-compose-expr
(list 'calcFunc-Prime
(list
'var
(intern (substring (symbol-name (nth 1 a)) 0 -1))
(intern (substring (symbol-name (nth 2 a)) 0 -1))))
prec)
(symbol-name (nth 1 a)))))))
(defconst math-eqn-special-funcs
'( calcFunc-log
@ -1065,31 +1058,30 @@
calcFunc-arcsinh calcFunc-arccosh calcFunc-arctanh))
(put 'eqn 'math-func-formatter
(function
(lambda (func a)
(let (left right)
(if (string-match "[^']'+\\'" func)
(let ((n (- (length func) (match-beginning 0) 1)))
(setq func (substring func 0 (- n)))
(while (>= (setq n (1- n)) 0)
(setq func (concat func " prime")))))
(cond ((or (> (length a) 2)
(not (math-tex-expr-is-flat (nth 1 a))))
(setq left "{left ( "
right " right )}"))
(lambda (func a)
(let (left right)
(if (string-match "[^']'+\\'" func)
(let ((n (- (length func) (match-beginning 0) 1)))
(setq func (substring func 0 (- n)))
(while (>= (setq n (1- n)) 0)
(setq func (concat func " prime")))))
(cond ((or (> (length a) 2)
(not (math-tex-expr-is-flat (nth 1 a))))
(setq left "{left ( "
right " right )}"))
((and
(memq (car a) math-eqn-special-funcs)
(= (length a) 2)
(or (Math-realp (nth 1 a))
(memq (car (nth 1 a)) '(var *))))
(setq left "~{" right "}"))
(t
(setq left " ( "
right " )")))
(list 'horiz func left
(math-compose-vector (cdr a) " , " 0)
right)))))
((and
(memq (car a) math-eqn-special-funcs)
(= (length a) 2)
(or (Math-realp (nth 1 a))
(memq (car (nth 1 a)) '(var *))))
(setq left "~{" right "}"))
(t
(setq left " ( "
right " )")))
(list 'horiz func left
(math-compose-vector (cdr a) " , " 0)
right))))
(put 'eqn 'math-lang-read-symbol
'((?\"
@ -1111,23 +1103,22 @@
("above" punc ",")))
(put 'eqn 'math-lang-adjust-words
(function
(lambda ()
(let ((code (assoc math-expr-data math-eqn-ignore-words)))
(cond ((null code))
((null (cdr code))
(math-read-token))
((consp (nth 1 code))
(math-read-token)
(if (assoc math-expr-data (cdr code))
(setq math-expr-data (format "%s %s"
(car code) math-expr-data))))
((eq (nth 1 code) 'punc)
(setq math-exp-token 'punc
math-expr-data (nth 2 code)))
(t
(math-read-token)
(math-read-token)))))))
(lambda ()
(let ((code (assoc math-expr-data math-eqn-ignore-words)))
(cond ((null code))
((null (cdr code))
(math-read-token))
((consp (nth 1 code))
(math-read-token)
(if (assoc math-expr-data (cdr code))
(setq math-expr-data (format "%s %s"
(car code) math-expr-data))))
((eq (nth 1 code) 'punc)
(setq math-exp-token 'punc
math-expr-data (nth 2 code)))
(t
(math-read-token)
(math-read-token))))))
(put 'eqn 'math-lang-read
'((eq (string-match "->\\|<-\\|\\+-\\|\\\\dots\\|~\\|\\^"
@ -1357,14 +1348,13 @@
( calcFunc-in . (math-lang-compose-switch-args "Contains"))))
(put 'yacas 'math-compose-subscr
(function
(lambda (a)
(let ((args (cdr (cdr a))))
(list 'horiz
(math-compose-expr (nth 1 a) 1000)
"["
(math-compose-vector args ", " 0)
"]")))))
(lambda (a)
(let ((args (cdr (cdr a))))
(list 'horiz
(math-compose-expr (nth 1 a) 1000)
"["
(math-compose-vector args ", " 0)
"]"))))
(defun math-yacas-parse-Sum (f _val)
"Read in the arguments to \"Sum\" in Calc's Yacas mode."
@ -1600,24 +1590,22 @@
(add-to-list 'calc-lang-brackets-are-subscripts 'maxima)
(put 'maxima 'math-compose-subscr
(function
(lambda (a)
(let ((args (cdr (cdr a))))
(list 'horiz
(math-compose-expr (nth 1 a) 1000)
"["
(math-compose-vector args ", " 0)
"]")))))
(lambda (a)
(let ((args (cdr (cdr a))))
(list 'horiz
(math-compose-expr (nth 1 a) 1000)
"["
(math-compose-vector args ", " 0)
"]"))))
(put 'maxima 'math-matrix-formatter
(function
(lambda (a)
(list 'horiz
"matrix("
(math-compose-vector (cdr a)
(concat math-comp-comma " ")
math-comp-vector-prec)
")"))))
(lambda (a)
(list 'horiz
"matrix("
(math-compose-vector (cdr a)
(concat math-comp-comma " ")
math-comp-vector-prec)
")")))
;;; Giac
@ -1806,15 +1794,14 @@ order to Calc's."
(add-to-list 'calc-lang-allow-underscores 'giac)
(put 'giac 'math-compose-subscr
(function
(lambda (a)
;; (let ((args (cdr (cdr a))))
(list 'horiz
(math-compose-expr (nth 1 a) 1000)
"["
(math-compose-expr
(calc-normalize (list '- (nth 2 a) 1)) 0)
"]")))) ;;)
(lambda (a)
;; (let ((args (cdr (cdr a))))
(list 'horiz
(math-compose-expr (nth 1 a) 1000)
"["
(math-compose-expr
(calc-normalize (list '- (nth 2 a) 1)) 0)
"]"))) ;;)
(defun math-read-giac-subscr (x _op)
(let ((idx (math-read-expr-level 0)))
@ -1932,7 +1919,7 @@ order to Calc's."
(put 'math 'math-function-close "]")
(put 'math 'math-radix-formatter
(function (lambda (r s) (format "%d^^%s" r s))))
(lambda (r s) (format "%d^^%s" r s)))
(put 'math 'math-lang-read
'((eq (string-match "\\[\\[\\|->\\|:>" math-exp-str math-exp-pos)
@ -1942,13 +1929,12 @@ order to Calc's."
math-exp-pos (match-end 0))))
(put 'math 'math-compose-subscr
(function
(lambda (a)
(list 'horiz
(math-compose-expr (nth 1 a) 1000)
"[["
(math-compose-expr (nth 2 a) 0)
"]]"))))
(lambda (a)
(list 'horiz
(math-compose-expr (nth 1 a) 1000)
"[["
(math-compose-expr (nth 2 a) 0)
"]]")))
(defun math-read-math-subscr (x _op)
(let ((idx (math-read-expr-level 0)))
@ -2038,26 +2024,24 @@ order to Calc's."
(put 'maple 'math-complex-format 'I)
(put 'maple 'math-matrix-formatter
(function
(lambda (a)
(list 'horiz
"matrix("
math-comp-left-bracket
(math-compose-vector (cdr a)
(concat math-comp-comma " ")
math-comp-vector-prec)
math-comp-right-bracket
")"))))
(lambda (a)
(list 'horiz
"matrix("
math-comp-left-bracket
(math-compose-vector (cdr a)
(concat math-comp-comma " ")
math-comp-vector-prec)
math-comp-right-bracket
")")))
(put 'maple 'math-compose-subscr
(function
(lambda (a)
(let ((args (cdr (cdr a))))
(list 'horiz
(math-compose-expr (nth 1 a) 1000)
"["
(math-compose-vector args ", " 0)
"]")))))
(lambda (a)
(let ((args (cdr (cdr a))))
(list 'horiz
(math-compose-expr (nth 1 a) 1000)
"["
(math-compose-vector args ", " 0)
"]"))))
(add-to-list 'calc-lang-allow-underscores 'maple)
(add-to-list 'calc-lang-brackets-are-subscripts 'maple)

6
lisp/calc/calc-macs.el
View file

@ -33,12 +33,12 @@
(defmacro calc-wrapper (&rest body)
`(calc-do (function (lambda ()
,@body))))
`(calc-do (lambda ()
,@body)))
(defmacro calc-slow-wrapper (&rest body)
`(calc-do
(function (lambda () ,@body)) (point)))
(lambda () ,@body) (point)))
(defmacro math-showing-full-precision (form)
`(let ((calc-float-format calc-full-float-format))

43
lisp/calc/calc-map.el
View file

@ -612,14 +612,13 @@
"()")
minibuffer-local-map
t)))
(setq math-arglist (mapcar (function
(lambda (x)
(list 'var
x
(intern
(concat
"var-"
(symbol-name x))))))
(setq math-arglist (mapcar (lambda (x)
(list 'var
x
(intern
(concat
"var-"
(symbol-name x)))))
math-arglist))))
(setq oper (list "$"
(length math-arglist)
@ -962,12 +961,12 @@
(apply 'calcFunc-mapeqp func args)))
(defun calcFunc-mapeqr (func &rest args)
(setq args (mapcar (function (lambda (x)
(let ((func (assq (car-safe x)
calc-tweak-eqn-table)))
(if func
(cons (nth 1 func) (cdr x))
x))))
(setq args (mapcar (lambda (x)
(let ((func (assq (car-safe x)
calc-tweak-eqn-table)))
(if func
(cons (nth 1 func) (cdr x))
x)))
args))
(apply 'calcFunc-mapeqp func args))
@ -1092,28 +1091,28 @@
(defun calcFunc-reducea (func vec)
(if (math-matrixp vec)
(cons 'vec
(mapcar (function (lambda (x) (calcFunc-reducer func x)))
(mapcar (lambda (x) (calcFunc-reducer func x))
(cdr vec)))
(calcFunc-reducer func vec)))
(defun calcFunc-rreducea (func vec)
(if (math-matrixp vec)
(cons 'vec
(mapcar (function (lambda (x) (calcFunc-rreducer func x)))
(mapcar (lambda (x) (calcFunc-rreducer func x))
(cdr vec)))
(calcFunc-rreducer func vec)))
(defun calcFunc-reduced (func vec)
(if (math-matrixp vec)
(cons 'vec
(mapcar (function (lambda (x) (calcFunc-reducer func x)))
(mapcar (lambda (x) (calcFunc-reducer func x))
(cdr (math-transpose vec))))
(calcFunc-reducer func vec)))
(defun calcFunc-rreduced (func vec)
(if (math-matrixp vec)
(cons 'vec
(mapcar (function (lambda (x) (calcFunc-rreducer func x)))
(mapcar (lambda (x) (calcFunc-rreducer func x))
(cdr (math-transpose vec))))
(calcFunc-rreducer func vec)))
@ -1216,10 +1215,10 @@
(let ((mat nil))
(while (setq a (cdr a))
(setq mat (cons (cons 'vec
(mapcar (function (lambda (x)
(math-build-call func
(list (car a)
x))))
(mapcar (lambda (x)
(math-build-call func
(list (car a)
x)))
(cdr b)))
mat)))
(math-normalize (cons 'vec (nreverse mat)))))

11
lisp/calc/calc-misc.el
View file

@ -176,9 +176,9 @@ Calc user interface as before (either C-x * C or C-x * K; initially C-x * C).
"Create another, independent Calculator buffer."
(interactive)
(if (eq major-mode 'calc-mode)
(mapc (function
(lambda (v)
(set-default v (symbol-value v)))) calc-local-var-list))
(mapc (lambda (v)
(set-default v (symbol-value v)))
calc-local-var-list))
(set-buffer (generate-new-buffer "*Calculator*"))
(pop-to-buffer (current-buffer))
(calc-mode))
@ -274,9 +274,8 @@ Calc user interface as before (either C-x * C or C-x * K; initially C-x * C).
;;;###autoload
(defun calc-do-handle-whys ()
(setq calc-why (sort calc-next-why
(function
(lambda (x y)
(and (eq (car x) '*) (not (eq (car y) '*))))))
(lambda (x y)
(and (eq (car x) '*) (not (eq (car y) '*)))))
calc-next-why nil)
(if (and calc-why (or (eq calc-auto-why t)
(and (eq (car (car calc-why)) '*)

2
lisp/calc/calc-mode.el
View file

@ -268,7 +268,7 @@
(interactive)
(calc-wrapper
(let (pos
(vals (mapcar (function (lambda (v) (symbol-value (car v))))
(vals (mapcar (lambda (v) (symbol-value (car v)))
calc-mode-var-list)))
(unless calc-settings-file
(error "No `calc-settings-file' specified"))

6
lisp/calc/calc-mtx.el
View file

@ -55,7 +55,7 @@
(defun math-col-matrix (a)
(if (and (Math-vectorp a)
(not (math-matrixp a)))
(cons 'vec (mapcar (function (lambda (x) (list 'vec x))) (cdr a)))
(cons 'vec (mapcar (lambda (x) (list 'vec x)) (cdr a)))
a))
@ -79,8 +79,8 @@
(cons 'vec (nreverse mat))))
(defun math-mul-mat-vec (a b)
(cons 'vec (mapcar (function (lambda (row)
(math-dot-product row b)))
(cons 'vec (mapcar (lambda (row)
(math-dot-product row b))
(cdr a))))

21
lisp/calc/calc-poly.el
View file

@ -202,7 +202,7 @@
(if (memq (car-safe expr) '(+ -))
(math-list-to-sum
(sort (math-sum-to-list expr)
(function (lambda (a b) (math-beforep (car a) (car b))))))
(lambda (a b) (math-beforep (car a) (car b)))))
expr))
(defun math-list-to-sum (lst)
@ -387,7 +387,7 @@ This returns only the remainder from the pseudo-division."
lst
(if (eq a -1)
(math-mul-list lst a)
(mapcar (function (lambda (x) (math-poly-div-exact x a))) lst))))
(mapcar (lambda (x) (math-poly-div-exact x a)) lst))))
(defun math-mul-list (lst a)
(if (eq a 1)
@ -395,7 +395,7 @@ This returns only the remainder from the pseudo-division."
(if (eq a -1)
(mapcar 'math-neg lst)
(and (not (eq a 0))
(mapcar (function (lambda (x) (math-mul x a))) lst)))))
(mapcar (lambda (x) (math-mul x a)) lst)))))
;;; Run GCD on all elements in a list.
(defun math-poly-gcd-list (lst)
@ -502,10 +502,10 @@ Take the base that has the highest degree considering both a and b.
(defun math-sort-poly-base-list (lst)
"Sort a list of polynomial bases."
(sort lst (function (lambda (a b)
(or (> (nth 1 a) (nth 1 b))
(and (= (nth 1 a) (nth 1 b))
(math-beforep (car a) (car b))))))))
(sort lst (lambda (a b)
(or (> (nth 1 a) (nth 1 b))
(and (= (nth 1 a) (nth 1 b))
(math-beforep (car a) (car b)))))))
;;; Given an expression find all variables that are polynomial bases.
;;; Return list in the form '( (var1 degree1) (var2 degree2) ... ).
@ -1033,10 +1033,9 @@ If no partial fraction representation can be found, return nil."
(math-transpose
(cons 'vec
(mapcar
(function
(lambda (x)
(cons 'vec (math-padded-polynomial
x var tdeg))))
(lambda (x)
(cons 'vec (math-padded-polynomial
x var tdeg)))
(cdr eqns))))))
(and (math-vectorp eqns)
(let ((res 0)

14
lisp/calc/calc-prog.el
View file

@ -182,7 +182,7 @@
odef key keyname cmd cmd-base cmd-base-default
func calc-user-formula-alist is-symb)
(if is-lambda
(setq math-arglist (mapcar (function (lambda (x) (nth 1 x)))
(setq math-arglist (mapcar (lambda (x) (nth 1 x))
(nreverse (cdr (reverse (cdr form)))))
form (nth (1- (length form)) form))
(calc-default-formula-arglist form)
@ -290,10 +290,10 @@
(y-or-n-p
"Leave it symbolic for non-constant arguments? ")))
(setq calc-user-formula-alist
(mapcar (function (lambda (x)
(or (cdr (assq x '((nil . arg-nil)
(t . arg-t))))
x))) calc-user-formula-alist))
(mapcar (lambda (x)
(or (cdr (assq x '((nil . arg-nil)
(t . arg-t))))
x)) calc-user-formula-alist))
(if cmd
(progn
(require 'calc-macs)
@ -319,8 +319,8 @@
(append
(list 'lambda calc-user-formula-alist)
(and is-symb
(mapcar (function (lambda (v)
(list 'math-check-const v t)))
(mapcar (lambda (v)
(list 'math-check-const v t))
calc-user-formula-alist))
(list body))))
(put func 'calc-user-defn form)

77
lisp/calc/calc-rewr.el
View file

@ -181,19 +181,18 @@
(calc-line-numbering nil)
(calc-show-selections t)
(calc-why nil)
(math-mt-func (function
(lambda (x)
(let ((result (math-apply-rewrites x (cdr crules)
heads crules)))
(if result
(progn
(if trace-buffer
(let ((fmt (math-format-stack-value
(list result nil nil))))
(with-current-buffer trace-buffer
(insert "\nrewrite to\n" fmt "\n"))))
(setq heads (math-rewrite-heads result heads t))))
result)))))
(math-mt-func (lambda (x)
(let ((result (math-apply-rewrites x (cdr crules)
heads crules)))
(if result
(progn
(if trace-buffer
(let ((fmt (math-format-stack-value
(list result nil nil))))
(with-current-buffer trace-buffer
(insert "\nrewrite to\n" fmt "\n"))))
(setq heads (math-rewrite-heads result heads t))))
result))))
(if trace-buffer
(let ((fmt (math-format-stack-value (list math-rewrite-whole-expr nil nil))))
(with-current-buffer trace-buffer
@ -485,8 +484,8 @@
(let ((math-rewrite-whole t))
(cdr (math-compile-rewrites (cons
'vec
(mapcar (function (lambda (x)
(list 'vec x t)))
(mapcar (lambda (x)
(list 'vec x t))
(if (eq (car-safe pats) 'vec)
(cdr pats)
(list pats)))))))))
@ -656,15 +655,14 @@
nil
(nreverse
(mapcar
(function
(lambda (v)
(and (car v)
(list
'calcFunc-assign
(math-build-var-name
(car v))
(math-rwcomp-register-expr
(nth 1 v))))))
(lambda (v)
(and (car v)
(list
'calcFunc-assign
(math-build-var-name
(car v))
(math-rwcomp-register-expr
(nth 1 v)))))
math-regs))))
(math-rwcomp-match-vars math-rhs))
math-remembering)
@ -672,7 +670,7 @@
(let* ((heads (math-rewrite-heads math-pattern))
(rule (list (vconcat
(nreverse
(mapcar (function (lambda (x) (nth 3 x)))
(mapcar (lambda (x) (nth 3 x))
math-regs)))
math-prog
heads
@ -724,10 +722,9 @@
(setq rules (cdr rules)))
(if nil-rules
(setq rule-set (cons (cons nil nil-rules) rule-set)))
(setq all-heads (mapcar 'car
(sort all-heads (function
(lambda (x y)
(< (cdr x) (cdr y)))))))
(setq all-heads (mapcar #'car
(sort all-heads (lambda (x y)
(< (cdr x) (cdr y))))))
(let ((set rule-set)
rule heads ptr)
(while set
@ -790,15 +787,14 @@
(math-rewrite-heads-rec (car expr)))))))
(defun math-parse-schedule (sched)
(mapcar (function
(lambda (s)
(if (integerp s)
s
(if (math-vectorp s)
(math-parse-schedule (cdr s))
(if (eq (car-safe s) 'var)
(math-var-to-calcFunc s)
(error "Improper component in rewrite schedule"))))))
(mapcar (lambda (s)
(if (integerp s)
s
(if (math-vectorp s)
(math-parse-schedule (cdr s))
(if (eq (car-safe s) 'var)
(math-var-to-calcFunc s)
(error "Improper component in rewrite schedule")))))
sched))
(defun math-rwcomp-match-vars (expr)
@ -1180,9 +1176,8 @@
(list 'calcFunc-register
reg2))))
(math-rwcomp-pattern (car arg2) (cdr arg2))))
(let* ((args (mapcar (function
(lambda (x)
(cons x (math-rwcomp-best-reg x))))
(let* ((args (mapcar (lambda (x)
(cons x (math-rwcomp-best-reg x)))
(cdr expr)))
(args2 (copy-sequence args))
(argp (reverse args2))

71
lisp/calc/calc-store.el
View file

@ -168,15 +168,13 @@
()
(setq calc-var-name-map (copy-keymap minibuffer-local-completion-map))
(define-key calc-var-name-map " " 'self-insert-command)
(mapc (function
(lambda (x)
(mapc (lambda (x)
(define-key calc-var-name-map (char-to-string x)
'calcVar-digit)))
'calcVar-digit))
"0123456789")
(mapc (function
(lambda (x)
(mapc (lambda (x)
(define-key calc-var-name-map (char-to-string x)
'calcVar-oper)))
'calcVar-oper))
"+-*/^|"))
(defvar calc-store-opers)
@ -324,10 +322,9 @@
(calc-pop-push-record
(1+ calc-given-value-flag)
(concat "=" (calc-var-name (car (car var))))
(let ((saved-val (mapcar (function
(lambda (v)
(and (boundp (car v))
(symbol-value (car v)))))
(let ((saved-val (mapcar (lambda (v)
(and (boundp (car v))
(symbol-value (car v))))
var)))
(unwind-protect
(let ((vv var))
@ -597,13 +594,12 @@
calc-settings-file)))
(if var
(calc-insert-permanent-variable var)
(mapatoms (function
(lambda (x)
(and (string-match "\\`var-" (symbol-name x))
(not (memq x calc-dont-insert-variables))
(calc-var-value x)
(not (eq (car-safe (symbol-value x)) 'special-const))
(calc-insert-permanent-variable x))))))
(mapatoms (lambda (x)
(and (string-match "\\`var-" (symbol-name x))
(not (memq x calc-dont-insert-variables))
(calc-var-value x)
(not (eq (car-safe (symbol-value x)) 'special-const))
(calc-insert-permanent-variable x)))))
(save-buffer))))
@ -638,27 +634,26 @@
(defun calc-insert-variables (buf)
(interactive "bBuffer in which to save variable values: ")
(with-current-buffer buf
(mapatoms (function
(lambda (x)
(and (string-match "\\`var-" (symbol-name x))
(not (memq x calc-dont-insert-variables))
(calc-var-value x)
(not (eq (car-safe (symbol-value x)) 'special-const))
(or (not (eq x 'var-Decls))
(not (equal var-Decls '(vec))))
(or (not (eq x 'var-Holidays))
(not (equal var-Holidays '(vec (var sat var-sat)
(var sun var-sun)))))
(insert "(setq "
(symbol-name x)
" "
(prin1-to-string
(let ((calc-language
(if (memq calc-language '(nil big))
'flat
calc-language)))
(math-format-value (symbol-value x) 100000)))
")\n")))))))
(mapatoms (lambda (x)
(and (string-match "\\`var-" (symbol-name x))
(not (memq x calc-dont-insert-variables))
(calc-var-value x)
(not (eq (car-safe (symbol-value x)) 'special-const))
(or (not (eq x 'var-Decls))
(not (equal var-Decls '(vec))))
(or (not (eq x 'var-Holidays))
(not (equal var-Holidays '(vec (var sat var-sat)
(var sun var-sun)))))
(insert "(setq "
(symbol-name x)
" "
(prin1-to-string
(let ((calc-language
(if (memq calc-language '(nil big))
'flat
calc-language)))
(math-format-value (symbol-value x) 100000)))
")\n"))))))
(defun calc-assign (arg)
(interactive "P")

6
lisp/calc/calc-stuff.el
View file

@ -182,7 +182,7 @@ With a prefix, push that prefix as a number onto the stack."
math-eval-rules-cache-tag t
math-format-date-cache nil
math-holidays-cache-tag t)
(mapc (function (lambda (x) (set x -100))) math-cache-list)
(mapc (lambda (x) (set x -100)) math-cache-list)
(unless inhibit-msg
(message "All internal calculator caches have been reset"))))
@ -258,14 +258,14 @@ With a prefix, push that prefix as a number onto the stack."
(t (list 'calcFunc-clean a)))))
(defun calcFunc-pclean (a &optional prec)
(math-map-over-constants (function (lambda (x) (calcFunc-clean x prec)))
(math-map-over-constants (lambda (x) (calcFunc-clean x prec))
a))
(defun calcFunc-pfloat (a)
(math-map-over-constants 'math-float a))
(defun calcFunc-pfrac (a &optional tol)
(math-map-over-constants (function (lambda (x) (calcFunc-frac x tol)))
(math-map-over-constants (lambda (x) (calcFunc-frac x tol))
a))
;; The variable math-moc-func is local to math-map-over-constants,

40
lisp/calc/calc-units.el
View file

@ -860,23 +860,22 @@ If COMP or STD is non-nil, put that in the units table instead."
tab)
(message "Building units table...")
(setq math-units-table-buffer-valid nil)
(setq tab (mapcar (function
(lambda (x)
(list (car x)
(and (nth 1 x)
(if (stringp (nth 1 x))
(let ((exp (math-read-plain-expr
(nth 1 x))))
(if (eq (car-safe exp) 'error)
(error "Format error in definition of %s in units table: %s"
(car x) (nth 2 exp))
exp))
(nth 1 x)))
(nth 2 x)
(nth 3 x)
(and (not (nth 1 x))
(list (cons (car x) 1)))
(nth 4 x))))
(setq tab (mapcar (lambda (x)
(list (car x)
(and (nth 1 x)
(if (stringp (nth 1 x))
(let ((exp (math-read-plain-expr
(nth 1 x))))
(if (eq (car-safe exp) 'error)
(error "Format error in definition of %s in units table: %s"
(car x) (nth 2 exp))
exp))
(nth 1 x)))
(nth 2 x)
(nth 3 x)
(and (not (nth 1 x))
(list (cons (car x) 1)))
(nth 4 x)))
combined-units))
(let ((math-units-table tab))
(mapc #'math-find-base-units tab))
@ -1100,10 +1099,9 @@ If COMP or STD is non-nil, put that in the units table instead."
(setq math-decompose-units-cache
(cons entry
(sort ulist
(function
(lambda (x y)
(not (Math-lessp (nth 1 x)
(nth 1 y))))))))))
(lambda (x y)
(not (Math-lessp (nth 1 x)
(nth 1 y)))))))))
(cdr math-decompose-units-cache))))
(defun math-decompose-unit-part (unit)

18
lisp/calc/calc-vec.el
View file

@ -744,7 +744,7 @@
;;; Get the Nth row of a matrix.
(defun calcFunc-mrow (mat n) ; [Public]
(if (Math-vectorp n)
(math-map-vec (function (lambda (x) (calcFunc-mrow mat x))) n)
(math-map-vec (lambda (x) (calcFunc-mrow mat x)) n)
(if (and (eq (car-safe n) 'intv) (math-constp n))
(calcFunc-subvec mat
(math-add (nth 2 n) (if (memq (nth 1 n) '(2 3)) 0 1))
@ -768,15 +768,15 @@
;;; Get the Nth column of a matrix.
(defun math-mat-col (mat n)
(cons 'vec (mapcar (function (lambda (x) (elt x n))) (cdr mat))))
(cons 'vec (mapcar (lambda (x) (elt x n)) (cdr mat))))
(defun calcFunc-mcol (mat n) ; [Public]
(if (Math-vectorp n)
(calcFunc-trn
(math-map-vec (function (lambda (x) (calcFunc-mcol mat x))) n))
(math-map-vec (lambda (x) (calcFunc-mcol mat x)) n))
(if (and (eq (car-safe n) 'intv) (math-constp n))
(if (math-matrixp mat)
(math-map-vec (function (lambda (x) (calcFunc-mrow x n))) mat)
(math-map-vec (lambda (x) (calcFunc-mrow x n)) mat)
(calcFunc-mrow mat n))
(or (and (integerp (setq n (math-check-integer n)))
(> n 0))
@ -804,7 +804,7 @@
;;; Remove the Nth column from a matrix.
(defun math-mat-less-col (mat n)
(cons 'vec (mapcar (function (lambda (x) (math-mat-less-row x n)))
(cons 'vec (mapcar (lambda (x) (math-mat-less-row x n))
(cdr mat))))
(defun calcFunc-mrcol (mat n) ; [Public]
@ -939,10 +939,10 @@
(calcFunc-idn a (1- (length m)))
(if (math-vectorp m)
(if (math-zerop a)
(cons 'vec (mapcar (function (lambda (x)
(if (math-vectorp x)
(math-mimic-ident a x)
a)))
(cons 'vec (mapcar (lambda (x)
(if (math-vectorp x)
(math-mimic-ident a x)
a))
(cdr m)))
(math-dimension-error))
(calcFunc-idn a))))

11
lisp/calc/calc-yank.el
View file

@ -643,12 +643,11 @@ Interactively, reads the register using `register-read-with-preview'."
(allow-ret (> n 1))
(list (math-showing-full-precision
(mapcar (if (> n 1)
(function (lambda (x)
(math-format-flat-expr x 0)))
(function
(lambda (x)
(if (math-vectorp x) (setq allow-ret t))
(math-format-nice-expr x (frame-width)))))
(lambda (x)
(math-format-flat-expr x 0))
(lambda (x)
(if (math-vectorp x) (setq allow-ret t))
(math-format-nice-expr x (frame-width))))
(if (> n 0)
(calc-top-list n)
(calc-top-list 1 (- n)))))))

11
lisp/calc/calc.el
View file

@ -506,7 +506,7 @@ The variable VAR will be added to `calc-mode-var-list'."
(defun calc-mode-var-list-restore-default-values ()
"Restore the default values of the variables in `calc-mode-var-list'."
(mapcar (function (lambda (v) (set (car v) (nth 1 v))))
(mapcar (lambda (v) (set (car v) (nth 1 v)))
calc-mode-var-list))
(defun calc-mode-var-list-restore-saved-values ()
@ -535,7 +535,7 @@ The variable VAR will be added to `calc-mode-var-list'."
newvarlist)))
(setq varlist (cdr varlist)))))))
(if newvarlist
(mapcar (function (lambda (v) (set (car v) (nth 1 v))))
(mapcar (lambda (v) (set (car v) (nth 1 v)))
newvarlist)
(calc-mode-var-list-restore-default-values))))
@ -1315,8 +1315,9 @@ Notations: 3.14e6 3.14 * 10^6
\\{calc-mode-map}
"
(interactive)
(mapc (function ;FIXME: Why (set-default v (symbol-value v)) ?!?!?
(lambda (v) (set-default v (symbol-value v))))
(mapc (lambda (v)
;; FIXME: Why (set-default v (symbol-value v)) ?!?!?
(set-default v (symbol-value v)))
calc-local-var-list)
(kill-all-local-variables)
(use-local-map (if (eq calc-algebraic-mode 'total)
@ -1537,7 +1538,7 @@ See `window-dedicated-p' for what that means."
(let ((tail (nthcdr (1- calc-undo-length) calc-undo-list)))
(if tail (setcdr tail nil)))
(setq calc-redo-list nil))))
(mapc (function (lambda (v) (set-default v (symbol-value v))))
(mapc (lambda (v) (set-default v (symbol-value v)))
calc-local-var-list)
(let ((buf (current-buffer))
(win (get-buffer-window (current-buffer)))

583
lisp/calc/calcalg2.el
View file

@ -361,175 +361,175 @@
res))))
(put 'calcFunc-inv\' 'math-derivative-1
(function (lambda (u) (math-neg (math-div 1 (math-sqr u))))))
(lambda (u) (math-neg (math-div 1 (math-sqr u)))))
(put 'calcFunc-sqrt\' 'math-derivative-1
(function (lambda (u) (math-div 1 (math-mul 2 (list 'calcFunc-sqrt u))))))
(lambda (u) (math-div 1 (math-mul 2 (list 'calcFunc-sqrt u)))))
(put 'calcFunc-deg\' 'math-derivative-1
(function (lambda (_) (math-div-float '(float 18 1) (math-pi)))))
(lambda (_) (math-div-float '(float 18 1) (math-pi))))
(put 'calcFunc-rad\' 'math-derivative-1
(function (lambda (_) (math-pi-over-180))))
(lambda (_) (math-pi-over-180)))
(put 'calcFunc-ln\' 'math-derivative-1
(function (lambda (u) (math-div 1 u))))
(lambda (u) (math-div 1 u)))
(put 'calcFunc-log10\' 'math-derivative-1
(function (lambda (u)
(math-div (math-div 1 (math-normalize '(calcFunc-ln 10)))
u))))
(lambda (u)
(math-div (math-div 1 (math-normalize '(calcFunc-ln 10)))
u)))
(put 'calcFunc-lnp1\' 'math-derivative-1
(function (lambda (u) (math-div 1 (math-add u 1)))))
(lambda (u) (math-div 1 (math-add u 1))))
(put 'calcFunc-log\' 'math-derivative-2
(function (lambda (x b)
(and (not (Math-zerop b))
(let ((lnv (math-normalize
(list 'calcFunc-ln b))))
(math-div 1 (math-mul lnv x)))))))
(lambda (x b)
(and (not (Math-zerop b))
(let ((lnv (math-normalize
(list 'calcFunc-ln b))))
(math-div 1 (math-mul lnv x))))))
(put 'calcFunc-log\'2 'math-derivative-2
(function (lambda (x b)
(let ((lnv (list 'calcFunc-ln b)))
(math-neg (math-div (list 'calcFunc-log x b)
(math-mul lnv b)))))))
(lambda (x b)
(let ((lnv (list 'calcFunc-ln b)))
(math-neg (math-div (list 'calcFunc-log x b)
(math-mul lnv b))))))
(put 'calcFunc-exp\' 'math-derivative-1
(function (lambda (u) (math-normalize (list 'calcFunc-exp u)))))
(lambda (u) (math-normalize (list 'calcFunc-exp u))))
(put 'calcFunc-expm1\' 'math-derivative-1
(function (lambda (u) (math-normalize (list 'calcFunc-expm1 u)))))
(lambda (u) (math-normalize (list 'calcFunc-expm1 u))))
(put 'calcFunc-sin\' 'math-derivative-1
(function (lambda (u) (math-to-radians-2 (math-normalize
(list 'calcFunc-cos u)) t))))
(lambda (u) (math-to-radians-2 (math-normalize
(list 'calcFunc-cos u)) t)))
(put 'calcFunc-cos\' 'math-derivative-1
(function (lambda (u) (math-neg (math-to-radians-2
(math-normalize
(list 'calcFunc-sin u)) t)))))
(lambda (u) (math-neg (math-to-radians-2
(math-normalize
(list 'calcFunc-sin u)) t))))
(put 'calcFunc-tan\' 'math-derivative-1
(function (lambda (u) (math-to-radians-2
(math-sqr
(math-normalize
(list 'calcFunc-sec u))) t))))
(lambda (u) (math-to-radians-2
(math-sqr
(math-normalize
(list 'calcFunc-sec u))) t)))
(put 'calcFunc-sec\' 'math-derivative-1
(function (lambda (u) (math-to-radians-2
(math-mul
(math-normalize
(list 'calcFunc-sec u))
(math-normalize
(list 'calcFunc-tan u))) t))))
(lambda (u) (math-to-radians-2
(math-mul
(math-normalize
(list 'calcFunc-sec u))
(math-normalize
(list 'calcFunc-tan u))) t)))
(put 'calcFunc-csc\' 'math-derivative-1
(function (lambda (u) (math-neg
(math-to-radians-2
(math-mul
(math-normalize
(list 'calcFunc-csc u))
(math-normalize
(list 'calcFunc-cot u))) t)))))
(lambda (u) (math-neg
(math-to-radians-2
(math-mul
(math-normalize
(list 'calcFunc-csc u))
(math-normalize
(list 'calcFunc-cot u))) t))))
(put 'calcFunc-cot\' 'math-derivative-1
(function (lambda (u) (math-neg
(math-to-radians-2
(math-sqr
(math-normalize
(list 'calcFunc-csc u))) t)))))
(lambda (u) (math-neg
(math-to-radians-2
(math-sqr
(math-normalize
(list 'calcFunc-csc u))) t))))
(put 'calcFunc-arcsin\' 'math-derivative-1
(function (lambda (u)
(math-from-radians-2
(math-div 1 (math-normalize
(list 'calcFunc-sqrt
(math-sub 1 (math-sqr u))))) t))))
(lambda (u)
(math-from-radians-2
(math-div 1 (math-normalize
(list 'calcFunc-sqrt
(math-sub 1 (math-sqr u))))) t)))
(put 'calcFunc-arccos\' 'math-derivative-1
(function (lambda (u)
(math-from-radians-2
(math-div -1 (math-normalize
(list 'calcFunc-sqrt
(math-sub 1 (math-sqr u))))) t))))
(lambda (u)
(math-from-radians-2
(math-div -1 (math-normalize
(list 'calcFunc-sqrt
(math-sub 1 (math-sqr u))))) t)))
(put 'calcFunc-arctan\' 'math-derivative-1
(function (lambda (u) (math-from-radians-2
(math-div 1 (math-add 1 (math-sqr u))) t))))
(lambda (u) (math-from-radians-2
(math-div 1 (math-add 1 (math-sqr u))) t)))
(put 'calcFunc-sinh\' 'math-derivative-1
(function (lambda (u) (math-normalize (list 'calcFunc-cosh u)))))
(lambda (u) (math-normalize (list 'calcFunc-cosh u))))
(put 'calcFunc-cosh\' 'math-derivative-1
(function (lambda (u) (math-normalize (list 'calcFunc-sinh u)))))
(lambda (u) (math-normalize (list 'calcFunc-sinh u))))
(put 'calcFunc-tanh\' 'math-derivative-1
(function (lambda (u) (math-sqr
(math-normalize
(list 'calcFunc-sech u))))))
(lambda (u) (math-sqr
(math-normalize
(list 'calcFunc-sech u)))))
(put 'calcFunc-sech\' 'math-derivative-1
(function (lambda (u) (math-neg
(math-mul
(math-normalize (list 'calcFunc-sech u))
(math-normalize (list 'calcFunc-tanh u)))))))
(lambda (u) (math-neg
(math-mul
(math-normalize (list 'calcFunc-sech u))
(math-normalize (list 'calcFunc-tanh u))))))
(put 'calcFunc-csch\' 'math-derivative-1
(function (lambda (u) (math-neg
(math-mul
(math-normalize (list 'calcFunc-csch u))
(math-normalize (list 'calcFunc-coth u)))))))
(lambda (u) (math-neg
(math-mul
(math-normalize (list 'calcFunc-csch u))
(math-normalize (list 'calcFunc-coth u))))))
(put 'calcFunc-coth\' 'math-derivative-1
(function (lambda (u) (math-neg
(math-sqr
(math-normalize
(list 'calcFunc-csch u)))))))
(lambda (u) (math-neg
(math-sqr
(math-normalize
(list 'calcFunc-csch u))))))
(put 'calcFunc-arcsinh\' 'math-derivative-1
(function (lambda (u)
(math-div 1 (math-normalize
(list 'calcFunc-sqrt
(math-add (math-sqr u) 1)))))))
(lambda (u)
(math-div 1 (math-normalize
(list 'calcFunc-sqrt
(math-add (math-sqr u) 1))))))
(put 'calcFunc-arccosh\' 'math-derivative-1
(function (lambda (u)
(math-div 1 (math-normalize
(list 'calcFunc-sqrt
(math-add (math-sqr u) -1)))))))
(lambda (u)
(math-div 1 (math-normalize
(list 'calcFunc-sqrt
(math-add (math-sqr u) -1))))))
(put 'calcFunc-arctanh\' 'math-derivative-1
(function (lambda (u) (math-div 1 (math-sub 1 (math-sqr u))))))
(lambda (u) (math-div 1 (math-sub 1 (math-sqr u)))))
(put 'calcFunc-bern\'2 'math-derivative-2
(function (lambda (n x)
(math-mul n (list 'calcFunc-bern (math-add n -1) x)))))
(lambda (n x)
(math-mul n (list 'calcFunc-bern (math-add n -1) x))))
(put 'calcFunc-euler\'2 'math-derivative-2
(function (lambda (n x)
(math-mul n (list 'calcFunc-euler (math-add n -1) x)))))
(lambda (n x)
(math-mul n (list 'calcFunc-euler (math-add n -1) x))))
(put 'calcFunc-gammag\'2 'math-derivative-2
(function (lambda (a x) (math-deriv-gamma a x 1))))
(lambda (a x) (math-deriv-gamma a x 1)))
(put 'calcFunc-gammaG\'2 'math-derivative-2
(function (lambda (a x) (math-deriv-gamma a x -1))))
(lambda (a x) (math-deriv-gamma a x -1)))
(put 'calcFunc-gammaP\'2 'math-derivative-2
(function (lambda (a x) (math-deriv-gamma a x
(math-div
1 (math-normalize
(list 'calcFunc-gamma
a)))))))
(lambda (a x) (math-deriv-gamma a x
(math-div
1 (math-normalize
(list 'calcFunc-gamma
a))))))
(put 'calcFunc-gammaQ\'2 'math-derivative-2
(function (lambda (a x) (math-deriv-gamma a x
(math-div
-1 (math-normalize
(list 'calcFunc-gamma
a)))))))
(lambda (a x) (math-deriv-gamma a x
(math-div
-1 (math-normalize
(list 'calcFunc-gamma
a))))))
(defun math-deriv-gamma (a x scale)
(math-mul scale
@ -537,13 +537,13 @@
(list 'calcFunc-exp (math-neg x)))))
(put 'calcFunc-betaB\' 'math-derivative-3
(function (lambda (x a b) (math-deriv-beta x a b 1))))
(lambda (x a b) (math-deriv-beta x a b 1)))
(put 'calcFunc-betaI\' 'math-derivative-3
(function (lambda (x a b) (math-deriv-beta x a b
(math-div
1 (list 'calcFunc-beta
a b))))))
(lambda (x a b) (math-deriv-beta x a b
(math-div
1 (list 'calcFunc-beta
a b)))))
(defun math-deriv-beta (x a b scale)
(math-mul (math-mul (math-pow x (math-add a -1))
@ -551,101 +551,96 @@
scale))
(put 'calcFunc-erf\' 'math-derivative-1
(function (lambda (x) (math-div 2
(math-mul (list 'calcFunc-exp
(math-sqr x))
(if calc-symbolic-mode
'(calcFunc-sqrt
(var pi var-pi))
(math-sqrt-pi)))))))
(lambda (x) (math-div 2
(math-mul (list 'calcFunc-exp
(math-sqr x))
(if calc-symbolic-mode
'(calcFunc-sqrt
(var pi var-pi))
(math-sqrt-pi))))))
(put 'calcFunc-erfc\' 'math-derivative-1
(function (lambda (x) (math-div -2
(math-mul (list 'calcFunc-exp
(math-sqr x))
(if calc-symbolic-mode
'(calcFunc-sqrt
(var pi var-pi))
(math-sqrt-pi)))))))
(lambda (x) (math-div -2
(math-mul (list 'calcFunc-exp
(math-sqr x))
(if calc-symbolic-mode
'(calcFunc-sqrt
(var pi var-pi))
(math-sqrt-pi))))))
(put 'calcFunc-besJ\'2 'math-derivative-2
(function (lambda (v z) (math-div (math-sub (list 'calcFunc-besJ
(math-add v -1)
z)
(list 'calcFunc-besJ
(math-add v 1)
z))
2))))
(lambda (v z) (math-div (math-sub (list 'calcFunc-besJ
(math-add v -1)
z)
(list 'calcFunc-besJ
(math-add v 1)
z))
2)))
(put 'calcFunc-besY\'2 'math-derivative-2
(function (lambda (v z) (math-div (math-sub (list 'calcFunc-besY
(math-add v -1)
z)
(list 'calcFunc-besY
(math-add v 1)
z))
2))))
(lambda (v z) (math-div (math-sub (list 'calcFunc-besY
(math-add v -1)
z)
(list 'calcFunc-besY
(math-add v 1)
z))
2)))
(put 'calcFunc-sum 'math-derivative-n
(function
(lambda (expr)
(if (math-expr-contains (cons 'vec (cdr (cdr expr))) math-deriv-var)
(throw 'math-deriv nil)
(cons 'calcFunc-sum
(cons (math-derivative (nth 1 expr))
(cdr (cdr expr))))))))
(lambda (expr)
(if (math-expr-contains (cons 'vec (cdr (cdr expr))) math-deriv-var)
(throw 'math-deriv nil)
(cons 'calcFunc-sum
(cons (math-derivative (nth 1 expr))
(cdr (cdr expr)))))))
(put 'calcFunc-prod 'math-derivative-n
(function
(lambda (expr)
(if (math-expr-contains (cons 'vec (cdr (cdr expr))) math-deriv-var)
(throw 'math-deriv nil)
(math-mul expr
(cons 'calcFunc-sum
(cons (math-div (math-derivative (nth 1 expr))
(nth 1 expr))
(cdr (cdr expr)))))))))
(lambda (expr)
(if (math-expr-contains (cons 'vec (cdr (cdr expr))) math-deriv-var)
(throw 'math-deriv nil)
(math-mul expr
(cons 'calcFunc-sum
(cons (math-div (math-derivative (nth 1 expr))
(nth 1 expr))
(cdr (cdr expr))))))))
(put 'calcFunc-integ 'math-derivative-n
(function
(lambda (expr)
(if (= (length expr) 3)
(if (equal (nth 2 expr) math-deriv-var)
(nth 1 expr)
(math-normalize
(list 'calcFunc-integ
(math-derivative (nth 1 expr))
(nth 2 expr))))
(if (= (length expr) 5)
(let ((lower (math-expr-subst (nth 1 expr) (nth 2 expr)
(nth 3 expr)))
(upper (math-expr-subst (nth 1 expr) (nth 2 expr)
(nth 4 expr))))
(math-add (math-sub (math-mul upper
(math-derivative (nth 4 expr)))
(math-mul lower
(math-derivative (nth 3 expr))))
(if (equal (nth 2 expr) math-deriv-var)
0
(math-normalize
(list 'calcFunc-integ
(math-derivative (nth 1 expr)) (nth 2 expr)
(nth 3 expr) (nth 4 expr)))))))))))
(lambda (expr)
(if (= (length expr) 3)
(if (equal (nth 2 expr) math-deriv-var)
(nth 1 expr)
(math-normalize
(list 'calcFunc-integ
(math-derivative (nth 1 expr))
(nth 2 expr))))
(if (= (length expr) 5)
(let ((lower (math-expr-subst (nth 1 expr) (nth 2 expr)
(nth 3 expr)))
(upper (math-expr-subst (nth 1 expr) (nth 2 expr)
(nth 4 expr))))
(math-add (math-sub (math-mul upper
(math-derivative (nth 4 expr)))
(math-mul lower
(math-derivative (nth 3 expr))))
(if (equal (nth 2 expr) math-deriv-var)
0
(math-normalize
(list 'calcFunc-integ
(math-derivative (nth 1 expr)) (nth 2 expr)
(nth 3 expr) (nth 4 expr))))))))))
(put 'calcFunc-if 'math-derivative-n
(function
(lambda (expr)
(and (= (length expr) 4)
(list 'calcFunc-if (nth 1 expr)
(math-derivative (nth 2 expr))
(math-derivative (nth 3 expr)))))))
(lambda (expr)
(and (= (length expr) 4)
(list 'calcFunc-if (nth 1 expr)
(math-derivative (nth 2 expr))
(math-derivative (nth 3 expr))))))
(put 'calcFunc-subscr 'math-derivative-n
(function
(lambda (expr)
(and (= (length expr) 3)
(list 'calcFunc-subscr (nth 1 expr)
(math-derivative (nth 2 expr)))))))
(lambda (expr)
(and (= (length expr) 3)
(list 'calcFunc-subscr (nth 1 expr)
(math-derivative (nth 2 expr))))))
(defvar math-integ-var '(var X ---))
@ -1015,11 +1010,10 @@
res '(calcFunc-integsubst)))
(and (memq (length part) '(3 4 5))
(let ((parts (mapcar
(function
(lambda (x)
(math-expr-subst
x (nth 2 part)
math-integ-var)))
(lambda (x)
(math-expr-subst
x (nth 2 part)
math-integ-var))
(cdr part))))
(math-integrate-by-substitution
expr (car parts) t
@ -1516,7 +1510,7 @@
var low high)
(nth 2 (nth 2 expr))))
((eq (car-safe expr) 'vec)
(cons 'vec (mapcar (function (lambda (x) (calcFunc-integ x var low high)))
(cons 'vec (mapcar (lambda (x) (calcFunc-integ x var low high))
(cdr expr))))
(t
(let ((state (list calc-angle-mode
@ -2742,28 +2736,27 @@
math-t1 math-t2 math-t3)
(setq math-t2 (math-polynomial-base
math-solve-lhs
(function
(lambda (solve-b)
(let ((math-solve-b solve-b)
(math-poly-neg-powers '(1))
(math-poly-mult-powers nil)
(math-poly-frac-powers 1)
(math-poly-exp-base t))
(and (not (equal math-solve-b math-solve-lhs))
(or (not (memq (car-safe math-solve-b) '(+ -))) sub-rhs)
(setq math-t3 '(1 0) math-t2 1
math-t1 (math-is-polynomial math-solve-lhs
math-solve-b 50))
(if (and (equal math-poly-neg-powers '(1))
(memq math-poly-mult-powers '(nil 1))
(eq math-poly-frac-powers 1)
sub-rhs)
(setq math-t1 (cons (math-sub (car math-t1) math-solve-rhs)
(cdr math-t1)))
(math-solve-poly-funny-powers sub-rhs))
(math-solve-crunch-poly degree)
(or (math-expr-contains math-solve-b math-solve-var)
(math-expr-contains (car math-t3) math-solve-var))))))))
(lambda (solve-b)
(let ((math-solve-b solve-b)
(math-poly-neg-powers '(1))
(math-poly-mult-powers nil)
(math-poly-frac-powers 1)
(math-poly-exp-base t))
(and (not (equal math-solve-b math-solve-lhs))
(or (not (memq (car-safe math-solve-b) '(+ -))) sub-rhs)
(setq math-t3 '(1 0) math-t2 1
math-t1 (math-is-polynomial math-solve-lhs
math-solve-b 50))
(if (and (equal math-poly-neg-powers '(1))
(memq math-poly-mult-powers '(nil 1))
(eq math-poly-frac-powers 1)
sub-rhs)
(setq math-t1 (cons (math-sub (car math-t1) math-solve-rhs)
(cdr math-t1)))
(math-solve-poly-funny-powers sub-rhs))
(math-solve-crunch-poly degree)
(or (math-expr-contains math-solve-b math-solve-var)
(math-expr-contains (car math-t3) math-solve-var)))))))
(if math-t2
(list (math-pow math-t2 (car math-t3))
(cons 'vec math-t1)
@ -3326,12 +3319,11 @@
(delq (car v) (copy-sequence var-list))
(let ((math-solve-simplifying nil)
(s (mapcar
(function
(lambda (x)
(cons
(car x)
(math-solve-system-subst
(cdr x)))))
(lambda (x)
(cons
(car x)
(math-solve-system-subst
(cdr x))))
solns)))
(if elim
s
@ -3347,35 +3339,33 @@
;; Eliminated all variables, so now put solution into the proper format.
(setq solns (sort solns
(function
(lambda (x y)
(not (memq (car x) (memq (car y) math-solve-vars)))))))
(lambda (x y)
(not (memq (car x) (memq (car y) math-solve-vars))))))
(if (eq math-solve-full 'all)
(math-transpose
(math-normalize
(cons 'vec
(if solns
(mapcar (function (lambda (x) (cons 'vec (cdr x)))) solns)
(mapcar (function (lambda (x) (cons 'vec x))) eqn-list)))))
(mapcar (lambda (x) (cons 'vec (cdr x))) solns)
(mapcar (lambda (x) (cons 'vec x)) eqn-list)))))
(math-normalize
(cons 'vec
(if solns
(mapcar (function (lambda (x) (cons 'calcFunc-eq x))) solns)
(mapcar 'car eqn-list)))))))
(mapcar (lambda (x) (cons 'calcFunc-eq x)) solns)
(mapcar #'car eqn-list)))))))
(defun math-solve-system-subst (x) ; uses "res" and "v"
(let ((accum nil)
(res2 math-solve-system-res))
(while x
(setq accum (nconc accum
(mapcar (function
(lambda (r)
(if math-solve-simplifying
(math-simplify
(math-expr-subst
(car x) math-solve-system-vv r))
(math-expr-subst
(car x) math-solve-system-vv r))))
(mapcar (lambda (r)
(if math-solve-simplifying
(math-simplify
(math-expr-subst
(car x) math-solve-system-vv r))
(math-expr-subst
(car x) math-solve-system-vv r)))
(car res2)))
x (cdr x)
res2 (cdr res2)))
@ -3471,11 +3461,10 @@
(let ((old-len (length res))
new-len)
(setq res (delq nil
(mapcar (function
(lambda (x)
(and (not (memq (car-safe x)
'(cplx polar)))
x)))
(mapcar (lambda (x)
(and (not (memq (car-safe x)
'(cplx polar)))
x))
res))
new-len (length res))
(if (< new-len old-len)
@ -3545,119 +3534,119 @@
(put 'calcFunc-inv 'math-inverse
(function (lambda (x) (math-div 1 x))))
(lambda (x) (math-div 1 x)))
(put 'calcFunc-inv 'math-inverse-sign -1)
(put 'calcFunc-sqrt 'math-inverse
(function (lambda (x) (math-sqr x))))
(lambda (x) (math-sqr x)))
(put 'calcFunc-conj 'math-inverse
(function (lambda (x) (list 'calcFunc-conj x))))
(lambda (x) (list 'calcFunc-conj x)))
(put 'calcFunc-abs 'math-inverse
(function (lambda (x) (math-solve-get-sign x))))
(lambda (x) (math-solve-get-sign x)))
(put 'calcFunc-deg 'math-inverse
(function (lambda (x) (list 'calcFunc-rad x))))
(lambda (x) (list 'calcFunc-rad x)))
(put 'calcFunc-deg 'math-inverse-sign 1)
(put 'calcFunc-rad 'math-inverse
(function (lambda (x) (list 'calcFunc-deg x))))
(lambda (x) (list 'calcFunc-deg x)))
(put 'calcFunc-rad 'math-inverse-sign 1)
(put 'calcFunc-ln 'math-inverse
(function (lambda (x) (list 'calcFunc-exp x))))
(lambda (x) (list 'calcFunc-exp x)))
(put 'calcFunc-ln 'math-inverse-sign 1)
(put 'calcFunc-log10 'math-inverse
(function (lambda (x) (list 'calcFunc-exp10 x))))
(lambda (x) (list 'calcFunc-exp10 x)))
(put 'calcFunc-log10 'math-inverse-sign 1)
(put 'calcFunc-lnp1 'math-inverse
(function (lambda (x) (list 'calcFunc-expm1 x))))
(lambda (x) (list 'calcFunc-expm1 x)))
(put 'calcFunc-lnp1 'math-inverse-sign 1)
(put 'calcFunc-exp 'math-inverse
(function (lambda (x) (math-add (math-normalize (list 'calcFunc-ln x))
(math-mul 2
(math-mul '(var pi var-pi)
(math-solve-get-int
'(var i var-i))))))))
(lambda (x) (math-add (math-normalize (list 'calcFunc-ln x))
(math-mul 2
(math-mul '(var pi var-pi)
(math-solve-get-int
'(var i var-i)))))))
(put 'calcFunc-exp 'math-inverse-sign 1)
(put 'calcFunc-expm1 'math-inverse
(function (lambda (x) (math-add (math-normalize (list 'calcFunc-lnp1 x))
(math-mul 2
(math-mul '(var pi var-pi)
(math-solve-get-int
'(var i var-i))))))))
(lambda (x) (math-add (math-normalize (list 'calcFunc-lnp1 x))
(math-mul 2
(math-mul '(var pi var-pi)
(math-solve-get-int
'(var i var-i)))))))
(put 'calcFunc-expm1 'math-inverse-sign 1)
(put 'calcFunc-sin 'math-inverse
(function (lambda (x) (let ((n (math-solve-get-int 1)))
(math-add (math-mul (math-normalize
(list 'calcFunc-arcsin x))
(math-pow -1 n))
(math-mul (math-half-circle t)
n))))))
(lambda (x) (let ((n (math-solve-get-int 1)))
(math-add (math-mul (math-normalize
(list 'calcFunc-arcsin x))
(math-pow -1 n))
(math-mul (math-half-circle t)
n)))))
(put 'calcFunc-cos 'math-inverse
(function (lambda (x) (math-add (math-solve-get-sign
(math-normalize
(list 'calcFunc-arccos x)))
(math-solve-get-int
(math-full-circle t))))))
(lambda (x) (math-add (math-solve-get-sign
(math-normalize
(list 'calcFunc-arccos x)))
(math-solve-get-int
(math-full-circle t)))))
(put 'calcFunc-tan 'math-inverse
(function (lambda (x) (math-add (math-normalize (list 'calcFunc-arctan x))
(math-solve-get-int
(math-half-circle t))))))
(lambda (x) (math-add (math-normalize (list 'calcFunc-arctan x))
(math-solve-get-int
(math-half-circle t)))))
(put 'calcFunc-arcsin 'math-inverse
(function (lambda (x) (math-normalize (list 'calcFunc-sin x)))))
(lambda (x) (math-normalize (list 'calcFunc-sin x))))
(put 'calcFunc-arccos 'math-inverse
(function (lambda (x) (math-normalize (list 'calcFunc-cos x)))))
(lambda (x) (math-normalize (list 'calcFunc-cos x))))
(put 'calcFunc-arctan 'math-inverse
(function (lambda (x) (math-normalize (list 'calcFunc-tan x)))))
(lambda (x) (math-normalize (list 'calcFunc-tan x))))
(put 'calcFunc-sinh 'math-inverse
(function (lambda (x) (let ((n (math-solve-get-int 1)))
(math-add (math-mul (math-normalize
(list 'calcFunc-arcsinh x))
(math-pow -1 n))
(math-mul (math-half-circle t)
(math-mul
'(var i var-i)
n)))))))
(lambda (x) (let ((n (math-solve-get-int 1)))
(math-add (math-mul (math-normalize
(list 'calcFunc-arcsinh x))
(math-pow -1 n))
(math-mul (math-half-circle t)
(math-mul
'(var i var-i)
n))))))
(put 'calcFunc-sinh 'math-inverse-sign 1)
(put 'calcFunc-cosh 'math-inverse
(function (lambda (x) (math-add (math-solve-get-sign
(math-normalize
(list 'calcFunc-arccosh x)))
(math-mul (math-full-circle t)
(math-solve-get-int
'(var i var-i)))))))
(lambda (x) (math-add (math-solve-get-sign
(math-normalize
(list 'calcFunc-arccosh x)))
(math-mul (math-full-circle t)
(math-solve-get-int
'(var i var-i))))))
(put 'calcFunc-tanh 'math-inverse
(function (lambda (x) (math-add (math-normalize
(list 'calcFunc-arctanh x))
(math-mul (math-half-circle t)
(math-solve-get-int
'(var i var-i)))))))
(lambda (x) (math-add (math-normalize
(list 'calcFunc-arctanh x))
(math-mul (math-half-circle t)
(math-solve-get-int
'(var i var-i))))))
(put 'calcFunc-tanh 'math-inverse-sign 1)
(put 'calcFunc-arcsinh 'math-inverse
(function (lambda (x) (math-normalize (list 'calcFunc-sinh x)))))
(lambda (x) (math-normalize (list 'calcFunc-sinh x))))
(put 'calcFunc-arcsinh 'math-inverse-sign 1)
(put 'calcFunc-arccosh 'math-inverse
(function (lambda (x) (math-normalize (list 'calcFunc-cosh x)))))
(lambda (x) (math-normalize (list 'calcFunc-cosh x))))
(put 'calcFunc-arctanh 'math-inverse
(function (lambda (x) (math-normalize (list 'calcFunc-tanh x)))))
(lambda (x) (math-normalize (list 'calcFunc-tanh x))))
(put 'calcFunc-arctanh 'math-inverse-sign 1)

16
lisp/calc/calcalg3.el
View file

@ -480,13 +480,13 @@
"Fitting variables"
(format "%s; %s"
(mapconcat 'symbol-name
(mapcar (function (lambda (v)
(nth 1 v)))
(mapcar (lambda (v)
(nth 1 v))
defv)
",")
(mapconcat 'symbol-name
(mapcar (function (lambda (v)
(nth 1 v)))
(mapcar (lambda (v)
(nth 1 v))
defc)
",")))))
(coefs nil))
@ -1336,7 +1336,7 @@
(or (> (length (nth 1 data)) 2)
(math-reject-arg data "*Too few data points"))
(if (and (math-vectorp x) (or (math-constp x) math-expand-formulas))
(cons 'vec (mapcar (function (lambda (x) (calcFunc-polint data x)))
(cons 'vec (mapcar (lambda (x) (calcFunc-polint data x))
(cdr x)))
(or (math-objectp x) math-expand-formulas (math-reject-arg x 'objectp))
(math-with-extra-prec 2
@ -1352,7 +1352,7 @@
(or (> (length (nth 1 data)) 2)
(math-reject-arg data "*Too few data points"))
(if (and (math-vectorp x) (or (math-constp x) math-expand-formulas))
(cons 'vec (mapcar (function (lambda (x) (calcFunc-ratint data x)))
(cons 'vec (mapcar (lambda (x) (calcFunc-ratint data x))
(cdr x)))
(or (math-objectp x) math-expand-formulas (math-reject-arg x 'objectp))
(math-with-extra-prec 2
@ -1910,8 +1910,8 @@
(while p
(setq vars (delq (assoc (car-safe p) vars) vars)
p (cdr p)))
(sort (mapcar 'car vars)
(function (lambda (x y) (string< (nth 1 x) (nth 1 y)))))))
(sort (mapcar #'car vars)
(lambda (x y) (string< (nth 1 x) (nth 1 y))))))
;; The variables math-all-vars-vars (the vars for math-all-vars) and
;; math-all-vars-found are local to math-all-vars-in, but are used by

117
lisp/calc/calccomp.el
View file

@ -464,14 +464,13 @@
(math-compose-vector (cdr (nth 1 a))
(math-vector-to-string sep nil)
(or cprec prec))
(cons 'horiz (mapcar (function
(lambda (x)
(if (eq (car-safe x) 'calcFunc-bstring)
(prog1
(math-compose-expr
x (or bprec cprec prec))
(setq bprec -123))
(math-compose-expr x (or cprec prec)))))
(cons 'horiz (mapcar (lambda (x)
(if (eq (car-safe x) 'calcFunc-bstring)
(prog1
(math-compose-expr
x (or bprec cprec prec))
(setq bprec -123))
(math-compose-expr x (or cprec prec))))
(cdr (nth 1 a)))))))
((and (memq (car a) '(calcFunc-cvert calcFunc-clvert calcFunc-crvert))
(not (eq calc-language 'unform))
@ -482,47 +481,46 @@
(let* ((base 0)
(v 0)
(prec (or (nth 2 a) prec))
(c (mapcar (function
(lambda (x)
(let ((b nil) (cc nil) a d)
(if (and (memq (car-safe x) '(calcFunc-cbase
calcFunc-ctbase
calcFunc-cbbase))
(memq (length x) '(1 2)))
(setq b (car x)
x (nth 1 x)))
(if (and (eq (car-safe x) 'calcFunc-crule)
(memq (length x) '(1 2))
(or (null (nth 1 x))
(and (math-vectorp (nth 1 x))
(= (length (nth 1 x)) 2)
(math-vector-is-string
(nth 1 x)))
(and (natnump (nth 1 x))
(<= (nth 1 x) 255))))
(setq cc (list
'rule
(if (math-vectorp (nth 1 x))
(aref (math-vector-to-string
(nth 1 x) nil) 0)
(or (nth 1 x) ?-))))
(or (and (memq (car-safe x) '(calcFunc-cvspace
calcFunc-ctspace
calcFunc-cbspace))
(memq (length x) '(2 3))
(eq (nth 1 x) 0))
(null x)
(setq cc (math-compose-expr x prec))))
(setq a (if cc (math-comp-ascent cc) 0)
d (if cc (math-comp-descent cc) 0))
(if (eq b 'calcFunc-cbase)
(setq base (+ v a -1))
(if (eq b 'calcFunc-ctbase)
(setq base v)
(if (eq b 'calcFunc-cbbase)
(setq base (+ v a d -1)))))
(setq v (+ v a d))
cc)))
(c (mapcar (lambda (x)
(let ((b nil) (cc nil) a d)
(if (and (memq (car-safe x) '(calcFunc-cbase
calcFunc-ctbase
calcFunc-cbbase))
(memq (length x) '(1 2)))
(setq b (car x)
x (nth 1 x)))
(if (and (eq (car-safe x) 'calcFunc-crule)
(memq (length x) '(1 2))
(or (null (nth 1 x))
(and (math-vectorp (nth 1 x))
(= (length (nth 1 x)) 2)
(math-vector-is-string
(nth 1 x)))
(and (natnump (nth 1 x))
(<= (nth 1 x) 255))))
(setq cc (list
'rule
(if (math-vectorp (nth 1 x))
(aref (math-vector-to-string
(nth 1 x) nil) 0)
(or (nth 1 x) ?-))))
(or (and (memq (car-safe x) '(calcFunc-cvspace
calcFunc-ctspace
calcFunc-cbspace))
(memq (length x) '(2 3))
(eq (nth 1 x) 0))
(null x)
(setq cc (math-compose-expr x prec))))
(setq a (if cc (math-comp-ascent cc) 0)
d (if cc (math-comp-descent cc) 0))
(if (eq b 'calcFunc-cbase)
(setq base (+ v a -1))
(if (eq b 'calcFunc-ctbase)
(setq base v)
(if (eq b 'calcFunc-cbbase)
(setq base (+ v a d -1)))))
(setq v (+ v a d))
cc))
(cdr (nth 1 a)))))
(setq c (delq nil c))
(if c
@ -865,16 +863,15 @@
(while (<= (setq col (1+ col)) cols)
(setq res (cons (cons math-comp-just
(cons base
(mapcar (function
(lambda (r)
(list 'horiz
(math-compose-expr
(nth col r)
math-comp-vector-prec)
(if (= col cols)
""
(concat
math-comp-comma-spc " ")))))
(mapcar (lambda (r)
(list 'horiz
(math-compose-expr
(nth col r)
math-comp-vector-prec)
(if (= col cols)
""
(concat
math-comp-comma-spc " "))))
a)))
res)))
(nreverse res)))
@ -923,7 +920,7 @@
( ?\^? . "\\^?" )))
(defun math-vector-to-string (a &optional quoted)
(setq a (concat (mapcar (function (lambda (x) (if (consp x) (nth 1 x) x)))
(setq a (concat (mapcar (lambda (x) (if (consp x) (nth 1 x) x))
(cdr a))))
(if (string-match "[\000-\037\177\\\"]" a)
(let ((p 0)

6
lisp/cedet/inversion.el
View file

@ -349,7 +349,11 @@ Optional argument RESERVED is saved for later use."
;;;###autoload
(defun inversion-require-emacs (emacs-ver xemacs-ver sxemacs-ver)
"Declare that you need either EMACS-VER, XEMACS-VER or SXEMACS-ver.
Only checks one based on which kind of Emacs is being run."
Only checks one based on which kind of Emacs is being run.
This function is obsolete; do this instead:
(when (version<= \"28.1\" emacs-version) ...)"
(declare (obsolete nil "28.1"))
(let ((err (inversion-test 'emacs
(cond ((featurep 'sxemacs)
sxemacs-ver)

26
lisp/cedet/semantic/bovine/el.el
View file

@ -464,27 +464,11 @@ Return a bovination list to use."
(define-mode-local-override semantic-dependency-tag-file
emacs-lisp-mode (tag)
"Find the file BUFFER depends on described by TAG."
(if (fboundp 'find-library-name)
(condition-case nil
;; Try an Emacs 22 fcn. This throws errors.
(find-library-name (semantic-tag-name tag))
(error
(message "semantic: cannot find source file %s"
(semantic-tag-name tag))))
;; No handy function available. (Older Emacsen)
(let* ((lib (locate-library (semantic-tag-name tag)))
(name (if lib (file-name-sans-extension lib) nil))
(nameel (concat name ".el")))
(cond
((and name (file-exists-p nameel)) nameel)
((and name (file-exists-p (concat name ".el.gz")))
;; This is the linux distro case.
(concat name ".el.gz"))
;; Source file does not exist.
(name
(message "semantic: cannot find source file %s" (concat name ".el")))
(t
nil)))))
(condition-case nil
(find-library-name (semantic-tag-name tag))
(error
(message "semantic: cannot find source file %s"
(semantic-tag-name tag)))))
;;; DOC Strings
;;

11
lisp/cedet/semantic/format.el
View file

@ -32,7 +32,6 @@
;;
;;; Code:
(eval-when-compile (require 'font-lock))
(require 'semantic)
(require 'semantic/tag-ls)
(require 'ezimage)
@ -119,12 +118,10 @@ be used unless font lock is a feature.")
"Apply onto TEXT a color associated with FACE-CLASS.
FACE-CLASS is a tag type found in `semantic-format-face-alist'.
See that variable for details on adding new types."
(if (featurep 'font-lock)
(let ((face (cdr-safe (assoc face-class semantic-format-face-alist)))
(newtext (concat text)))
(put-text-property 0 (length text) 'face face newtext)
newtext)
text))
(let ((face (cdr-safe (assoc face-class semantic-format-face-alist)))
(newtext (concat text)))
(put-text-property 0 (length text) 'face face newtext)
newtext))
(defun semantic--format-colorize-merge-text (precoloredtext face-class)
"Apply onto PRECOLOREDTEXT a color associated with FACE-CLASS.

11
lisp/cedet/semantic/ia.el
View file

@ -79,15 +79,14 @@
(insert "("))
(t nil))))
(defalias 'semantic-ia-get-completions 'semantic-ia-get-completions-deprecated
"`Semantic-ia-get-completions' is obsolete.
Use `semantic-analyze-possible-completions' instead.")
(defalias 'semantic-ia-get-completions 'semantic-ia-get-completions-deprecated)
(make-obsolete 'semantic-ia-get-completions
#'semantic-analyze-possible-completions "28.1")
(defun semantic-ia-get-completions-deprecated (context point)
"A function to help transition away from `semantic-ia-get-completions'.
Return completions based on CONTEXT at POINT.
You should not use this, nor the aliased version.
Use `semantic-analyze-possible-completions' instead."
Return completions based on CONTEXT at POINT."
(declare (obsolete semantic-analyze-possible-completions "28.1"))
(semantic-analyze-possible-completions context))
;;;###autoload

6
lisp/cedet/semantic/sort.el
View file

@ -46,11 +46,7 @@
(defun semantic-string-lessp-ci (s1 s2)
"Case insensitive version of `string-lessp'.
Argument S1 and S2 are the strings to compare."
;; Use downcase instead of upcase because an average name
;; has more lower case characters.
(if (fboundp 'compare-strings)
(eq (compare-strings s1 0 nil s2 0 nil t) -1)
(string-lessp (downcase s1) (downcase s2))))
(eq (compare-strings s1 0 nil s2 0 nil t) -1))
(defun semantic-sort-tag-type (tag)
"Return a type string for TAG guaranteed to be a string."

22
lisp/cedet/semantic/symref/grep.el
View file

@ -167,24 +167,10 @@ This shell should support pipe redirect syntax."
(with-current-buffer b
(erase-buffer)
(setq default-directory rootdir)
(if (not (fboundp 'grep-compute-defaults))
;; find . -type f -print0 | xargs -0 -e grep -nH -e
;; Note : I removed -e as it is not posix, nor necessary it seems.
(let ((cmd (concat "find " (file-local-name rootdir)
" -type f " filepattern " -print0 "
"| xargs -0 grep -H " grepflags "-e " greppat)))
;;(message "Old command: %s" cmd)
(process-file semantic-symref-grep-shell nil b nil
shell-command-switch cmd)
)
(let ((cmd (semantic-symref-grep-use-template
(file-local-name rootdir) filepattern grepflags greppat)))
(process-file semantic-symref-grep-shell nil b nil
shell-command-switch cmd))
))
(let ((cmd (semantic-symref-grep-use-template
(file-local-name rootdir) filepattern grepflags greppat)))
(process-file semantic-symref-grep-shell nil b nil
shell-command-switch cmd)))
(setq ans (semantic-symref-parse-tool-output tool b))
;; Return the answer
ans))

11
lisp/cedet/semantic/tag.el
View file

@ -53,6 +53,11 @@
(declare-function semantic-clear-toplevel-cache "semantic")
(declare-function semantic-tag-similar-p "semantic/tag-ls")
(define-obsolete-variable-alias 'semantic-token-version
'semantic-tag-version "28.1")
(define-obsolete-variable-alias 'semantic-token-incompatible-version
'semantic-tag-incompatible-version "28.1")
(defconst semantic-tag-version "2.0"
"Version string of semantic tags made with this code.")
@ -1321,12 +1326,6 @@ This function is overridable with the symbol `insert-foreign-tag'."
"Insert foreign tags into log-edit mode."
(insert (concat "(" (semantic-format-tag-name foreign-tag) "): ")))
;;; Compatibility
;;
(defconst semantic-token-version
semantic-tag-version)
(defconst semantic-token-incompatible-version
semantic-tag-incompatible-version)
(provide 'semantic/tag)

2
lisp/cus-dep.el
View file

@ -205,7 +205,7 @@ Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS"
(setq where (get symbol 'custom-where))
(when where
(if (or (custom-variable-p symbol)
(custom-facep symbol))
(facep symbol))
;; This means it's a variable or a face.
(progn
(if (assoc version version-alist)

36
lisp/cus-edit.el
View file

@ -1295,10 +1295,11 @@ that were added or redefined since that version."
(push (list symbol 'custom-group) found))
(if (custom-variable-p symbol)
(push (list symbol 'custom-variable) found))
(if (custom-facep symbol)
(if (facep symbol)
(push (list symbol 'custom-face) found)))))))
(if found
(custom-buffer-create (custom-sort-items found t 'first)
(custom-buffer-create (custom--filter-obsolete-variables
(custom-sort-items found t 'first))
"*Customize Changed Options*")
(user-error "No user option defaults have been changed since Emacs %s"
since-version))))
@ -1405,7 +1406,7 @@ symbols `custom-face' or `custom-variable'."
(mapatoms (lambda (symbol)
(and (or (get symbol 'customized-face)
(get symbol 'customized-face-comment))
(custom-facep symbol)
(facep symbol)
(push (list symbol 'custom-face) found))
(and (or (get symbol 'customized-value)
(get symbol 'customized-variable-comment))
@ -1452,7 +1453,7 @@ symbols `custom-face' or `custom-variable'."
(mapatoms (lambda (symbol)
(and (or (get symbol 'saved-face)
(get symbol 'saved-face-comment))
(custom-facep symbol)
(facep symbol)
(push (list symbol 'custom-face) found))
(and (or (get symbol 'saved-value)
(get symbol 'saved-variable-comment))
@ -1490,7 +1491,7 @@ If TYPE is `groups', include only groups."
(if (get symbol 'custom-group)
(push (list symbol 'custom-group) found)))
(if (memq type '(nil faces))
(if (custom-facep symbol)
(if (facep symbol)
(push (list symbol 'custom-face) found)))
(if (memq type '(nil options))
(if (and (boundp symbol)
@ -1504,7 +1505,8 @@ If TYPE is `groups', include only groups."
(symbol-name type))
pattern))
(custom-buffer-create
(custom-sort-items found t custom-buffer-order-groups)
(custom--filter-obsolete-variables
(custom-sort-items found t custom-buffer-order-groups))
"*Customize Apropos*")))
;;;###autoload
@ -4232,6 +4234,13 @@ and so forth. The remaining group tags are shown with `custom-group-tag'."
(insert "--------")))
(widget-default-create widget))
(defun custom--filter-obsolete-variables (items)
"Filter obsolete variables from ITEMS."
(seq-remove (lambda (item)
(and (eq (nth 1 item) 'custom-variable)
(get (nth 0 item) 'byte-obsolete-variable)))
items))
(defun custom-group-members (symbol groups-only)
"Return SYMBOL's custom group members.
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."
?\s))
;; Members.
(message "Creating group...")
(let* ((members (custom-sort-items
members
;; Never sort the top-level custom group.
(unless (eq symbol 'emacs)
custom-buffer-sort-alphabetically)
custom-buffer-order-groups))
(let* ((members (custom--filter-obsolete-variables
(custom-sort-items
members
;; Never sort the top-level custom group.
(unless (eq symbol 'emacs)
custom-buffer-sort-alphabetically)
custom-buffer-order-groups)))
(prefixes (widget-get widget :custom-prefixes))
(custom-prefix-list (custom-prefix-add symbol prefixes))
(have-subtitle (and (not (eq symbol 'emacs))
@ -4888,7 +4898,7 @@ This function does not save the buffer."
(let ((spec (car-safe (get symbol 'theme-face)))
(value (get symbol 'saved-face))
(now (not (or (get symbol 'face-defface-spec)
(and (not (custom-facep symbol))
(and (not (facep symbol))
(not (get symbol 'force-face))))))
(comment (get symbol 'saved-face-comment)))
(when (or (and spec (eq (nth 0 spec) 'user))

4
lisp/cus-face.el
View file

@ -27,8 +27,6 @@
;;; Code:
(defalias 'custom-facep 'facep)
;;; Declaring a face.
(defun custom-declare-face (face spec doc &rest args)
@ -394,6 +392,8 @@ Each of the arguments ARGS has this form:
This means reset FACE to its value in FROM-THEME."
(apply 'custom-theme-reset-faces 'user args))
(define-obsolete-function-alias 'custom-facep #'facep "28.1")
;;; The End.
(provide 'cus-face)

51
lisp/edmacro.el
View file

@ -535,32 +535,31 @@ doubt, use whitespace."
(setq bind-len (1+ text)))
(t
(setq desc (mapconcat
(function
(lambda (ch)
(cond
((integerp ch)
(concat
(cl-loop for pf across "ACHMsS"
for bit in '(?\A-\^@ ?\C-\^@ ?\H-\^@
?\M-\^@ ?\s-\^@ ?\S-\^@)
when (/= (logand ch bit) 0)
concat (format "%c-" pf))
(let ((ch2 (logand ch (1- (ash 1 18)))))
(cond ((<= ch2 32)
(pcase ch2
(0 "NUL") (9 "TAB") (10 "LFD")
(13 "RET") (27 "ESC") (32 "SPC")
(_
(format "C-%c"
(+ (if (<= ch2 26) 96 64)
ch2)))))
((= ch2 127) "DEL")
((<= ch2 maxkey) (char-to-string ch2))
(t (format "\\%o" ch2))))))
((symbolp ch)
(format "<%s>" ch))
(t
(error "Unrecognized item in macro: %s" ch)))))
(lambda (ch)
(cond
((integerp ch)
(concat
(cl-loop for pf across "ACHMsS"
for bit in '(?\A-\^@ ?\C-\^@ ?\H-\^@
?\M-\^@ ?\s-\^@ ?\S-\^@)
when (/= (logand ch bit) 0)
concat (format "%c-" pf))
(let ((ch2 (logand ch (1- (ash 1 18)))))
(cond ((<= ch2 32)
(pcase ch2
(0 "NUL") (9 "TAB") (10 "LFD")
(13 "RET") (27 "ESC") (32 "SPC")
(_
(format "C-%c"
(+ (if (<= ch2 26) 96 64)
ch2)))))
((= ch2 127) "DEL")
((<= ch2 maxkey) (char-to-string ch2))
(t (format "\\%o" ch2))))))
((symbolp ch)
(format "<%s>" ch))
(t
(error "Unrecognized item in macro: %s" ch))))
(or fkey key) " "))))
(if prefix
(setq desc (concat (edmacro-sanitize-for-string prefix) desc)))

42
lisp/emacs-lisp/advice.el
View file

@ -2375,28 +2375,26 @@ The assignment starts at position INDEX."
(defun ad-insert-argument-access-forms (definition arglist)
"Expands arg-access text macros in DEFINITION according to ARGLIST."
(ad-substitute-tree
(function
(lambda (form)
(or (eq form 'ad-arg-bindings)
(and (memq (car-safe form)
'(ad-get-arg ad-get-args ad-set-arg ad-set-args))
(integerp (car-safe (cdr form)))))))
(function
(lambda (form)
(if (eq form 'ad-arg-bindings)
(ad-retrieve-args-form arglist)
(let ((accessor (car form))
(index (car (cdr form)))
(val (car (cdr (ad-insert-argument-access-forms
(cdr form) arglist)))))
(cond ((eq accessor 'ad-get-arg)
(ad-get-argument arglist index))
((eq accessor 'ad-set-arg)
(ad-set-argument arglist index val))
((eq accessor 'ad-get-args)
(ad-get-arguments arglist index))
((eq accessor 'ad-set-args)
(ad-set-arguments arglist index val)))))))
(lambda (form)
(or (eq form 'ad-arg-bindings)
(and (memq (car-safe form)
'(ad-get-arg ad-get-args ad-set-arg ad-set-args))
(integerp (car-safe (cdr form))))))
(lambda (form)
(if (eq form 'ad-arg-bindings)
(ad-retrieve-args-form arglist)
(let ((accessor (car form))
(index (car (cdr form)))
(val (car (cdr (ad-insert-argument-access-forms
(cdr form) arglist)))))
(cond ((eq accessor 'ad-get-arg)
(ad-get-argument arglist index))
((eq accessor 'ad-set-arg)
(ad-set-argument arglist index val))
((eq accessor 'ad-get-args)
(ad-get-arguments arglist index))
((eq accessor 'ad-set-args)
(ad-set-arguments arglist index val))))))
definition))
;; @@@ Mapping argument lists:

2
lisp/emacs-lisp/benchmark.el
View file

@ -43,7 +43,7 @@
;;;###autoload
(defmacro benchmark-run (&optional repetitions &rest forms)
"Time execution of FORMS.
If REPETITIONS is supplied as a number, run forms that many times,
If REPETITIONS is supplied as a number, run FORMS that many times,
accounting for the overhead of the resulting loop. Otherwise run
FORMS once.
Return a list of the total elapsed time for execution, the number of

3
lisp/emacs-lisp/bytecomp.el
View file

@ -2642,7 +2642,8 @@ list that represents a doc string reference.
;; and similar macros cleaner.
(put 'eval 'byte-hunk-handler 'byte-compile-file-form-eval)
(defun byte-compile-file-form-eval (form)
(if (eq (car-safe (nth 1 form)) 'quote)
(if (and (eq (car-safe (nth 1 form)) 'quote)
(equal (nth 2 form) lexical-binding))
(nth 1 (nth 1 form))
(byte-compile-keep-pending form)))

29
lisp/emacs-lisp/cl-extra.el
View file

@ -209,10 +209,10 @@ non-nil value.
\n(fn PREDICATE SEQ...)"
(if (or cl-rest (nlistp cl-seq))
(catch 'cl-some
(apply 'cl-map nil
(function (lambda (&rest cl-x)
(let ((cl-res (apply cl-pred cl-x)))
(if cl-res (throw 'cl-some cl-res)))))
(apply #'cl-map nil
(lambda (&rest cl-x)
(let ((cl-res (apply cl-pred cl-x)))
(if cl-res (throw 'cl-some cl-res))))
cl-seq cl-rest) nil)
(let ((cl-x nil))
(while (and cl-seq (not (setq cl-x (funcall cl-pred (pop cl-seq))))))
@ -224,9 +224,9 @@ non-nil value.
\n(fn PREDICATE SEQ...)"
(if (or cl-rest (nlistp cl-seq))
(catch 'cl-every
(apply 'cl-map nil
(function (lambda (&rest cl-x)
(or (apply cl-pred cl-x) (throw 'cl-every nil))))
(apply #'cl-map nil
(lambda (&rest cl-x)
(or (apply cl-pred cl-x) (throw 'cl-every nil)))
cl-seq cl-rest) t)
(while (and cl-seq (funcall cl-pred (car cl-seq)))
(setq cl-seq (cdr cl-seq)))
@ -249,14 +249,13 @@ non-nil value.
(or cl-base
(setq cl-base (copy-sequence [0])))
(map-keymap
(function
(lambda (cl-key cl-bind)
(aset cl-base (1- (length cl-base)) cl-key)
(if (keymapp cl-bind)
(cl--map-keymap-recursively
cl-func-rec cl-bind
(vconcat cl-base (list 0)))
(funcall cl-func-rec cl-base cl-bind))))
(lambda (cl-key cl-bind)
(aset cl-base (1- (length cl-base)) cl-key)
(if (keymapp cl-bind)
(cl--map-keymap-recursively
cl-func-rec cl-bind
(vconcat cl-base (list 0)))
(funcall cl-func-rec cl-base cl-bind)))
cl-map))
;;;###autoload

26
lisp/emacs-lisp/cl-macs.el
View file

@ -819,16 +819,15 @@ final clause, and matches if no other keys match.
(cons
'cond
(mapcar
(function
(lambda (c)
(cons (cond ((eq (car c) 'otherwise) t)
((eq (car c) 'cl--ecase-error-flag)
`(error "cl-etypecase failed: %s, %s"
,temp ',(reverse type-list)))
(t
(push (car c) type-list)
`(cl-typep ,temp ',(car c))))
(or (cdr c) '(nil)))))
(lambda (c)
(cons (cond ((eq (car c) 'otherwise) t)
((eq (car c) 'cl--ecase-error-flag)
`(error "cl-etypecase failed: %s, %s"
,temp ',(reverse type-list)))
(t
(push (car c) type-list)
`(cl-typep ,temp ',(car c))))
(or (cdr c) '(nil))))
clauses)))))
;;;###autoload
@ -2793,7 +2792,7 @@ Supported keywords for slots are:
(unless (cl--struct-name-p name)
(signal 'wrong-type-argument (list 'cl-struct-name-p name 'name)))
(setq descs (cons '(cl-tag-slot)
(mapcar (function (lambda (x) (if (consp x) x (list x))))
(mapcar (lambda (x) (if (consp x) x (list x)))
descs)))
(while opts
(let ((opt (if (consp (car opts)) (caar opts) (car opts)))
@ -2820,9 +2819,8 @@ Supported keywords for slots are:
;; we include EIEIO classes rather than cl-structs!
(when include-name (error "Can't :include more than once"))
(setq include-name (car args))
(setq include-descs (mapcar (function
(lambda (x)
(if (consp x) x (list x))))
(setq include-descs (mapcar (lambda (x)
(if (consp x) x (list x)))
(cdr args))))
((eq opt :print-function)
(setq print-func (car args)))

13
lisp/emacs-lisp/cl-seq.el
View file

@ -69,10 +69,9 @@
(list 'or (list 'memq '(car cl-keys-temp)
(list 'quote
(mapcar
(function
(lambda (x)
(if (consp x)
(car x) x)))
(lambda (x)
(if (consp x)
(car x) x))
(append kwords
other-keys))))
'(car (cdr (memq (quote :allow-other-keys)
@ -668,9 +667,9 @@ This is a destructive function; it reuses the storage of SEQ if possible.
(cl--parsing-keywords (:key) ()
(if (memq cl-key '(nil identity))
(sort cl-seq cl-pred)
(sort cl-seq (function (lambda (cl-x cl-y)
(funcall cl-pred (funcall cl-key cl-x)
(funcall cl-key cl-y)))))))))
(sort cl-seq (lambda (cl-x cl-y)
(funcall cl-pred (funcall cl-key cl-x)
(funcall cl-key cl-y))))))))
;;;###autoload
(defun cl-stable-sort (cl-seq cl-pred &rest cl-keys)

1
lisp/emacs-lisp/easymenu.el
View file

@ -514,6 +514,7 @@ completely and menu filter functions can be expected to work.
If BEFORE is non-nil, add before the item named BEFORE.
If IN-MENU is non-nil, follow MENU-PATH in IN-MENU.
This is a compatibility function; use `easy-menu-add-item'."
(declare (obsolete easy-menu-add-item "28.1"))
(easy-menu-add-item (or in-menu (current-global-map))
(cons "menu-bar" menu-path)
submenu before))

20
lisp/emacs-lisp/edebug.el
View file

@ -309,9 +309,8 @@ A lambda list keyword is a symbol that starts with `&'."
(defun edebug-sort-alist (alist function)
;; Return the ALIST sorted with comparison function FUNCTION.
;; This uses 'sort so the sorting is destructive.
(sort alist (function
(lambda (e1 e2)
(funcall function (car e1) (car e2))))))
(sort alist (lambda (e1 e2)
(funcall function (car e1) (car e2)))))
;; Not used.
'(defmacro edebug-save-restriction (&rest body)
@ -407,14 +406,13 @@ Return the result of the last expression in BODY."
(if (listp window-info)
(mapcar (lambda (one-window-info)
(if one-window-info
(apply (function
(lambda (window buffer point start hscroll)
(if (edebug-window-live-p window)
(progn
(set-window-buffer window buffer)
(set-window-point window point)
(set-window-start window start)
(set-window-hscroll window hscroll)))))
(apply (lambda (window buffer point start hscroll)
(if (edebug-window-live-p window)
(progn
(set-window-buffer window buffer)
(set-window-point window point)
(set-window-start window start)
(set-window-hscroll window hscroll))))
one-window-info)))
window-info)
(set-window-configuration window-info)))

16
lisp/emacs-lisp/lisp.el
View file

@ -784,9 +784,17 @@ This command assumes point is not in a string or comment."
(interactive "P")
(insert-pair arg ?\( ?\)))
(defcustom delete-pair-blink-delay blink-matching-delay
"Time in seconds to delay after showing a paired character to delete.
It's used by the command `delete-pair'. The value 0 disables blinking."
:type 'number
:group 'lisp
:version "28.1")
(defun delete-pair (&optional arg)
"Delete a pair of characters enclosing ARG sexps that follow point.
A negative ARG deletes a pair around the preceding ARG sexps instead."
A negative ARG deletes a pair around the preceding ARG sexps instead.
The option `delete-pair-blink-delay' can disable blinking."
(interactive "P")
(if arg
(setq arg (prefix-numeric-value arg))
@ -802,6 +810,9 @@ A negative ARG deletes a pair around the preceding ARG sexps instead."
(if (= (length p) 3) (cdr p) p))
insert-pair-alist))
(error "Not after matching pair"))
(when (and (numberp delete-pair-blink-delay)
(> delete-pair-blink-delay 0))
(sit-for delete-pair-blink-delay))
(delete-char 1)))
(delete-char -1))
(save-excursion
@ -814,6 +825,9 @@ A negative ARG deletes a pair around the preceding ARG sexps instead."
(if (= (length p) 3) (cdr p) p))
insert-pair-alist))
(error "Not before matching pair"))
(when (and (numberp delete-pair-blink-delay)
(> delete-pair-blink-delay 0))
(sit-for delete-pair-blink-delay))
(delete-char -1)))
(delete-char 1))))

46
lisp/emacs-lisp/package.el
View file

@ -2129,8 +2129,7 @@ Otherwise return nil."
(when str
(when (string-match "\\`[ \t]*[$]Revision:[ \t]+" str)
(setq str (substring str (match-end 0))))
(ignore-errors
(if (version-to-list str) str))))
(if (version-to-list str) str)))
(declare-function lm-homepage "lisp-mnt" (&optional file))
@ -2731,7 +2730,9 @@ either a full name or nil, and EMAIL is a valid email address."
(define-key map "(" #'package-menu-toggle-hiding)
(define-key map (kbd "/ /") 'package-menu-clear-filter)
(define-key map (kbd "/ a") 'package-menu-filter-by-archive)
(define-key map (kbd "/ d") 'package-menu-filter-by-description)
(define-key map (kbd "/ k") 'package-menu-filter-by-keyword)
(define-key map (kbd "/ N") 'package-menu-filter-by-name-or-description)
(define-key map (kbd "/ n") 'package-menu-filter-by-name)
(define-key map (kbd "/ s") 'package-menu-filter-by-status)
(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."
"--"
("Filter Packages"
["Filter by Archive" package-menu-filter-by-archive :help "Filter packages by archive"]
["Filter by Description" package-menu-filter-by-description :help "Filter packages by description"]
["Filter by Keyword" package-menu-filter-by-keyword :help "Filter packages by keyword"]
["Filter by Name" package-menu-filter-by-name :help "Filter packages by name"]
["Filter by Name or Description" package-menu-filter-by-name-or-description
:help "Filter packages by name or description"]
["Filter by Status" package-menu-filter-by-status :help "Filter packages by status"]
["Filter by Version" package-menu-filter-by-version :help "Filter packages by version"]
["Filter Marked" package-menu-filter-marked :help "Filter packages marked for upgrade"]
@ -3792,6 +3796,23 @@ packages."
(string-join archive ",")
archive)))))
(defun package-menu-filter-by-description (description)
"Filter the \"*Packages*\" buffer by DESCRIPTION regexp.
Display only packages with a description that matches regexp
DESCRIPTION.
When called interactively, prompt for DESCRIPTION.
If DESCRIPTION is nil or the empty string, show all packages."
(interactive (list (read-regexp "Filter by description (regexp)")))
(package--ensure-package-menu-mode)
(if (or (not description) (string-empty-p description))
(package-menu--generate t t)
(package-menu--filter-by (lambda (pkg-desc)
(string-match description
(package-desc-summary pkg-desc)))
(format "desc:%s" description))))
(defun package-menu-filter-by-keyword (keyword)
"Filter the \"*Packages*\" buffer by KEYWORD.
Display only packages with specified KEYWORD.
@ -3817,6 +3838,27 @@ packages."
(define-obsolete-function-alias
'package-menu-filter #'package-menu-filter-by-keyword "27.1")
(defun package-menu-filter-by-name-or-description (name-or-description)
"Filter the \"*Packages*\" buffer by NAME-OR-DESCRIPTION regexp.
Display only packages with a name-or-description that matches regexp
NAME-OR-DESCRIPTION.
When called interactively, prompt for NAME-OR-DESCRIPTION.
If NAME-OR-DESCRIPTION is nil or the empty string, show all
packages."
(interactive (list (read-regexp "Filter by name or description (regexp)")))
(package--ensure-package-menu-mode)
(if (or (not name-or-description) (string-empty-p name-or-description))
(package-menu--generate t t)
(package-menu--filter-by (lambda (pkg-desc)
(or (string-match name-or-description
(package-desc-summary pkg-desc))
(string-match name-or-description
(symbol-name
(package-desc-name pkg-desc)))))
(format "name-or-desc:%s" name-or-description))))
(defun package-menu-filter-by-name (name)
"Filter the \"*Packages*\" buffer by NAME regexp.
Display only packages with name that matches regexp NAME.

40
lisp/emacs-lisp/pp.el
View file

@ -94,27 +94,25 @@ after OUT-BUFFER-NAME."
;; This function either decides not to display it at all
;; or displays it in the usual way.
(temp-buffer-show-function
(function
(lambda (buf)
(with-current-buffer buf
(goto-char (point-min))
(end-of-line 1)
(if (or (< (1+ (point)) (point-max))
(>= (- (point) (point-min)) (frame-width)))
(let ((temp-buffer-show-function old-show-function)
(old-selected (selected-window))
(window (display-buffer buf)))
(goto-char (point-min)) ; expected by some hooks ...
(make-frame-visible (window-frame window))
(unwind-protect
(progn
(select-window window)
(run-hooks 'temp-buffer-show-hook))
(when (window-live-p old-selected)
(select-window old-selected))
(message "See buffer %s." out-buffer-name)))
(message "%s" (buffer-substring (point-min) (point)))
))))))
(lambda (buf)
(with-current-buffer buf
(goto-char (point-min))
(end-of-line 1)
(if (or (< (1+ (point)) (point-max))
(>= (- (point) (point-min)) (frame-width)))
(let ((temp-buffer-show-function old-show-function)
(old-selected (selected-window))
(window (display-buffer buf)))
(goto-char (point-min)) ; expected by some hooks ...
(make-frame-visible (window-frame window))
(unwind-protect
(progn
(select-window window)
(run-hooks 'temp-buffer-show-hook))
(when (window-live-p old-selected)
(select-window old-selected))
(message "See buffer %s." out-buffer-name)))
(message "%s" (buffer-substring (point-min) (point))))))))
(with-output-to-temp-buffer out-buffer-name
(pp expression)
(with-current-buffer standard-output

21
lisp/emacs-lisp/regi.el
View file

@ -163,18 +163,15 @@ useful information:
;; let's find the special tags and remove them from the working
;; frame. note that only the last special tag is used.
(mapc
(function
(lambda (entry)
(let ((pred (car entry))
(func (car (cdr entry))))
(cond
((eq pred 'begin) (setq begin-tag func))
((eq pred 'end) (setq end-tag func))
((eq pred 'every) (setq every-tag func))
(t
(setq working-frame (append working-frame (list entry))))
) ; end-cond
)))
(lambda (entry)
(let ((pred (car entry))
(func (car (cdr entry))))
(cond
((eq pred 'begin) (setq begin-tag func))
((eq pred 'end) (setq end-tag func))
((eq pred 'every) (setq every-tag func))
(t
(setq working-frame (append working-frame (list entry)))))))
frame) ; end-mapcar
;; execute the begin entry

3
lisp/emulation/edt.el
View file

@ -2161,8 +2161,7 @@ Argument KEY is the name of a key. It can be a standard key or a function key.
Argument BINDING is the Emacs function to be bound to <KEY>."
(define-key edt-user-global-map key binding))
;; For backward compatibility to existing edt-user.el files.
(fset 'edt-bind-standard-key (symbol-function 'edt-bind-key))
(define-obsolete-function-alias 'edt-bind-standard-key #'edt-bind-key "28.1")
(defun edt-bind-gold-key (key gold-binding)
"Binds <GOLD> standard key sequences to custom bindings in the EDT Emulator.

8
lisp/emulation/viper-util.el
View file

@ -249,15 +249,7 @@ Otherwise return the normal value."
(goto-char cur-pos)
result))
;; Emacs used to count each multibyte character as several positions in the buffer,
;; so we had to use Emacs's chars-in-region to count characters. Since 20.3,
;; Emacs counts multibyte characters as 1 position. XEmacs has always been
;; counting each char as just one pos. So, now we can simply subtract beg from
;; end to determine the number of characters in a region.
(defun viper-chars-in-region (beg end &optional preserve-sign)
;;(let ((count (abs (if (fboundp 'chars-in-region)
;; (chars-in-region beg end)
;; (- end beg)))))
(let ((count (abs (- end beg))))
(if (and (< end beg) preserve-sign)
(- count)

9
lisp/epa.el
View file

@ -24,7 +24,6 @@
;;; Dependencies
(require 'epg)
(require 'font-lock)
(eval-when-compile (require 'subr-x))
(require 'derived)
@ -1071,9 +1070,7 @@ If no one is selected, default secret key is used. "
(list 'epa-coding-system-used
epa-last-coding-system-specified
'front-sticky nil
'rear-nonsticky t
'start-open t
'end-open t)))))
'rear-nonsticky t)))))
(define-obsolete-function-alias 'epa--derived-mode-p 'derived-mode-p "28.1")
@ -1148,9 +1145,7 @@ If no one is selected, symmetric encryption will be performed. ")
(list 'epa-coding-system-used
epa-last-coding-system-specified
'front-sticky nil
'rear-nonsticky t
'start-open t
'end-open t)))))
'rear-nonsticky t)))))
;;;; Key Management

3
lisp/erc/erc-log.el
View file

@ -414,8 +414,7 @@ You can save every individual message by putting this function on
(or buffer (setq buffer (current-buffer)))
(when (erc-logging-enabled buffer)
(let ((file (erc-current-logfile buffer))
(coding-system erc-log-file-coding-system)
(inhibit-clash-detection t)) ; needed for XEmacs
(coding-system erc-log-file-coding-system))
(save-excursion
(with-current-buffer buffer
(save-restriction

4
lisp/erc/erc.el
View file

@ -58,7 +58,6 @@
(load "erc-loaddefs" nil t)
(require 'cl-lib)
(require 'font-lock)
(require 'format-spec)
(require 'pp)
(require 'thingatpt)
@ -4015,8 +4014,7 @@ If FACE is non-nil, it will be used to propertize the prompt. If it is nil,
;; of the prompt, but stuff typed in front of the prompt
;; shall remain part of the prompt.
(setq prompt (propertize prompt
'start-open t ; XEmacs
'rear-nonsticky t ; Emacs
'rear-nonsticky t
'erc-prompt t
'field t
'front-sticky t

9
lisp/eshell/em-basic.el
View file

@ -90,11 +90,10 @@ or `eshell-printn' for display."
(car args))
(t
(mapcar
(function
(lambda (arg)
(if (stringp arg)
(set-text-properties 0 (length arg) nil arg))
arg))
(lambda (arg)
(if (stringp arg)
(set-text-properties 0 (length arg) nil arg))
arg)
args)))))
(if output-newline
(cond

53
lisp/eshell/em-cmpl.el
View file

@ -210,9 +210,8 @@ to writing a completion function."
:group 'eshell-cmpl)
(defcustom eshell-command-completion-function
(function
(lambda ()
(pcomplete-here (eshell-complete-commands-list))))
(lambda ()
(pcomplete-here (eshell-complete-commands-list)))
(eshell-cmpl--custom-variable-docstring 'pcomplete-command-completion-function)
:type (get 'pcomplete-command-completion-function 'custom-type)
:group 'eshell-cmpl)
@ -224,12 +223,11 @@ to writing a completion function."
:group 'eshell-cmpl)
(defcustom eshell-default-completion-function
(function
(lambda ()
(while (pcomplete-here
(pcomplete-dirs-or-entries
(cdr (assoc (funcall eshell-cmpl-command-name-function)
eshell-command-completions-alist)))))))
(lambda ()
(while (pcomplete-here
(pcomplete-dirs-or-entries
(cdr (assoc (funcall eshell-cmpl-command-name-function)
eshell-command-completions-alist))))))
(eshell-cmpl--custom-variable-docstring 'pcomplete-default-completion-function)
:type (get 'pcomplete-default-completion-function 'custom-type)
:group 'eshell-cmpl)
@ -308,10 +306,9 @@ to writing a completion function."
;; load-hooks for any other extension modules have been run, which
;; is true at the time `eshell-mode-hook' is run
(add-hook 'eshell-mode-hook
(function
(lambda ()
(set (make-local-variable 'comint-file-name-quote-list)
eshell-special-chars-outside-quoting)))
(lambda ()
(set (make-local-variable 'comint-file-name-quote-list)
eshell-special-chars-outside-quoting))
nil t)
(add-hook 'pcomplete-quote-arg-hook #'eshell-quote-backslash nil t)
(add-hook 'completion-at-point-functions
@ -391,19 +388,18 @@ to writing a completion function."
(nconc args (list ""))
(nconc posns (list (point))))
(cons (mapcar
(function
(lambda (arg)
(let ((val
(if (listp arg)
(let ((result
(eshell-do-eval
(list 'eshell-commands arg) t)))
(cl-assert (eq (car result) 'quote))
(cadr result))
arg)))
(if (numberp val)
(setq val (number-to-string val)))
(or val ""))))
(lambda (arg)
(let ((val
(if (listp arg)
(let ((result
(eshell-do-eval
(list 'eshell-commands arg) t)))
(cl-assert (eq (car result) 'quote))
(cadr result))
arg)))
(if (numberp val)
(setq val (number-to-string val)))
(or val "")))
args)
posns)))
@ -454,9 +450,8 @@ to writing a completion function."
(eshell-alias-completions filename))
(eshell-winnow-list
(mapcar
(function
(lambda (name)
(substring name 7)))
(lambda (name)
(substring name 7))
(all-completions (concat "eshell/" filename)
obarray #'functionp))
nil '(eshell-find-alias-function))

5
lisp/eshell/em-dirs.el
View file

@ -289,9 +289,8 @@ Thus, this does not include the current directory.")
(eshell-read-user-names)
(pcomplete-uniquify-list
(mapcar
(function
(lambda (user)
(file-name-as-directory (cdr user))))
(lambda (user)
(file-name-as-directory (cdr user)))
eshell-user-names)))))))
(defun eshell/pwd (&rest _args)

19
lisp/eshell/em-hist.el
View file

@ -79,9 +79,8 @@
(defcustom eshell-hist-unload-hook
(list
(function
(lambda ()
(remove-hook 'kill-emacs-hook 'eshell-save-some-history))))
(lambda ()
(remove-hook 'kill-emacs-hook 'eshell-save-some-history)))
"A hook that gets run when `eshell-hist' is unloaded."
:type 'hook)
@ -250,16 +249,14 @@ Returns nil if INPUT is prepended by blank space, otherwise non-nil."
(set (make-local-variable 'search-invisible) t)
(set (make-local-variable 'search-exit-option) t)
(add-hook 'isearch-mode-hook
(function
(lambda ()
(if (>= (point) eshell-last-output-end)
(setq overriding-terminal-local-map
eshell-isearch-map))))
(lambda ()
(if (>= (point) eshell-last-output-end)
(setq overriding-terminal-local-map
eshell-isearch-map)))
nil t)
(add-hook 'isearch-mode-end-hook
(function
(lambda ()
(setq overriding-terminal-local-map nil)))
(lambda ()
(setq overriding-terminal-local-map nil))
nil t))
(eshell-hist-mode))

76
lisp/eshell/em-ls.el
View file

@ -270,8 +270,7 @@ instead."
eshell-current-subjob-p
font-lock-mode)
;; use the fancy highlighting in `eshell-ls' rather than font-lock
(when (and eshell-ls-use-colors
(featurep 'font-lock))
(when eshell-ls-use-colors
(font-lock-mode -1)
(setq font-lock-defaults nil)
(if (boundp 'font-lock-buffers)
@ -631,38 +630,37 @@ In Eshell's implementation of ls, ENTRIES is always reversed."
(if (eq sort-method 'unsorted)
(nreverse entries)
(sort entries
(function
(lambda (l r)
(let ((result
(cond
((eq sort-method 'by-atime)
(eshell-ls-compare-entries l r 4 'time-less-p))
((eq sort-method 'by-mtime)
(eshell-ls-compare-entries l r 5 'time-less-p))
((eq sort-method 'by-ctime)
(eshell-ls-compare-entries l r 6 'time-less-p))
((eq sort-method 'by-size)
(eshell-ls-compare-entries l r 7 '<))
((eq sort-method 'by-extension)
(let ((lx (file-name-extension
(directory-file-name (car l))))
(rx (file-name-extension
(directory-file-name (car r)))))
(cond
((or (and (not lx) (not rx))
(equal lx rx))
(string-lessp (directory-file-name (car l))
(directory-file-name (car r))))
((not lx) t)
((not rx) nil)
(t
(string-lessp lx rx)))))
(t
(string-lessp (directory-file-name (car l))
(directory-file-name (car r)))))))
(if reverse-list
(not result)
result)))))))
(lambda (l r)
(let ((result
(cond
((eq sort-method 'by-atime)
(eshell-ls-compare-entries l r 4 'time-less-p))
((eq sort-method 'by-mtime)
(eshell-ls-compare-entries l r 5 'time-less-p))
((eq sort-method 'by-ctime)
(eshell-ls-compare-entries l r 6 'time-less-p))
((eq sort-method 'by-size)
(eshell-ls-compare-entries l r 7 '<))
((eq sort-method 'by-extension)
(let ((lx (file-name-extension
(directory-file-name (car l))))
(rx (file-name-extension
(directory-file-name (car r)))))
(cond
((or (and (not lx) (not rx))
(equal lx rx))
(string-lessp (directory-file-name (car l))
(directory-file-name (car r))))
((not lx) t)
((not rx) nil)
(t
(string-lessp lx rx)))))
(t
(string-lessp (directory-file-name (car l))
(directory-file-name (car r)))))))
(if reverse-list
(not result)
result))))))
(defun eshell-ls-files (files &optional size-width copy-fileinfo)
"Output a list of FILES.
@ -799,9 +797,8 @@ to use, and each member of which is the width of that column
(width 0)
(widths
(mapcar
(function
(lambda (file)
(+ 2 (length (car file)))))
(lambda (file)
(+ 2 (length (car file))))
files))
;; must account for the added space...
(max-width (+ (window-width) 2))
@ -846,9 +843,8 @@ to use, and each member of which is the width of that column
(width 0)
(widths
(mapcar
(function
(lambda (file)
(+ 2 (length (car file)))))
(lambda (file)
(+ 2 (length (car file))))
files))
(max-width (+ (window-width) 2))
col-widths

46
lisp/eshell/em-pred.el
View file

@ -116,10 +116,9 @@ The format of each entry is
(defcustom eshell-modifier-alist
'((?E . #'(lambda (lst)
(mapcar
(function
(lambda (str)
(eshell-stringify
(car (eshell-parse-argument str)))))
(lambda (str)
(eshell-stringify
(car (eshell-parse-argument str))))
lst)))
(?L . #'(lambda (lst) (mapcar 'downcase lst)))
(?U . #'(lambda (lst) (mapcar 'upcase lst)))
@ -240,16 +239,14 @@ EXAMPLES:
(defun eshell-display-predicate-help ()
(interactive)
(with-electric-help
(function
(lambda ()
(insert eshell-predicate-help-string)))))
(lambda ()
(insert eshell-predicate-help-string))))
(defun eshell-display-modifier-help ()
(interactive)
(with-electric-help
(function
(lambda ()
(insert eshell-modifier-help-string)))))
(lambda ()
(insert eshell-modifier-help-string))))
(define-minor-mode eshell-pred-mode
"Minor mode for the eshell-pred module.
@ -544,20 +541,20 @@ that `ls -l' will show in the first column of its display."
(if repeat
`(lambda (lst)
(mapcar
(function
(lambda (str)
(let ((i 0))
(while (setq i (string-match ,match str i))
(setq str (replace-match ,replace t nil str))))
str)) lst))
(lambda (str)
(let ((i 0))
(while (setq i (string-match ,match str i))
(setq str (replace-match ,replace t nil str))))
str)
lst))
`(lambda (lst)
(mapcar
(function
(lambda (str)
(if (string-match ,match str)
(setq str (replace-match ,replace t nil str))
(error (concat str ": substitution failed")))
str)) lst)))))
(lambda (str)
(if (string-match ,match str)
(setq str (replace-match ,replace t nil str))
(error (concat str ": substitution failed")))
str)
lst)))))
(defun eshell-include-members (&optional invert-p)
"Include only lisp members matching a regexp."
@ -598,9 +595,8 @@ that `ls -l' will show in the first column of its display."
(goto-char (1+ end)))
`(lambda (lst)
(mapcar
(function
(lambda (str)
(split-string str ,sep))) lst))))
(lambda (str)
(split-string str ,sep)) lst))))
(provide 'em-pred)

7
lisp/eshell/em-prompt.el
View file

@ -48,10 +48,9 @@ as is common with most shells."
(autoload 'eshell/pwd "em-dirs")
(defcustom eshell-prompt-function
(function
(lambda ()
(concat (abbreviate-file-name (eshell/pwd))
(if (= (user-uid) 0) " # " " $ "))))
(lambda ()
(concat (abbreviate-file-name (eshell/pwd))
(if (= (user-uid) 0) " # " " $ ")))
"A function that returns the Eshell prompt string.
Make sure to update `eshell-prompt-regexp' so that it will match your
prompt."

25
lisp/eshell/em-smart.el
View file

@ -94,10 +94,9 @@ it to get a real sense of how it works."
(defcustom eshell-smart-unload-hook
(list
(function
(lambda ()
(remove-hook 'window-configuration-change-hook
'eshell-refresh-windows))))
(lambda ()
(remove-hook 'window-configuration-change-hook
'eshell-refresh-windows)))
"A hook that gets run when `eshell-smart' is unloaded."
:type 'hook
:group 'eshell-smart)
@ -186,9 +185,8 @@ The options are `begin', `after' or `end'."
(make-local-variable 'eshell-smart-command-done)
(add-hook 'eshell-post-command-hook
(function
(lambda ()
(setq eshell-smart-command-done t)))
(lambda ()
(setq eshell-smart-command-done t))
t t)
(unless (eq eshell-review-quick-commands t)
@ -208,13 +206,12 @@ The options are `begin', `after' or `end'."
"Refresh all visible Eshell buffers."
(let (affected)
(walk-windows
(function
(lambda (wind)
(with-current-buffer (window-buffer wind)
(if eshell-mode
(let (window-scroll-functions) ;;FIXME: Why?
(eshell-smart-scroll-window wind (window-start))
(setq affected t))))))
(lambda (wind)
(with-current-buffer (window-buffer wind)
(if eshell-mode
(let (window-scroll-functions) ;;FIXME: Why?
(eshell-smart-scroll-window wind (window-start))
(setq affected t)))))
0 frame)
(if affected
(let (window-scroll-functions) ;;FIXME: Why?

5
lisp/eshell/em-unix.el
View file

@ -419,9 +419,8 @@ Remove the DIRECTORY(ies), if they are empty.")
(apply 'eshell-shuffle-files
command action
(mapcar
(function
(lambda (file)
(concat source "/" file)))
(lambda (file)
(concat source "/" file))
(directory-files source))
target func t args)
(when (eq func 'rename-file)

79
lisp/eshell/esh-arg.el
View file

@ -85,51 +85,48 @@ If POS is nil, the location of point is checked."
'eshell-parse-special-reference
;; numbers convert to numbers if they stand alone
(function
(lambda ()
(when (and (not eshell-current-argument)
(not eshell-current-quoted)
(looking-at eshell-number-regexp)
(eshell-arg-delimiter (match-end 0)))
(goto-char (match-end 0))
(let ((str (match-string 0)))
(if (> (length str) 0)
(add-text-properties 0 (length str) '(number t) str))
str))))
(lambda ()
(when (and (not eshell-current-argument)
(not eshell-current-quoted)
(looking-at eshell-number-regexp)
(eshell-arg-delimiter (match-end 0)))
(goto-char (match-end 0))
(let ((str (match-string 0)))
(if (> (length str) 0)
(add-text-properties 0 (length str) '(number t) str))
str)))
;; parse any non-special characters, based on the current context
(function
(lambda ()
(unless eshell-inside-quote-regexp
(setq eshell-inside-quote-regexp
(format "[^%s]+"
(apply 'string eshell-special-chars-inside-quoting))))
(unless eshell-outside-quote-regexp
(setq eshell-outside-quote-regexp
(format "[^%s]+"
(apply 'string eshell-special-chars-outside-quoting))))
(when (looking-at (if eshell-current-quoted
eshell-inside-quote-regexp
eshell-outside-quote-regexp))
(goto-char (match-end 0))
(let ((str (match-string 0)))
(if str
(set-text-properties 0 (length str) nil str))
str))))
(lambda ()
(unless eshell-inside-quote-regexp
(setq eshell-inside-quote-regexp
(format "[^%s]+"
(apply 'string eshell-special-chars-inside-quoting))))
(unless eshell-outside-quote-regexp
(setq eshell-outside-quote-regexp
(format "[^%s]+"
(apply 'string eshell-special-chars-outside-quoting))))
(when (looking-at (if eshell-current-quoted
eshell-inside-quote-regexp
eshell-outside-quote-regexp))
(goto-char (match-end 0))
(let ((str (match-string 0)))
(if str
(set-text-properties 0 (length str) nil str))
str)))
;; whitespace or a comment is an argument delimiter
(function
(lambda ()
(let (comment-p)
(when (or (looking-at "[ \t]+")
(and (not eshell-current-argument)
(looking-at "#\\([^<'].*\\|$\\)")
(setq comment-p t)))
(if comment-p
(add-text-properties (match-beginning 0) (match-end 0)
'(comment t)))
(goto-char (match-end 0))
(eshell-finish-arg)))))
(lambda ()
(let (comment-p)
(when (or (looking-at "[ \t]+")
(and (not eshell-current-argument)
(looking-at "#\\([^<'].*\\|$\\)")
(setq comment-p t)))
(if comment-p
(add-text-properties (match-beginning 0) (match-end 0)
'(comment t)))
(goto-char (match-end 0))
(eshell-finish-arg))))
;; parse backslash and the character after
'eshell-parse-backslash

32
lisp/eshell/esh-cmd.el
View file

@ -304,10 +304,9 @@ otherwise t.")
;; situation can occur, for example, if a Lisp function results in
;; `debug' being called, and the user then types \\[top-level]
(add-hook 'eshell-post-command-hook
(function
(lambda ()
(setq eshell-current-command nil
eshell-last-async-proc nil)))
(lambda ()
(setq eshell-current-command nil
eshell-last-async-proc nil))
nil t)
(add-hook 'eshell-parse-argument-hook
@ -355,18 +354,17 @@ hooks should be run before and after the command."
args))
(commands
(mapcar
(function
(lambda (cmd)
(setq cmd
(if (or (not (car eshell--sep-terms))
(string= (car eshell--sep-terms) ";"))
(eshell-parse-pipeline cmd)
`(eshell-do-subjob
(list ,(eshell-parse-pipeline cmd)))))
(setq eshell--sep-terms (cdr eshell--sep-terms))
(if eshell-in-pipeline-p
cmd
`(eshell-trap-errors ,cmd))))
(lambda (cmd)
(setq cmd
(if (or (not (car eshell--sep-terms))
(string= (car eshell--sep-terms) ";"))
(eshell-parse-pipeline cmd)
`(eshell-do-subjob
(list ,(eshell-parse-pipeline cmd)))))
(setq eshell--sep-terms (cdr eshell--sep-terms))
(if eshell-in-pipeline-p
cmd
`(eshell-trap-errors ,cmd)))
(eshell-separate-commands terms "[&;]" nil 'eshell--sep-terms))))
(let ((cmd commands))
(while cmd
@ -920,7 +918,7 @@ at the moment are:
(funcall pred name))
(throw 'simple nil)))
t))
(fboundp (intern-soft (concat "eshell/" name))))))
(eshell-find-alias-function name))))
(defun eshell-eval-command (command &optional input)
"Evaluate the given COMMAND iteratively."

58
lisp/eshell/esh-mode.el
View file

@ -742,13 +742,12 @@ This function should be a pre-command hook."
(if (eq scroll 'this)
(goto-char (point-max))
(walk-windows
(function
(lambda (window)
(when (and (eq (window-buffer window) current)
(or (eq scroll t) (eq scroll 'all)))
(select-window window)
(goto-char (point-max))
(select-window selected))))
(lambda (window)
(when (and (eq (window-buffer window) current)
(or (eq scroll t) (eq scroll 'all)))
(select-window window)
(goto-char (point-max))
(select-window selected)))
nil t))))))
;;; jww (1999-10-23): this needs testing
@ -764,29 +763,28 @@ This function should be in the list `eshell-output-filter-functions'."
(scroll eshell-scroll-to-bottom-on-output))
(unwind-protect
(walk-windows
(function
(lambda (window)
(if (eq (window-buffer window) current)
(progn
(select-window window)
(if (and (< (point) eshell-last-output-end)
(or (eq scroll t) (eq scroll 'all)
;; Maybe user wants point to jump to end.
(and (eq scroll 'this)
(eq selected window))
(and (eq scroll 'others)
(not (eq selected window)))
;; If point was at the end, keep it at end.
(>= (point) eshell-last-output-start)))
(goto-char eshell-last-output-end))
;; Optionally scroll so that the text
;; ends at the bottom of the window.
(if (and eshell-scroll-show-maximum-output
(>= (point) eshell-last-output-end))
(save-excursion
(goto-char (point-max))
(recenter -1)))
(select-window selected)))))
(lambda (window)
(if (eq (window-buffer window) current)
(progn
(select-window window)
(if (and (< (point) eshell-last-output-end)
(or (eq scroll t) (eq scroll 'all)
;; Maybe user wants point to jump to end.
(and (eq scroll 'this)
(eq selected window))
(and (eq scroll 'others)
(not (eq selected window)))
;; If point was at the end, keep it at end.
(>= (point) eshell-last-output-start)))
(goto-char eshell-last-output-end))
;; Optionally scroll so that the text
;; ends at the bottom of the window.
(if (and eshell-scroll-show-maximum-output
(>= (point) eshell-last-output-end))
(save-excursion
(goto-char (point-max))
(recenter -1)))
(select-window selected))))
nil t)
(set-buffer current))))

19
lisp/eshell/esh-module.el
View file

@ -65,16 +65,15 @@ Changes will only take effect in future Eshell buffers."
:type (append
(list 'set ':tag "Supported modules")
(mapcar
(function
(lambda (modname)
(let ((modsym (intern modname)))
(list 'const
':tag (format "%s -- %s" modname
(get modsym 'custom-tag))
':link (caar (get modsym 'custom-links))
':doc (concat "\n" (get modsym 'group-documentation)
"\n ")
modsym))))
(lambda (modname)
(let ((modsym (intern modname)))
(list 'const
':tag (format "%s -- %s" modname
(get modsym 'custom-tag))
':link (caar (get modsym 'custom-links))
':doc (concat "\n" (get modsym 'group-documentation)
"\n ")
modsym)))
(sort (mapcar 'symbol-name
(eshell-subgroups 'eshell-module))
'string-lessp))

10
lisp/eshell/esh-proc.el
View file

@ -215,9 +215,8 @@ and signal names."
The prompt will be set to PROMPT."
(completing-read prompt
(mapcar
(function
(lambda (proc)
(cons (process-name proc) t)))
(lambda (proc)
(cons (process-name proc) t))
(process-list))
nil t))
@ -499,9 +498,8 @@ See the variable `eshell-kill-processes-on-exit'."
(let ((sigs eshell-kill-process-signals))
(while sigs
(eshell-process-interact
(function
(lambda (proc)
(signal-process (process-id proc) (car sigs)))) t query)
(lambda (proc)
(signal-process (process-id proc) (car sigs))) t query)
(setq query nil)
(if (not eshell-process-list)
(setq sigs nil)

20
lisp/eshell/esh-var.el
View file

@ -382,9 +382,8 @@ This function is explicit for adding to `eshell-parse-argument-hook'."
(defun eshell-envvar-names (&optional environment)
"Return a list of currently visible environment variable names."
(mapcar (function
(lambda (x)
(substring x 0 (string-match "=" x))))
(mapcar (lambda (x)
(substring x 0 (string-match "=" x)))
(or environment process-environment)))
(defun eshell-environment-variables ()
@ -618,14 +617,13 @@ For example, to retrieve the second element of a user's record in
(sort
(append
(mapcar
(function
(lambda (varname)
(let ((value (eshell-get-variable varname)))
(if (and value
(stringp value)
(file-directory-p value))
(concat varname "/")
varname))))
(lambda (varname)
(let ((value (eshell-get-variable varname)))
(if (and value
(stringp value)
(file-directory-p value))
(concat varname "/")
varname)))
(eshell-envvar-names (eshell-environment-variables)))
(all-completions argname obarray 'boundp)
completions)

45
lisp/ffap.el
View file

@ -301,15 +301,14 @@ disable ffap most of the time."
:version "20.3")
;;; Compatibility:
;;
;; This version of ffap supports only the Emacs it is distributed in.
;; See the ftp site for a more general version. The following
;; functions are necessary "leftovers" from the more general version.
;;; Obsolete:
(defun ffap-mouse-event () ; current mouse event, or nil
(declare (obsolete nil "28.1"))
(and (listp last-nonmenu-event) last-nonmenu-event))
(defun ffap-event-buffer (event)
(declare (obsolete nil "28.1"))
(window-buffer (car (event-start event))))
@ -690,14 +689,13 @@ Optional DEPTH limits search depth."
(setq depth (1- depth))
(cons dir
(and (not (eq depth -1))
(apply 'nconc
(apply #'nconc
(mapcar
(function
(lambda (d)
(cond
((not (file-directory-p d)) nil)
((file-symlink-p d) (list d))
(t (ffap-all-subdirs-loop d depth)))))
(lambda (d)
(cond
((not (file-directory-p d)) nil)
((file-symlink-p d) (list d))
(t (ffap-all-subdirs-loop d depth))))
(directory-files dir t "\\`[^.]")
)))))
@ -710,13 +708,12 @@ Set to 0 to avoid all searching, or nil for no limit.")
The subdirs begin with the original directory, and the depth of the
search is bounded by `ffap-kpathsea-depth'. This is intended to mimic
kpathsea, a library used by some versions of TeX."
(apply 'nconc
(apply #'nconc
(mapcar
(function
(lambda (dir)
(if (string-match "[^/]//\\'" dir)
(ffap-all-subdirs (substring dir 0 -2) ffap-kpathsea-depth)
(list dir))))
(lambda (dir)
(if (string-match "[^/]//\\'" dir)
(ffap-all-subdirs (substring dir 0 -2) ffap-kpathsea-depth)
(list dir)))
path)))
(defun ffap-locate-file (file nosuffix path)
@ -1738,7 +1735,9 @@ Function CONT is applied to the entry chosen by the user."
(let (choice)
(cond
;; Emacs mouse:
((and (fboundp 'x-popup-menu) (ffap-mouse-event))
((and (fboundp 'x-popup-menu)
(listp last-nonmenu-event)
last-nonmenu-event)
(setq choice
(x-popup-menu
t
@ -1793,8 +1792,7 @@ Applies `ffap-menu-text-plist' text properties at all matches."
;; Remove duplicates.
(setq ffap-menu-alist ; sort by item
(sort ffap-menu-alist
(function
(lambda (a b) (string-lessp (car a) (car b))))))
(lambda (a b) (string-lessp (car a) (car b)))))
(let ((ptr ffap-menu-alist)) ; remove duplicates
(while (cdr ptr)
(if (equal (car (car ptr)) (car (car (cdr ptr))))
@ -1802,8 +1800,7 @@ Applies `ffap-menu-text-plist' text properties at all matches."
(setq ptr (cdr ptr)))))
(setq ffap-menu-alist ; sort by position
(sort ffap-menu-alist
(function
(lambda (a b) (< (cdr a) (cdr b)))))))
(lambda (a b) (< (cdr a) (cdr b))))))
;;; Mouse Support (`ffap-at-mouse'):
@ -1833,7 +1830,7 @@ Return value:
(ffap-guesser))))
(cond
(guess
(set-buffer (ffap-event-buffer e))
(set-buffer (window-buffer (car (event-start e))))
(ffap-highlight)
(unwind-protect
(progn

10
lisp/files-x.el
View file

@ -730,6 +730,16 @@ Execute BODY, and unwind connection-local variables."
;; No connection-local variables to apply.
,@body))
;;;###autoload
(defun path-separator ()
"The connection-local value of `path-separator'."
(with-connection-local-variables path-separator))
;;;###autoload
(defun null-device ()
"The connection-local value of `null-device'."
(with-connection-local-variables null-device))
(provide 'files-x)

65
lisp/files.el
View file

@ -2315,53 +2315,52 @@ the various files."
;; hexl-mode or image-mode.
(memq major-mode '(hexl-mode image-mode)))
(if (buffer-modified-p)
(if (y-or-n-p
(format
(if rawfile
"The file %s is already visited normally,
(if (let ((help-form
(format-message
(if rawfile "\
The file %s is already visited normally,
and you have edited the buffer. Now you have asked to visit it literally,
meaning no coding system handling, format conversion, or local variables.
Emacs can visit a file in only one way at a time.
Do you want to save the file, and visit it literally instead? "
"The file %s is already visited literally,
Emacs can visit a file in only one way at a time."
"\
The file %s is already visited literally,
meaning no coding system handling, format conversion, or local variables.
You have edited the buffer. Now you have asked to visit the file normally,
but Emacs can visit a file in only one way at a time.
Do you want to save the file, and visit it normally instead? ")
(file-name-nondirectory filename)))
but Emacs can visit a file in only one way at a time.")
(file-name-nondirectory filename))))
(y-or-n-p
(if rawfile "\
Do you want to save the file, and visit it literally instead? " "\
Do you want to save the file, and visit it normally instead? ")))
(progn
(save-buffer)
(find-file-noselect-1 buf filename nowarn
rawfile truename number))
(if (y-or-n-p
(format
(if rawfile
"\
Do you want to discard your changes, and visit the file literally now? "
"\
Do you want to discard your changes, and visit the file normally now? ")))
(if rawfile "\
Do you want to discard your changes, and visit the file literally now? " "\
Do you want to discard your changes, and visit the file normally now? "))
(find-file-noselect-1 buf filename nowarn
rawfile truename number)
(error (if rawfile "File already visited non-literally"
"File already visited literally"))))
(if (y-or-n-p
(format
(if rawfile
"The file %s is already visited normally.
(if (let ((help-form
(format-message
(if rawfile "\
The file %s is already visited normally.
You have asked to visit it literally,
meaning no coding system decoding, format conversion, or local variables.
But Emacs can visit a file in only one way at a time.
Do you want to revisit the file literally now? "
"The file %s is already visited literally,
But Emacs can visit a file in only one way at a time."
"\
The file %s is already visited literally,
meaning no coding system decoding, format conversion, or local variables.
You have asked to visit it normally,
but Emacs can visit a file in only one way at a time.
Do you want to revisit the file normally now? ")
(file-name-nondirectory filename)))
but Emacs can visit a file in only one way at a time.")
(file-name-nondirectory filename))))
(y-or-n-p
(if rawfile "\
Do you want to revisit the file literally now? " "\
Do you want to revisit the file normally now? ")))
(find-file-noselect-1 buf filename nowarn
rawfile truename number)
(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."
(save-some-buffers arg t)
(let ((confirm confirm-kill-emacs))
(and
(or (not (memq t (mapcar (function
(lambda (buf) (and (buffer-file-name buf)
(buffer-modified-p buf))))
(or (not (memq t (mapcar (lambda (buf)
(and (buffer-file-name buf)
(buffer-modified-p buf)))
(buffer-list))))
(progn (setq confirm nil)
(yes-or-no-p "Modified buffers exist; exit anyway? ")))

78
lisp/filesets.el
View file

@ -89,6 +89,7 @@
;;; Code:
(eval-when-compile (require 'cl-lib))
(require 'easymenu)
;;; Some variables
@ -308,7 +309,7 @@ SYM to VAL and return t. If INIT-FLAG is non-nil, set with
(defcustom filesets-menu-path '("File") ; cf recentf-menu-path
"The menu under which the filesets menu should be inserted.
See `add-submenu' for documentation."
See `easy-menu-add-item' for documentation."
:set (function filesets-set-default)
:type '(choice (const :tag "Top Level" nil)
(sexp :tag "Menu Path"))
@ -317,7 +318,7 @@ See `add-submenu' for documentation."
(defcustom filesets-menu-before "Open File..." ; cf recentf-menu-before
"The name of a menu before which this menu should be added.
See `add-submenu' for documentation."
See `easy-menu-add-item' for documentation."
:set (function filesets-set-default)
:type '(choice (string :tag "Name")
(const :tag "Last" nil))
@ -326,7 +327,7 @@ See `add-submenu' for documentation."
(defcustom filesets-menu-in-menu nil
"Use that instead of `current-menubar' as the menu to change.
See `add-submenu' for documentation."
See `easy-menu-add-item' for documentation."
:set (function filesets-set-default)
:type 'sexp
:group 'filesets)
@ -1075,18 +1076,6 @@ defined in `filesets-ingroup-patterns'."
:type 'integer
:group 'filesets)
;;; Emacs compatibility
(eval-and-compile
(if (featurep 'xemacs)
(fset 'filesets-error 'error)
(require 'easymenu)
(defun filesets-error (_class &rest args)
"`error' wrapper."
(error "%s" (mapconcat 'identity args " ")))
))
(defun filesets-filter-dir-names (lst &optional negative)
"Remove non-directory names from a list of strings.
@ -1160,7 +1149,7 @@ Return full path if FULL-FLAG is non-nil."
(filesets-message 1 "Filesets: %S doesn't exist" dir)
nil)
(t
(filesets-error 'error "Filesets: " dir " does not exist"))))
(error "Filesets: %s does not exist" dir))))
(defun filesets-quote (txt)
"Return TXT in quotes."
@ -1172,7 +1161,7 @@ Return full path if FULL-FLAG is non-nil."
(p (point)))
(if m
(buffer-substring (min m p) (max m p))
(filesets-error 'error "No selection."))))
(error "No selection"))))
(defun filesets-get-quoted-selection ()
"Return the currently selected text in quotes."
@ -1357,8 +1346,7 @@ Use the viewer defined in EV-ENTRY (a valid element of
(goto-char (point-min)))
(when oh
(run-hooks 'oh))))
(filesets-error 'error
"Filesets: general error when spawning external viewer"))))
(error "Filesets: general error when spawning external viewer"))))
(defun filesets-find-file (file)
"Call `find-file' after a possible delay (see `filesets-find-file-delay').
@ -1741,8 +1729,7 @@ Assume MODE (see `filesets-entry-mode'), if provided."
;;(filesets-message 3 "Filesets: scanning %s" dirpatt)
(filesets-directory-files dir patt ':files t))
;; (message "Filesets: malformed entry: %s" entry)))))))
(filesets-error 'error "Filesets: malformed entry: "
entry)))))))
(error "Filesets: malformed entry: %s" entry)))))))
(filesets-filter-list fl
(lambda (file)
(not (filesets-filetype-property file event))))))
@ -1768,7 +1755,7 @@ Use LOOKUP-NAME for searching additional data if provided."
(dolist (this files nil)
(filesets-file-open open-function this))
(message "Filesets: canceled")))
(filesets-error 'error "Filesets: Unknown fileset: " name))))
(error "Filesets: Unknown fileset: %s" name))))
(defun filesets-close (&optional mode name lookup-name)
"Close all buffers belonging to the fileset called NAME.
@ -1789,7 +1776,7 @@ Use LOOKUP-NAME for deducing the save-function, if provided."
(if buffer
(filesets-file-close save-function buffer)))))
; (message "Filesets: Unknown fileset: `%s'" name))))
(filesets-error 'error "Filesets: Unknown fileset: " name))))
(error "Filesets: Unknown fileset: %s" name))))
(defun filesets-add-buffer (&optional name buffer)
"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."
`(["Rebuild this submenu"
(filesets-rebuild-this-submenu ',lookup-name)]))))
(_
(filesets-error 'error "Filesets: malformed definition of " something))))
(error "Filesets: malformed definition of %s" something))))
(defun filesets-ingroup-get-data (master pos &optional fun)
"Access to `filesets-ingroup-patterns'. Extract data section."
@ -2070,8 +2057,7 @@ LOOKUP-NAME is used as lookup name for retrieving fileset specific settings."
(lst nil))
(cond
((not this-patt)
(filesets-error 'error "Filesets: malformed :ingroup definition "
this-def))
(error "Filesets: malformed :ingroup definition %s" this-def))
((< this-sd 0)
nil)
(t
@ -2174,7 +2160,7 @@ FS is a fileset's name. FLIST is a list returned by
(progn
(message "Filesets: can't parse %s" master)
nil)
(filesets-error 'error "Filesets: can't parse " master))))
(error "Filesets: can't parse %s" master))))
(defun filesets-build-dir-submenu-now (level depth entry lookup-name dir patt fd
&optional rebuild-flag)
@ -2349,21 +2335,20 @@ bottom up, set `filesets-submenus' to nil, first.)"
(filesets-menu-cache-file-save-maybe)))
(let ((cb (current-buffer)))
(when (not (member cb filesets-updated-buffers))
(add-submenu
filesets-menu-path
`(,filesets-menu-name
("# Filesets"
["Edit Filesets" filesets-edit]
["Save Filesets" filesets-save-config]
["Save Menu Cache" filesets-menu-cache-file-save]
["Rebuild Menu" filesets-build-menu]
["Customize" filesets-customize]
["About" filesets-info])
,(filesets-get-cmd-menu)
"---"
,@filesets-menu-cache)
filesets-menu-before
filesets-menu-in-menu)
(easy-menu-add-item (or filesets-menu-in-menu (current-global-map))
(cons "menu-bar" filesets-menu-path)
`(,filesets-menu-name
("# Filesets"
["Edit Filesets" filesets-edit]
["Save Filesets" filesets-save-config]
["Save Menu Cache" filesets-menu-cache-file-save]
["Rebuild Menu" filesets-build-menu]
["Customize" filesets-customize]
["About" filesets-info])
,(filesets-get-cmd-menu)
"---"
,@filesets-menu-cache)
filesets-menu-before)
(setq filesets-updated-buffers
(cons cb filesets-updated-buffers))
;; This wipes out other messages in the echo area.
@ -2474,7 +2459,7 @@ We apologize for the inconvenience.")))
(insert msg)
(when (y-or-n-p (format "Edit startup (%s) file now? " cf))
(find-file-other-window cf))
(filesets-error 'error msg))))
(error msg))))
(defun filesets-update (cached-version)
"Do some cleanup after updating filesets.el."
@ -2510,8 +2495,7 @@ We apologize for the inconvenience.")))
(defun filesets-init ()
"Filesets initialization.
Set up hooks, load the cache file -- if existing -- and build the menu."
(add-hook (if (featurep 'xemacs) 'activate-menubar-hook 'menu-bar-update-hook)
(function filesets-build-menu-maybe))
(add-hook 'menu-bar-update-hook #'filesets-build-menu-maybe)
(add-hook 'kill-buffer-hook (function filesets-remove-from-ubl))
(add-hook 'first-change-hook (function filesets-reset-filename-on-change))
(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."
(setq filesets-menu-use-cached-flag t)))
(filesets-build-menu)))
(defun filesets-error (_class &rest args)
"`error' wrapper."
(declare (obsolete error "28.1"))
(error "%s" (mapconcat 'identity args " ")))
(provide 'filesets)

24
lisp/find-lisp.el
View file

@ -221,15 +221,12 @@ It is a function which takes two arguments, the directory and its parent."
(make-local-variable 'revert-buffer-function)
(setq revert-buffer-function
(function
(lambda (_ignore1 _ignore2)
(find-lisp-insert-directory
default-directory
find-lisp-file-predicate
find-lisp-directory-predicate
'ignore)
)
))
(lambda (_ignore1 _ignore2)
(find-lisp-insert-directory
default-directory
find-lisp-file-predicate
find-lisp-directory-predicate
'ignore)))
;; Set subdir-alist so that Tree Dired will work:
(if (fboundp 'dired-simple-subdir-alist)
@ -267,11 +264,10 @@ It is a function which takes two arguments, the directory and its parent."
(insert find-lisp-line-indent "\n")
;; Run the find function
(mapc
(function
(lambda (file)
(find-lisp-find-dired-insert-file
(substring file len)
(current-buffer))))
(lambda (file)
(find-lisp-find-dired-insert-file
(substring file len)
(current-buffer)))
(sort files 'string-lessp))
;; FIXME: Sort function is ignored for now
;; (funcall sort-function files))

121
lisp/generic-x.el
View file

@ -107,8 +107,6 @@
;;; Code:
(eval-when-compile (require 'font-lock))
(defgroup generic-x nil
"A collection of generic modes."
:prefix "generic-"
@ -280,12 +278,11 @@ your changes into effect."
("^\\s-*\\(\\sw+\\)\\s-" 1 font-lock-variable-name-face))
'("srm\\.conf\\'" "httpd\\.conf\\'" "access\\.conf\\'")
(list
(function
(lambda ()
(setq imenu-generic-expression
'((nil "^\\([-A-Za-z0-9_]+\\)" 1)
("*Directories*" "^\\s-*<Directory\\s-*\\([^>]+\\)>" 1)
("*Locations*" "^\\s-*<Location\\s-*\\([^>]+\\)>" 1))))))
(lambda ()
(setq imenu-generic-expression
'((nil "^\\([-A-Za-z0-9_]+\\)" 1)
("*Directories*" "^\\s-*<Directory\\s-*\\([^>]+\\)>" 1)
("*Locations*" "^\\s-*<Location\\s-*\\([^>]+\\)>" 1)))))
"Generic mode for Apache or HTTPD configuration files."))
(when (memq 'apache-log-generic-mode generic-extras-enable-list)
@ -401,11 +398,10 @@ your changes into effect."
(2 font-lock-variable-name-face)))
'("\\.[iI][nN][iI]\\'")
(list
(function
(lambda ()
(setq imenu-generic-expression
'((nil "^\\[\\(.*\\)\\]" 1)
("*Variables*" "^\\s-*\\([^=]+\\)\\s-*=" 1))))))
(lambda ()
(setq imenu-generic-expression
'((nil "^\\[\\(.*\\)\\]" 1)
("*Variables*" "^\\s-*\\([^=]+\\)\\s-*=" 1)))))
"Generic mode for MS-Windows INI files.
You can use `ini-generic-mode-find-file-hook' to enter this mode
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'."
("^\\([^\n\r]*\\)\\s-*=" 1 font-lock-variable-name-face))
'("\\.[rR][eE][gG]\\'")
(list
(function
(lambda ()
(setq imenu-generic-expression
'((nil "^\\s-*\\(.*\\)\\s-*=" 1))))))
(lambda ()
(setq imenu-generic-expression
'((nil "^\\s-*\\(.*\\)\\s-*=" 1)))))
"Generic mode for MS-Windows Registry files."))
(declare-function w32-shell-name "w32-fns" ())
@ -456,10 +451,9 @@ like an INI file. You can add this hook to `find-file-hook'."
("\\s-/\\([^/]+\\)/[i, \t\n]" 1 font-lock-constant-face))
'("\\.rules\\'")
(list
(function
(lambda ()
(setq imenu-generic-expression
'((nil "\\s-/\\([^/]+\\)/[i, \t\n]" 1))))))
(lambda ()
(setq imenu-generic-expression
'((nil "\\s-/\\([^/]+\\)/[i, \t\n]" 1)))))
"Generic mode for Mailagent rules files."))
;; Solaris/Sys V prototype files
@ -548,13 +542,12 @@ like an INI file. You can add this hook to `find-file-hook'."
(2 font-lock-variable-name-face)))
'("\\.wrl\\'")
(list
(function
(lambda ()
(setq imenu-generic-expression
'((nil "^\\([A-Za-z0-9_]+\\)\\s-*{" 1)
("*Definitions*"
"DEF\\s-+\\([-A-Za-z0-9_]+\\)\\s-+\\([A-Za-z0-9]+\\)\\s-*{"
1))))))
(lambda ()
(setq imenu-generic-expression
'((nil "^\\([A-Za-z0-9_]+\\)\\s-*{" 1)
("*Definitions*"
"DEF\\s-+\\([-A-Za-z0-9_]+\\)\\s-+\\([A-Za-z0-9]+\\)\\s-*{"
1)))))
"Generic Mode for VRML files."))
;; Java Manifests
@ -594,20 +587,18 @@ like an INI file. You can add this hook to `find-file-hook'."
;; * an equal sign
;; * a colon
(mapcar
(function
(lambda (elt)
(list
(concat "^" java-properties-key elt java-properties-value "$")
'(1 font-lock-constant-face)
'(4 font-lock-variable-name-face))))
(lambda (elt)
(list
(concat "^" java-properties-key elt java-properties-value "$")
'(1 font-lock-constant-face)
'(4 font-lock-variable-name-face)))
;; These are the separators
'(":\\s-*" "\\s-+" "\\s-*=\\s-*"))))
nil
(list
(function
(lambda ()
(setq imenu-generic-expression
'((nil "^\\([^#! \t\n\r=:]+\\)" 1))))))
(lambda ()
(setq imenu-generic-expression
'((nil "^\\([^#! \t\n\r=:]+\\)" 1)))))
"Generic mode for Java properties files."))
;; C shell alias definitions
@ -622,10 +613,9 @@ like an INI file. You can add this hook to `find-file-hook'."
(1 font-lock-variable-name-face)))
'("alias\\'")
(list
(function
(lambda ()
(setq imenu-generic-expression
'((nil "^\\(alias\\|unalias\\)\\s-+\\([-a-zA-Z0-9_]+\\)" 2))))))
(lambda ()
(setq imenu-generic-expression
'((nil "^\\(alias\\|unalias\\)\\s-+\\([-a-zA-Z0-9_]+\\)" 2)))))
"Generic mode for C Shell alias files."))
;; Ansible inventory files
@ -645,11 +635,10 @@ like an INI file. You can add this hook to `find-file-hook'."
(2 font-lock-keyword-face)))
'("inventory\\'")
(list
(function
(lambda ()
(setq imenu-generic-expression
'((nil "^\\s-*\\[\\(.*\\)\\]" 1)
("*Variables*" "\\s-+\\([^ =\n\r]+\\)=" 1))))))
(lambda ()
(setq imenu-generic-expression
'((nil "^\\s-*\\[\\(.*\\)\\]" 1)
("*Variables*" "\\s-+\\([^ =\n\r]+\\)=" 1)))))
"Generic mode for Ansible inventory files."))
;;; Windows RC files
@ -1432,10 +1421,9 @@ like an INI file. You can add this hook to `find-file-hook'."
'(("^\\([-A-Za-z0-9_]+\\)" 1 font-lock-type-face))
'("/etc/inetd\\.conf\\'")
(list
(function
(lambda ()
(setq imenu-generic-expression
'((nil "^\\([-A-Za-z0-9_]+\\)" 1))))))))
(lambda ()
(setq imenu-generic-expression
'((nil "^\\([-A-Za-z0-9_]+\\)" 1)))))))
;; Services
(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'."
(2 font-lock-variable-name-face)))
'("/etc/services\\'")
(list
(function
(lambda ()
(setq imenu-generic-expression
'((nil "^\\([-A-Za-z0-9_]+\\)" 1))))))))
(lambda ()
(setq imenu-generic-expression
'((nil "^\\([-A-Za-z0-9_]+\\)" 1)))))))
;; Password and Group files
(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'."
;; /etc/passwd- is a backup file for /etc/passwd, so is group- and shadow-
'("/etc/passwd-?\\'" "/etc/group-?\\'" "/etc/shadow-?\\'")
(list
(function
(lambda ()
(setq imenu-generic-expression
'((nil "^\\([-A-Za-z0-9_]+\\):" 1))))))))
(lambda ()
(setq imenu-generic-expression
'((nil "^\\([-A-Za-z0-9_]+\\):" 1)))))))
;; Fstab
(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'."
(2 font-lock-variable-name-face t)))
'("/etc/[v]*fstab\\'")
(list
(function
(lambda ()
(setq imenu-generic-expression
'((nil "^\\([^# \t]+\\)\\s-+" 1))))))))
(lambda ()
(setq imenu-generic-expression
'((nil "^\\([^# \t]+\\)\\s-+" 1)))))))
;; /etc/sudoers
(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'."
(list
'generic-bracket-support
;; Make keywords case-insensitive
(function
(lambda()
(setq font-lock-defaults '(generic-font-lock-keywords nil t)))))
(lambda ()
(setq font-lock-defaults '(generic-font-lock-keywords nil t))))
"Generic mode for SPICE circuit netlist files."))
(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'."
(list
'generic-bracket-support
;; Make keywords case-insensitive
(function
(lambda()
(setq font-lock-defaults '(generic-font-lock-keywords nil t)))))
(lambda ()
(setq font-lock-defaults '(generic-font-lock-keywords nil t))))
"Generic mode for ASTAP circuit netlist files."))
(when (memq 'etc-modules-conf-generic-mode generic-extras-enable-list)

31
lisp/gnus/gnus-agent.el
View file

@ -3567,22 +3567,21 @@ articles in every agentized group? "))
(let* (delete-recursive
files f
(delete-recursive
(function
(lambda (f-or-d)
(ignore-errors
(if (file-directory-p f-or-d)
(condition-case nil
(delete-directory f-or-d)
(file-error
(setq files (directory-files f-or-d))
(while files
(setq f (pop files))
(or (member f '("." ".."))
(funcall delete-recursive
(nnheader-concat
f-or-d f))))
(delete-directory f-or-d)))
(delete-file f-or-d)))))))
(lambda (f-or-d)
(ignore-errors
(if (file-directory-p f-or-d)
(condition-case nil
(delete-directory f-or-d)
(file-error
(setq files (directory-files f-or-d))
(while files
(setq f (pop files))
(or (member f '("." ".."))
(funcall delete-recursive
(nnheader-concat
f-or-d f))))
(delete-directory f-or-d)))
(delete-file f-or-d))))))
(funcall delete-recursive dir)))))))))
;;;###autoload

2
lisp/gnus/gnus-art.el
View file

@ -6175,7 +6175,6 @@ If nil, don't show those extra buttons."
face ,gnus-article-button-face
follow-link t
gnus-part ,id
button t
article-type multipart
rear-nonsticky t))
;; Do the handles
@ -6200,6 +6199,7 @@ If nil, don't show those extra buttons."
follow-link t
gnus-part ,id
button t
category t
gnus-data ,handle
rear-nonsticky t))
(insert " "))

9
lisp/gnus/gnus-search.el
View file

@ -2101,9 +2101,10 @@ article came from is also searched."
(defun gnus-search--complete-key-data ()
"Potentially return completion data for a search key or value."
(let* ((key-start (save-excursion
(if (re-search-backward " " (minibuffer-prompt-end) t)
(1+ (point))
(minibuffer-prompt-end))))
(or (re-search-backward " " (minibuffer-prompt-end) t)
(goto-char (minibuffer-prompt-end)))
(skip-chars-forward " -")
(point)))
(after-colon (save-excursion
(when (re-search-backward ":" key-start t)
(1+ (point)))))
@ -2113,7 +2114,7 @@ article came from is also searched."
;; only handle in a contact-completion context.
(when (and gnus-search-contact-tables
(save-excursion
(re-search-backward "\\<\\(\\w+\\):" key-start t)
(re-search-backward "\\<-?\\(\\w+\\):" key-start t)
(member (match-string 1)
'("from" "to" "cc"
"bcc" "recipient" "address"))))

2
lisp/gnus/message.el
View file

@ -7651,7 +7651,7 @@ Optional DIGEST will use digest to forward."
;; Consider there is no illegible text.
(add-text-properties
b (point)
'(no-illegible-text t rear-nonsticky t start-open t))))
'(no-illegible-text t rear-nonsticky t))))
(defun message-forward-make-body-mml (forward-buffer)
(insert "\n\n<#mml type=message/rfc822 disposition=inline>\n")

84
lisp/gnus/nnmairix.el
View file

@ -1548,9 +1548,8 @@ See %s for details" proc nnmairix-mairix-output-buffer)))
(defun nnmairix-create-message-line-for-search ()
"Create message line for interactive query in minibuffer."
(mapconcat
(function
(lambda (cur)
(format "%c=%s" (car cur) (nth 3 cur))))
(lambda (cur)
(format "%c=%s" (car cur) (nth 3 cur)))
nnmairix-interactive-query-parameters ","))
(defun nnmairix-replace-illegal-chars (header)
@ -1811,13 +1810,12 @@ If VERSION is a string: must be contained in mairix version output."
(gnus-summary-toggle-header 1)
(set-buffer gnus-article-buffer)
(mapcar
(function
(lambda (field)
(list (car (cddr field))
(if (car field)
(nnmairix-replace-illegal-chars
(gnus-fetch-field (car field)))
nil))))
(lambda (field)
(list (car (cddr field))
(if (car field)
(nnmairix-replace-illegal-chars
(gnus-fetch-field (car field)))
nil)))
nnmairix-widget-fields-list))))
@ -1911,14 +1909,13 @@ If WITHVALUES is t, query is based on current article."
(when (member 'flags nnmairix-widget-other)
(setq flag
(mapconcat
(function
(lambda (flag)
(setq temp
(widget-value (cadr (assoc (car flag) nnmairix-widgets))))
(if (string= "yes" temp)
(cadr flag)
(if (string= "no" temp)
(concat "-" (cadr flag))))))
(lambda (flag)
(setq temp
(widget-value (cadr (assoc (car flag) nnmairix-widgets))))
(if (string= "yes" temp)
(cadr flag)
(if (string= "no" temp)
(concat "-" (cadr flag)))))
'(("seen" "s") ("replied" "r") ("flagged" "f")) ""))
(when (not (zerop (length flag)))
(push (concat "F:" flag) query)))
@ -1968,32 +1965,31 @@ VALUES may contain values for editable fields from current article."
;; how can this be done less ugly?
(let ((ret))
(mapc
(function
(lambda (field)
(setq field (car (cddr field)))
(setq ret
(nconc
(list
(list
(concat "c" field)
(widget-create 'checkbox
:tag field
:notify (lambda (widget &rest ignore)
(nnmairix-widget-toggle-activate widget))
nil)))
(list
(list
(concat "e" field)
(widget-create 'editable-field
:size 60
:format (concat " " field ":"
(make-string (- 11 (length field)) ?\ )
"%v")
:value (or (cadr (assoc field values)) ""))))
ret))
(widget-insert "\n")
;; Deactivate editable field
(widget-apply (cadr (nth 1 ret)) :deactivate)))
(lambda (field)
(setq field (car (cddr field)))
(setq ret
(nconc
(list
(list
(concat "c" field)
(widget-create 'checkbox
:tag field
:notify (lambda (widget &rest ignore)
(nnmairix-widget-toggle-activate widget))
nil)))
(list
(list
(concat "e" field)
(widget-create 'editable-field
:size 60
:format (concat " " field ":"
(make-string (- 11 (length field)) ?\ )
"%v")
:value (or (cadr (assoc field values)) ""))))
ret))
(widget-insert "\n")
;; Deactivate editable field
(widget-apply (cadr (nth 1 ret)) :deactivate))
nnmairix-widget-fields-list)
ret))

1
lisp/help.el
View file

@ -1310,6 +1310,7 @@ TRANSL, PARTIAL, SHADOW, NOMENU, MENTION-SHADOW are as in
((and mention-shadow (not (eq tem definition)))
(setq this-shadowed t))
(t nil))))
(eq definition (lookup-key tail (vector event) t))
(push (list event definition this-shadowed) vect))))
((eq (car tail) 'keymap)
;; The same keymap might be in the structure twice, if

19
lisp/ibuf-ext.el
View file

@ -208,11 +208,9 @@ either clicking or hitting return "
'follow-link t
'help-echo "Click or RET: save new value in customize"
'action (lambda (_)
(if (not (fboundp 'customize-save-variable))
(message "Customize not available; value not saved")
(customize-save-variable 'ibuffer-saved-filters
ibuffer-saved-filters)
(message "Saved updated ibuffer-saved-filters."))))
(customize-save-variable 'ibuffer-saved-filters
ibuffer-saved-filters)
(message "Saved updated ibuffer-saved-filters.")))
". See below for
an explanation and alternative ways to save the repaired value.
@ -1116,13 +1114,10 @@ filter into parts."
(defun ibuffer-maybe-save-stuff ()
(when ibuffer-save-with-custom
(if (fboundp 'customize-save-variable)
(progn
(customize-save-variable 'ibuffer-saved-filters
ibuffer-saved-filters)
(customize-save-variable 'ibuffer-saved-filter-groups
ibuffer-saved-filter-groups))
(message "Not saved permanently: Customize not available"))))
(customize-save-variable 'ibuffer-saved-filters
ibuffer-saved-filters)
(customize-save-variable 'ibuffer-saved-filter-groups
ibuffer-saved-filter-groups)))
;;;###autoload
(defun ibuffer-save-filters (name filters)

99
lisp/international/mule-cmds.el
View file

@ -441,56 +441,55 @@ non-nil, it is used to sort CODINGS instead."
(most-preferred (car from-priority))
(lang-preferred (get-language-info current-language-environment
'coding-system))
(func (function
(lambda (x)
(let ((base (coding-system-base x)))
;; We calculate the priority number 0..255 by
;; using the 8 bits PMMLCEII as this:
;; P: 1 if most preferred.
;; MM: greater than 0 if mime-charset.
;; L: 1 if one of the current lang. env.'s codings.
;; C: 1 if one of codings listed in the category list.
;; E: 1 if not XXX-with-esc
;; II: if iso-2022 based, 0..3, else 1.
(logior
(ash (if (eq base most-preferred) 1 0) 7)
(ash
(let ((mime (coding-system-get base :mime-charset)))
;; Prefer coding systems corresponding to a
;; MIME charset.
(if mime
;; Lower utf-16 priority so that we
;; normally prefer utf-8 to it, and put
;; x-ctext below that.
(cond ((string-match-p "utf-16"
(symbol-name mime))
2)
((string-match-p "^x-" (symbol-name mime))
1)
(t 3))
0))
5)
(ash (if (memq base lang-preferred) 1 0) 4)
(ash (if (memq base from-priority) 1 0) 3)
(ash (if (string-match-p "-with-esc\\'"
(symbol-name base))
0 1) 2)
(if (eq (coding-system-type base) 'iso-2022)
(let ((category (coding-system-category base)))
;; For ISO based coding systems, prefer
;; one that doesn't use designation nor
;; locking/single shifting.
(cond
((or (eq category 'coding-category-iso-8-1)
(eq category 'coding-category-iso-8-2))
2)
((or (eq category 'coding-category-iso-7-tight)
(eq category 'coding-category-iso-7))
1)
(t
0)))
1)
))))))
(func (lambda (x)
(let ((base (coding-system-base x)))
;; We calculate the priority number 0..255 by
;; using the 8 bits PMMLCEII as this:
;; P: 1 if most preferred.
;; MM: greater than 0 if mime-charset.
;; L: 1 if one of the current lang. env.'s codings.
;; C: 1 if one of codings listed in the category list.
;; E: 1 if not XXX-with-esc
;; II: if iso-2022 based, 0..3, else 1.
(logior
(ash (if (eq base most-preferred) 1 0) 7)
(ash
(let ((mime (coding-system-get base :mime-charset)))
;; Prefer coding systems corresponding to a
;; MIME charset.
(if mime
;; Lower utf-16 priority so that we
;; normally prefer utf-8 to it, and put
;; x-ctext below that.
(cond ((string-match-p "utf-16"
(symbol-name mime))
2)
((string-match-p "^x-" (symbol-name mime))
1)
(t 3))
0))
5)
(ash (if (memq base lang-preferred) 1 0) 4)
(ash (if (memq base from-priority) 1 0) 3)
(ash (if (string-match-p "-with-esc\\'"
(symbol-name base))
0 1) 2)
(if (eq (coding-system-type base) 'iso-2022)
(let ((category (coding-system-category base)))
;; For ISO based coding systems, prefer
;; one that doesn't use designation nor
;; locking/single shifting.
(cond
((or (eq category 'coding-category-iso-8-1)
(eq category 'coding-category-iso-8-2))
2)
((or (eq category 'coding-category-iso-7-tight)
(eq category 'coding-category-iso-7))
1)
(t
0)))
1)
)))))
(sort codings (lambda (x y)
(> (funcall func x) (funcall func y)))))))

13
lisp/international/mule-diag.el
View file

@ -136,13 +136,12 @@ SORT-KEY should be `name' or `iso-spec' (default `name')."
((eq sort-key 'iso-spec)
;; Sort by DIMENSION CHARS FINAL-CHAR
(function
(lambda (x y)
(or (< (nth 1 x) (nth 1 y))
(and (= (nth 1 x) (nth 1 y))
(or (< (nth 2 x) (nth 2 y))
(and (= (nth 2 x) (nth 2 y))
(< (nth 3 x) (nth 3 y)))))))))
(lambda (x y)
(or (< (nth 1 x) (nth 1 y))
(and (= (nth 1 x) (nth 1 y))
(or (< (nth 2 x) (nth 2 y))
(and (= (nth 2 x) (nth 2 y))
(< (nth 3 x) (nth 3 y))))))))
(t
(error "Invalid charset sort key: %s" sort-key))))

18
lisp/international/quail.el
View file

@ -1330,7 +1330,8 @@ If STR has `advice' text property, append the following special event:
(defun quail-input-method (key)
(if (or (and (or buffer-read-only
(get-char-property (point) 'read-only))
(and (get-char-property (point) 'read-only)
(get-char-property (point) 'front-sticky)))
(not (or inhibit-read-only
(get-char-property (point) 'inhibit-read-only))))
(and overriding-terminal-local-map
@ -2477,14 +2478,13 @@ should be made by `quail-build-decode-map' (which see)."
'face 'font-lock-comment-face))
(quail-indent-to max-key-width)
(if (vectorp (cdr elt))
(mapc (function
(lambda (x)
(let ((width (if (integerp x) (char-width x)
(string-width x))))
(when (> (+ (current-column) 1 width) window-width)
(insert "\n")
(quail-indent-to max-key-width))
(insert " " x))))
(mapc (lambda (x)
(let ((width (if (integerp x) (char-width x)
(string-width x))))
(when (> (+ (current-column) 1 width) window-width)
(insert "\n")
(quail-indent-to max-key-width))
(insert " " x)))
(cdr elt))
(insert " " (cdr elt)))
(insert ?\n))

16
lisp/jsonrpc.el
View file

@ -4,7 +4,7 @@
;; Author: João Távora <joaotavora@gmail.com>
;; Keywords: processes, languages, extensions
;; Version: 1.0.12
;; Version: 1.0.14
;; Package-Requires: ((emacs "25.2"))
;; 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
the request is successful, otherwise it exits non-locally with an
error of type `jsonrpc-error'.
DEFERRED is passed to `jsonrpc-async-request', which see.
DEFERRED and TIMEOUT as in `jsonrpc-async-request', which see.
If CANCEL-ON-INPUT is non-nil and the user inputs something while
the function is waiting, then it exits immediately, returning
@ -284,7 +284,8 @@ ignored."
(catch tag
(setq
id-and-timer
(jsonrpc--async-request-1
(apply
#'jsonrpc--async-request-1
connection method params
:success-fn (lambda (result)
(unless cancelled
@ -300,11 +301,12 @@ ignored."
(lambda ()
(unless cancelled
(throw tag '(error (jsonrpc-error-message . "Timed out")))))
:deferred deferred
:timeout timeout))
`(,@(when deferred `(:deferred ,deferred))
,@(when timeout `(:timeout ,timeout)))))
(cond (cancel-on-input
(while (sit-for 30))
(setq cancelled t)
(unwind-protect
(let ((inhibit-quit t)) (while (sit-for 30)))
(setq cancelled t))
`(cancelled ,cancel-on-input-retval))
(t (while t (accept-process-output nil 30)))))
;; In normal operation, cancellation is handled by the

Some files were not shown because too many files have changed in this diff Show more