diff options
| author | Stefan Monnier | 2018-11-20 16:09:35 -0500 |
|---|---|---|
| committer | Stefan Monnier | 2018-11-20 16:09:35 -0500 |
| commit | 11c9343fe63fdc8bfef3246d95f42523d73fb733 (patch) | |
| tree | 5f129a2598a0555e8a0fc06ca49e57cdf8f8e841 | |
| parent | 336681f35bf23f442a7159eb86d1c5d8a6269c7f (diff) | |
| download | emacs-11c9343fe63fdc8bfef3246d95f42523d73fb733.tar.gz emacs-11c9343fe63fdc8bfef3246d95f42523d73fb733.zip | |
calc.el, calc-(ext|poly), calccomp: Use lexical-binding
* lisp/calc/calc-ext.el: Use lexical-binding, silence warnings.
(calc-init-extensions): Remove a few functions which can't be called
directly since they depend on dynamically scoped vars.
(calc-embedded-quiet): Declare.
(math-defcache): Use 'declare'.
(math-normalize-a): Remove declaration.
(math-normalize-nonstandard): Receive 'a' as arg instead.
(math-defintegral): Use 'declare'.
(math-exp-pos, math-exp-old-pos, math-exp-keep-spaces, math-rb-h2)
(math-read-big-baseline, math-read-big-h2, math-read-big-err-msg)
(math-exp-token, math-expr-data, math-exp-str): Declare.
(math-map-tree, math-read-expr): Avoid dynvars as formal arguments.
* lisp/calc/calc-poly.el: Use lexical-binding, silence warnings.
Turn some comments into docstrings.
(math-poly-div): Avoid dynvars as formal arguments.
(math-poly-base-top-expr): Move declaration before first use.
(calcFunc-factors, math-factor-expr, math-factor-expr-try)
(calcFunc-factor): Avoid dynvars as formal arguments.
* lisp/calc/calc.el: Use lexical-binding, silence warnings.
(math-normalize-a): Remove.
(math-normalize): Use lexical var 'a' instead.
(math-svo-c): Remove.
(math-stack-value-offset): Pass 'c' explicitly as arg to
math-stack-value-offset-fancy instead.
* lisp/calc/calccomp.el: Use lexical-binding, silence warnings.
(math-svo-c): Remove.
(math-stack-value-offset-fancy): Use new arg 'c' instead.
(math-comp-to-string-flat): Avoid dynvars as formal arguments.
| -rw-r--r-- | lisp/calc/calc-ext.el | 85 | ||||
| -rw-r--r-- | lisp/calc/calc-poly.el | 117 | ||||
| -rw-r--r-- | lisp/calc/calc.el | 156 | ||||
| -rw-r--r-- | lisp/calc/calccomp.el | 51 |
4 files changed, 211 insertions, 198 deletions
diff --git a/lisp/calc/calc-ext.el b/lisp/calc/calc-ext.el index 821a7094349..761eb97a816 100644 --- a/lisp/calc/calc-ext.el +++ b/lisp/calc/calc-ext.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; calc-ext.el --- various extension functions for Calc | 1 | ;;; calc-ext.el --- various extension functions for Calc -*- lexical-binding:t -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1990-1993, 2001-2018 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 1990-1993, 2001-2018 Free Software Foundation, Inc. |
| 4 | 4 | ||
| @@ -88,7 +88,7 @@ | |||
| 88 | (defvar calc-alg-map) | 88 | (defvar calc-alg-map) |
| 89 | (defvar calc-alg-esc-map) | 89 | (defvar calc-alg-esc-map) |
| 90 | 90 | ||
| 91 | ;;; The following was made a function so that it could be byte-compiled. | 91 | ;; The following was made a function so that it could be byte-compiled. |
| 92 | (defun calc-init-extensions () | 92 | (defun calc-init-extensions () |
| 93 | 93 | ||
| 94 | (define-key calc-mode-map ":" 'calc-fdiv) | 94 | (define-key calc-mode-map ":" 'calc-fdiv) |
| @@ -894,8 +894,8 @@ calcFunc-pcont calcFunc-pdeg calcFunc-pdiv calcFunc-pdivide | |||
| 894 | calcFunc-pdivrem calcFunc-pgcd calcFunc-plead calcFunc-pprim | 894 | calcFunc-pdivrem calcFunc-pgcd calcFunc-plead calcFunc-pprim |
| 895 | calcFunc-prem math-accum-factors math-atomic-factorp | 895 | calcFunc-prem math-accum-factors math-atomic-factorp |
| 896 | math-div-poly-const math-div-thru math-expand-power math-expand-term | 896 | math-div-poly-const math-div-thru math-expand-power math-expand-term |
| 897 | math-factor-contains math-factor-expr math-factor-expr-part | 897 | math-factor-contains math-factor-expr |
| 898 | math-factor-expr-try math-factor-finish math-factor-poly-coefs | 898 | math-factor-finish |
| 899 | math-factor-protect math-mul-thru math-padded-polynomial | 899 | math-factor-protect math-mul-thru math-padded-polynomial |
| 900 | math-partial-fractions math-poly-degree math-poly-deriv-coefs | 900 | math-partial-fractions math-poly-degree math-poly-deriv-coefs |
| 901 | math-poly-gcd-frac-list math-poly-modulus-rec math-ratpoly-p | 901 | math-poly-gcd-frac-list math-poly-modulus-rec math-ratpoly-p |
| @@ -984,8 +984,8 @@ calc-force-refresh calc-locate-cursor-element calc-show-edit-buffer) | |||
| 984 | )) | 984 | )) |
| 985 | 985 | ||
| 986 | (mapcar (function (lambda (x) | 986 | (mapcar (function (lambda (x) |
| 987 | (mapcar (function (lambda (cmd) | 987 | (mapcar (function (lambda (cmd) (autoload cmd (car x) nil t))) |
| 988 | (autoload cmd (car x) nil t))) (cdr x)))) | 988 | (cdr x)))) |
| 989 | '( | 989 | '( |
| 990 | 990 | ||
| 991 | ("calc-alg" calc-alg-evaluate calc-apart calc-collect calc-expand | 991 | ("calc-alg" calc-alg-evaluate calc-apart calc-collect calc-expand |
| @@ -1307,8 +1307,9 @@ calc-kill calc-kill-region calc-yank)))) | |||
| 1307 | (message "%s" (if msg | 1307 | (message "%s" (if msg |
| 1308 | (concat group ": " msg ":" | 1308 | (concat group ": " msg ":" |
| 1309 | (make-string | 1309 | (make-string |
| 1310 | (- (apply 'max (mapcar 'length msgs)) | 1310 | (- (apply #'max (mapcar #'length msgs)) |
| 1311 | (length msg)) 32) | 1311 | (length msg)) |
| 1312 | ?\s) | ||
| 1312 | " [MORE]" | 1313 | " [MORE]" |
| 1313 | (if key | 1314 | (if key |
| 1314 | (concat " " (char-to-string key) | 1315 | (concat " " (char-to-string key) |
| @@ -1334,6 +1335,8 @@ calc-kill calc-kill-region calc-yank)))) | |||
| 1334 | 1335 | ||
| 1335 | ;;; General. | 1336 | ;;; General. |
| 1336 | 1337 | ||
| 1338 | (defvar calc-embedded-quiet) | ||
| 1339 | |||
| 1337 | (defun calc-reset (arg) | 1340 | (defun calc-reset (arg) |
| 1338 | (interactive "P") | 1341 | (interactive "P") |
| 1339 | (setq arg (if arg (prefix-numeric-value arg) nil)) | 1342 | (setq arg (if arg (prefix-numeric-value arg) nil)) |
| @@ -1398,7 +1401,7 @@ calc-kill calc-kill-region calc-yank)))) | |||
| 1398 | 1401 | ||
| 1399 | (defun calc-scroll-up (n) | 1402 | (defun calc-scroll-up (n) |
| 1400 | (interactive "P") | 1403 | (interactive "P") |
| 1401 | (condition-case err | 1404 | (condition-case nil |
| 1402 | (scroll-up (or n (/ (window-height) 2))) | 1405 | (scroll-up (or n (/ (window-height) 2))) |
| 1403 | (error nil)) | 1406 | (error nil)) |
| 1404 | (if (pos-visible-in-window-p (max 1 (- (point-max) 2))) | 1407 | (if (pos-visible-in-window-p (max 1 (- (point-max) 2))) |
| @@ -1657,7 +1660,7 @@ calc-kill calc-kill-region calc-yank)))) | |||
| 1657 | (let ((entries (calc-top-list n 1 'entry)) | 1660 | (let ((entries (calc-top-list n 1 'entry)) |
| 1658 | (calc-undo-list nil) (calc-redo-list nil)) | 1661 | (calc-undo-list nil) (calc-redo-list nil)) |
| 1659 | (calc-pop-stack n 1 t) | 1662 | (calc-pop-stack n 1 t) |
| 1660 | (calc-push-list (mapcar 'car entries) | 1663 | (calc-push-list (mapcar #'car entries) |
| 1661 | 1 | 1664 | 1 |
| 1662 | (mapcar (function (lambda (x) (nth 2 x))) | 1665 | (mapcar (function (lambda (x) (nth 2 x))) |
| 1663 | entries))))))) | 1666 | entries))))))) |
| @@ -1707,7 +1710,7 @@ calc-kill calc-kill-region calc-yank)))) | |||
| 1707 | (calc-pop-push-record-list 1 "eval" | 1710 | (calc-pop-push-record-list 1 "eval" |
| 1708 | (math-evaluate-expr (calc-top (- n))) | 1711 | (math-evaluate-expr (calc-top (- n))) |
| 1709 | (- n)) | 1712 | (- n)) |
| 1710 | (calc-pop-push-record-list n "eval" (mapcar 'math-evaluate-expr | 1713 | (calc-pop-push-record-list n "eval" (mapcar #'math-evaluate-expr |
| 1711 | (calc-top-list n))))) | 1714 | (calc-top-list n))))) |
| 1712 | (calc-handle-whys))) | 1715 | (calc-handle-whys))) |
| 1713 | 1716 | ||
| @@ -1928,7 +1931,7 @@ calc-kill calc-kill-region calc-yank)))) | |||
| 1928 | (calc-z-prefix-buf "") | 1931 | (calc-z-prefix-buf "") |
| 1929 | (kmap (sort (copy-sequence (calc-user-key-map)) | 1932 | (kmap (sort (copy-sequence (calc-user-key-map)) |
| 1930 | (function (lambda (x y) (< (car x) (car y)))))) | 1933 | (function (lambda (x y) (< (car x) (car y)))))) |
| 1931 | (flags (apply 'logior | 1934 | (flags (apply #'logior |
| 1932 | (mapcar (function | 1935 | (mapcar (function |
| 1933 | (lambda (k) | 1936 | (lambda (k) |
| 1934 | (calc-user-function-classify (car k)))) | 1937 | (calc-user-function-classify (car k)))) |
| @@ -2003,12 +2006,13 @@ calc-kill calc-kill-region calc-yank)))) | |||
| 2003 | ;;;; Caches. | 2006 | ;;;; Caches. |
| 2004 | 2007 | ||
| 2005 | (defmacro math-defcache (name init form) | 2008 | (defmacro math-defcache (name init form) |
| 2009 | (declare (indent 2) (debug (symbolp sexp form))) | ||
| 2006 | (let ((cache-prec (intern (concat (symbol-name name) "-cache-prec"))) | 2010 | (let ((cache-prec (intern (concat (symbol-name name) "-cache-prec"))) |
| 2007 | (cache-val (intern (concat (symbol-name name) "-cache"))) | 2011 | (cache-val (intern (concat (symbol-name name) "-cache"))) |
| 2008 | (last-prec (intern (concat (symbol-name name) "-last-prec"))) | 2012 | (last-prec (intern (concat (symbol-name name) "-last-prec"))) |
| 2009 | (last-val (intern (concat (symbol-name name) "-last")))) | 2013 | (last-val (intern (concat (symbol-name name) "-last")))) |
| 2010 | `(progn | 2014 | `(progn |
| 2011 | ; (defvar ,cache-prec ,(if init (math-numdigs (nth 1 init)) -100)) | 2015 | ;; (defvar ,cache-prec ,(if init (math-numdigs (nth 1 init)) -100)) |
| 2012 | (defvar ,cache-prec (cond | 2016 | (defvar ,cache-prec (cond |
| 2013 | ((consp ,init) (math-numdigs (nth 1 ,init))) | 2017 | ((consp ,init) (math-numdigs (nth 1 ,init))) |
| 2014 | (,init | 2018 | (,init |
| @@ -2037,7 +2041,6 @@ calc-kill calc-kill-region calc-yank)))) | |||
| 2037 | ,cache-val)) | 2041 | ,cache-val)) |
| 2038 | ,last-prec calc-internal-prec)) | 2042 | ,last-prec calc-internal-prec)) |
| 2039 | ,last-val)))) | 2043 | ,last-val)))) |
| 2040 | (put 'math-defcache 'lisp-indent-hook 2) | ||
| 2041 | 2044 | ||
| 2042 | ;;; Betcha didn't know that pi = 16 atan(1/5) - 4 atan(1/239). [F] [Public] | 2045 | ;;; Betcha didn't know that pi = 16 atan(1/5) - 4 atan(1/239). [F] [Public] |
| 2043 | (defconst math-approx-pi | 2046 | (defconst math-approx-pi |
| @@ -2400,7 +2403,7 @@ If X is not an error form, return 1." | |||
| 2400 | (list 'calcFunc-intv mask lo hi) | 2403 | (list 'calcFunc-intv mask lo hi) |
| 2401 | (math-make-intv mask lo hi)))) | 2404 | (math-make-intv mask lo hi)))) |
| 2402 | ((eq (car a) 'vec) | 2405 | ((eq (car a) 'vec) |
| 2403 | (cons 'vec (mapcar 'math-normalize (cdr a)))) | 2406 | (cons 'vec (mapcar #'math-normalize (cdr a)))) |
| 2404 | ((eq (car a) 'quote) | 2407 | ((eq (car a) 'quote) |
| 2405 | (math-normalize (nth 1 a))) | 2408 | (math-normalize (nth 1 a))) |
| 2406 | ((eq (car a) 'special-const) | 2409 | ((eq (car a) 'special-const) |
| @@ -2412,7 +2415,7 @@ If X is not an error form, return 1." | |||
| 2412 | (math-normalize-logical-op a)) | 2415 | (math-normalize-logical-op a)) |
| 2413 | ((memq (car a) '(calcFunc-lambda calcFunc-quote calcFunc-condition)) | 2416 | ((memq (car a) '(calcFunc-lambda calcFunc-quote calcFunc-condition)) |
| 2414 | (let ((calc-simplify-mode 'none)) | 2417 | (let ((calc-simplify-mode 'none)) |
| 2415 | (cons (car a) (mapcar 'math-normalize (cdr a))))) | 2418 | (cons (car a) (mapcar #'math-normalize (cdr a))))) |
| 2416 | ((eq (car a) 'calcFunc-evalto) | 2419 | ((eq (car a) 'calcFunc-evalto) |
| 2417 | (setq a (or (nth 1 a) 0)) | 2420 | (setq a (or (nth 1 a) 0)) |
| 2418 | (or calc-refreshing-evaltos | 2421 | (or calc-refreshing-evaltos |
| @@ -2435,27 +2438,25 @@ If X is not an error form, return 1." | |||
| 2435 | ;; The variable math-normalize-a is local to math-normalize in calc.el, | 2438 | ;; The variable math-normalize-a is local to math-normalize in calc.el, |
| 2436 | ;; but is used by math-normalize-nonstandard, which is called by | 2439 | ;; but is used by math-normalize-nonstandard, which is called by |
| 2437 | ;; math-normalize. | 2440 | ;; math-normalize. |
| 2438 | (defvar math-normalize-a) | 2441 | (defun math-normalize-nonstandard (a) |
| 2439 | |||
| 2440 | (defun math-normalize-nonstandard () | ||
| 2441 | (if (consp calc-simplify-mode) | 2442 | (if (consp calc-simplify-mode) |
| 2442 | (progn | 2443 | (progn |
| 2443 | (setq calc-simplify-mode 'none | 2444 | (setq calc-simplify-mode 'none |
| 2444 | math-simplify-only (car-safe (cdr-safe math-normalize-a))) | 2445 | math-simplify-only (car-safe (cdr-safe a))) |
| 2445 | nil) | 2446 | nil) |
| 2446 | (and (symbolp (car math-normalize-a)) | 2447 | (and (symbolp (car a)) |
| 2447 | (or (eq calc-simplify-mode 'none) | 2448 | (or (eq calc-simplify-mode 'none) |
| 2448 | (and (eq calc-simplify-mode 'num) | 2449 | (and (eq calc-simplify-mode 'num) |
| 2449 | (let ((aptr (setq math-normalize-a | 2450 | (let ((aptr (setq a |
| 2450 | (cons | 2451 | (cons |
| 2451 | (car math-normalize-a) | 2452 | (car a) |
| 2452 | (mapcar 'math-normalize | 2453 | (mapcar #'math-normalize |
| 2453 | (cdr math-normalize-a)))))) | 2454 | (cdr a)))))) |
| 2454 | (while (and aptr (math-constp (car aptr))) | 2455 | (while (and aptr (math-constp (car aptr))) |
| 2455 | (setq aptr (cdr aptr))) | 2456 | (setq aptr (cdr aptr))) |
| 2456 | aptr))) | 2457 | aptr))) |
| 2457 | (cons (car math-normalize-a) | 2458 | (cons (car a) |
| 2458 | (mapcar 'math-normalize (cdr math-normalize-a)))))) | 2459 | (mapcar #'math-normalize (cdr a)))))) |
| 2459 | 2460 | ||
| 2460 | 2461 | ||
| 2461 | ;;; Normalize a bignum digit list by trimming high-end zeros. [L l] | 2462 | ;;; Normalize a bignum digit list by trimming high-end zeros. [L l] |
| @@ -2808,7 +2809,7 @@ If X is not an error form, return 1." | |||
| 2808 | x) | 2809 | x) |
| 2809 | (if (Math-primp x) | 2810 | (if (Math-primp x) |
| 2810 | x | 2811 | x |
| 2811 | (cons (car x) (mapcar 'math-evaluate-expr-rec (cdr x)))))) | 2812 | (cons (car x) (mapcar #'math-evaluate-expr-rec (cdr x)))))) |
| 2812 | x)) | 2813 | x)) |
| 2813 | 2814 | ||
| 2814 | (defun math-any-floats (expr) | 2815 | (defun math-any-floats (expr) |
| @@ -2822,9 +2823,10 @@ If X is not an error form, return 1." | |||
| 2822 | (defvar math-mt-many nil) | 2823 | (defvar math-mt-many nil) |
| 2823 | (defvar math-mt-func nil) | 2824 | (defvar math-mt-func nil) |
| 2824 | 2825 | ||
| 2825 | (defun math-map-tree (math-mt-func mmt-expr &optional math-mt-many) | 2826 | (defun math-map-tree (func mmt-expr &optional many) |
| 2826 | (or math-mt-many (setq math-mt-many 1000000)) | 2827 | (let ((math-mt-func func) |
| 2827 | (math-map-tree-rec mmt-expr)) | 2828 | (math-mt-many (or many 1000000))) |
| 2829 | (math-map-tree-rec mmt-expr))) | ||
| 2828 | 2830 | ||
| 2829 | (defun math-map-tree-rec (mmt-expr) | 2831 | (defun math-map-tree-rec (mmt-expr) |
| 2830 | (or (= math-mt-many 0) | 2832 | (or (= math-mt-many 0) |
| @@ -2842,7 +2844,7 @@ If X is not an error form, return 1." | |||
| 2842 | (<= math-mt-many 0)) | 2844 | (<= math-mt-many 0)) |
| 2843 | (setq mmt-done t) | 2845 | (setq mmt-done t) |
| 2844 | (setq mmt-nextval (cons (car mmt-expr) | 2846 | (setq mmt-nextval (cons (car mmt-expr) |
| 2845 | (mapcar 'math-map-tree-rec | 2847 | (mapcar #'math-map-tree-rec |
| 2846 | (cdr mmt-expr)))) | 2848 | (cdr mmt-expr)))) |
| 2847 | (if (equal mmt-nextval mmt-expr) | 2849 | (if (equal mmt-nextval mmt-expr) |
| 2848 | (setq mmt-done t) | 2850 | (setq mmt-done t) |
| @@ -2867,6 +2869,7 @@ If X is not an error form, return 1." | |||
| 2867 | (defvar math-integral-cache) | 2869 | (defvar math-integral-cache) |
| 2868 | 2870 | ||
| 2869 | (defmacro math-defintegral (funcs &rest code) | 2871 | (defmacro math-defintegral (funcs &rest code) |
| 2872 | (declare (indent 1) (debug (sexp body))) | ||
| 2870 | (setq math-integral-cache nil) | 2873 | (setq math-integral-cache nil) |
| 2871 | (cons 'progn | 2874 | (cons 'progn |
| 2872 | (mapcar #'(lambda (func) | 2875 | (mapcar #'(lambda (func) |
| @@ -2876,9 +2879,9 @@ If X is not an error form, return 1." | |||
| 2876 | (list | 2879 | (list |
| 2877 | #'(lambda (u) ,@code))))) | 2880 | #'(lambda (u) ,@code))))) |
| 2878 | (if (symbolp funcs) (list funcs) funcs)))) | 2881 | (if (symbolp funcs) (list funcs) funcs)))) |
| 2879 | (put 'math-defintegral 'lisp-indent-hook 1) | ||
| 2880 | 2882 | ||
| 2881 | (defmacro math-defintegral-2 (funcs &rest code) | 2883 | (defmacro math-defintegral-2 (funcs &rest code) |
| 2884 | (declare (indent 1) (debug (sexp body))) | ||
| 2882 | (setq math-integral-cache nil) | 2885 | (setq math-integral-cache nil) |
| 2883 | (cons 'progn | 2886 | (cons 'progn |
| 2884 | (mapcar #'(lambda (func) | 2887 | (mapcar #'(lambda (func) |
| @@ -2887,7 +2890,6 @@ If X is not an error form, return 1." | |||
| 2887 | (get ',func 'math-integral-2) | 2890 | (get ',func 'math-integral-2) |
| 2888 | (list #'(lambda (u v) ,@code))))) | 2891 | (list #'(lambda (u v) ,@code))))) |
| 2889 | (if (symbolp funcs) (list funcs) funcs)))) | 2892 | (if (symbolp funcs) (list funcs) funcs)))) |
| 2890 | (put 'math-defintegral-2 'lisp-indent-hook 1) | ||
| 2891 | 2893 | ||
| 2892 | (defvar var-IntegAfterRules 'calc-IntegAfterRules) | 2894 | (defvar var-IntegAfterRules 'calc-IntegAfterRules) |
| 2893 | 2895 | ||
| @@ -3097,9 +3099,16 @@ If X is not an error form, return 1." | |||
| 3097 | ;;; Expression parsing. | 3099 | ;;; Expression parsing. |
| 3098 | 3100 | ||
| 3099 | (defvar math-expr-data) | 3101 | (defvar math-expr-data) |
| 3102 | (defvar math-exp-pos) | ||
| 3103 | (defvar math-exp-old-pos) | ||
| 3104 | (defvar math-exp-keep-spaces) | ||
| 3105 | (defvar math-exp-token) | ||
| 3106 | (defvar math-expr-data) | ||
| 3107 | (defvar math-exp-str) | ||
| 3100 | 3108 | ||
| 3101 | (defun math-read-expr (math-exp-str) | 3109 | (defun math-read-expr (str) |
| 3102 | (let ((math-exp-pos 0) | 3110 | (let ((math-exp-pos 0) |
| 3111 | (math-exp-str str) | ||
| 3103 | (math-exp-old-pos 0) | 3112 | (math-exp-old-pos 0) |
| 3104 | (math-exp-keep-spaces nil) | 3113 | (math-exp-keep-spaces nil) |
| 3105 | math-exp-token math-expr-data) | 3114 | math-exp-token math-expr-data) |
| @@ -3138,6 +3147,10 @@ If X is not an error form, return 1." | |||
| 3138 | 3147 | ||
| 3139 | ;;; They said it couldn't be done... | 3148 | ;;; They said it couldn't be done... |
| 3140 | 3149 | ||
| 3150 | (defvar math-read-big-baseline) | ||
| 3151 | (defvar math-read-big-h2) | ||
| 3152 | (defvar math-read-big-err-msg) | ||
| 3153 | |||
| 3141 | (defun math-read-big-expr (str) | 3154 | (defun math-read-big-expr (str) |
| 3142 | (and (> (length calc-left-label) 0) | 3155 | (and (> (length calc-left-label) 0) |
| 3143 | (string-match (concat "^" (regexp-quote calc-left-label)) str) | 3156 | (string-match (concat "^" (regexp-quote calc-left-label)) str) |
| @@ -3179,6 +3192,8 @@ If X is not an error form, return 1." | |||
| 3179 | '(error 0 "Syntax error")) | 3192 | '(error 0 "Syntax error")) |
| 3180 | (math-read-expr str))))) | 3193 | (math-read-expr str))))) |
| 3181 | 3194 | ||
| 3195 | (defvar math-rb-h2) | ||
| 3196 | |||
| 3182 | (defun math-read-big-bigp (math-read-big-lines) | 3197 | (defun math-read-big-bigp (math-read-big-lines) |
| 3183 | (and (cdr math-read-big-lines) | 3198 | (and (cdr math-read-big-lines) |
| 3184 | (let ((matrix nil) | 3199 | (let ((matrix nil) |
diff --git a/lisp/calc/calc-poly.el b/lisp/calc/calc-poly.el index 4092aeec529..41083b77480 100644 --- a/lisp/calc/calc-poly.el +++ b/lisp/calc/calc-poly.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; calc-poly.el --- polynomial functions for Calc | 1 | ;;; calc-poly.el --- polynomial functions for Calc -*- lexical-binding:t -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1990-1993, 2001-2018 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 1990-1993, 2001-2018 Free Software Foundation, Inc. |
| 4 | 4 | ||
| @@ -177,8 +177,8 @@ | |||
| 177 | (math-add (car res) (math-div (cdr res) pd)))) | 177 | (math-add (car res) (math-div (cdr res) pd)))) |
| 178 | 178 | ||
| 179 | 179 | ||
| 180 | ;;; Multiply two terms, expanding out products of sums. | ||
| 181 | (defun math-mul-thru (lhs rhs) | 180 | (defun math-mul-thru (lhs rhs) |
| 181 | "Multiply two terms, expanding out products of sums." | ||
| 182 | (if (memq (car-safe lhs) '(+ -)) | 182 | (if (memq (car-safe lhs) '(+ -)) |
| 183 | (list (car lhs) | 183 | (list (car lhs) |
| 184 | (math-mul-thru (nth 1 lhs) rhs) | 184 | (math-mul-thru (nth 1 lhs) rhs) |
| @@ -197,8 +197,8 @@ | |||
| 197 | (math-div num den))) | 197 | (math-div num den))) |
| 198 | 198 | ||
| 199 | 199 | ||
| 200 | ;;; Sort the terms of a sum into canonical order. | ||
| 201 | (defun math-sort-terms (expr) | 200 | (defun math-sort-terms (expr) |
| 201 | "Sort the terms of a sum into canonical order." | ||
| 202 | (if (memq (car-safe expr) '(+ -)) | 202 | (if (memq (car-safe expr) '(+ -)) |
| 203 | (math-list-to-sum | 203 | (math-list-to-sum |
| 204 | (sort (math-sum-to-list expr) | 204 | (sort (math-sum-to-list expr) |
| @@ -223,8 +223,8 @@ | |||
| 223 | (math-sum-to-list (nth 2 tree) (not neg)))) | 223 | (math-sum-to-list (nth 2 tree) (not neg)))) |
| 224 | (t (list (cons tree neg))))) | 224 | (t (list (cons tree neg))))) |
| 225 | 225 | ||
| 226 | ;;; Check if the polynomial coefficients are modulo forms. | ||
| 227 | (defun math-poly-modulus (expr &optional expr2) | 226 | (defun math-poly-modulus (expr &optional expr2) |
| 227 | "Check if the polynomial coefficients are modulo forms." | ||
| 228 | (or (math-poly-modulus-rec expr) | 228 | (or (math-poly-modulus-rec expr) |
| 229 | (and expr2 (math-poly-modulus-rec expr2)) | 229 | (and expr2 (math-poly-modulus-rec expr2)) |
| 230 | 1)) | 230 | 1)) |
| @@ -237,12 +237,13 @@ | |||
| 237 | (math-poly-modulus-rec (nth 2 expr)))))) | 237 | (math-poly-modulus-rec (nth 2 expr)))))) |
| 238 | 238 | ||
| 239 | 239 | ||
| 240 | ;;; Divide two polynomials. Return (quotient . remainder). | ||
| 241 | (defvar math-poly-div-base nil) | 240 | (defvar math-poly-div-base nil) |
| 242 | (defun math-poly-div (u v &optional math-poly-div-base) | 241 | (defun math-poly-div (u v &optional div-base) |
| 243 | (if math-poly-div-base | 242 | "Divide two polynomials. Return (quotient . remainder)." |
| 244 | (math-do-poly-div u v) | 243 | (let ((math-poly-div-base div-base)) |
| 245 | (math-do-poly-div (calcFunc-expand u) (calcFunc-expand v)))) | 244 | (if div-base |
| 245 | (math-do-poly-div u v) | ||
| 246 | (math-do-poly-div (calcFunc-expand u) (calcFunc-expand v))))) | ||
| 246 | 247 | ||
| 247 | (defun math-poly-div-exact (u v &optional base) | 248 | (defun math-poly-div-exact (u v &optional base) |
| 248 | (let ((res (math-poly-div u v base))) | 249 | (let ((res (math-poly-div u v base))) |
| @@ -308,8 +309,8 @@ | |||
| 308 | (math-div (math-build-polynomial-expr (cdr res) base) | 309 | (math-div (math-build-polynomial-expr (cdr res) base) |
| 309 | v))))))) | 310 | v))))))) |
| 310 | 311 | ||
| 311 | ;;; Divide two polynomials in coefficient-list form. Return (quot . rem). | ||
| 312 | (defun math-poly-div-coefs (u v) | 312 | (defun math-poly-div-coefs (u v) |
| 313 | "Divide two polynomials in coefficient-list form. Return (quot . rem)." | ||
| 313 | (cond ((null v) (math-reject-arg nil "Division by zero")) | 314 | (cond ((null v) (math-reject-arg nil "Division by zero")) |
| 314 | ((< (length u) (length v)) (cons nil u)) | 315 | ((< (length u) (length v)) (cons nil u)) |
| 315 | ((cdr u) | 316 | ((cdr u) |
| @@ -334,9 +335,9 @@ | |||
| 334 | (cons (list (math-poly-div-rec (car u) (car v))) | 335 | (cons (list (math-poly-div-rec (car u) (car v))) |
| 335 | nil)))) | 336 | nil)))) |
| 336 | 337 | ||
| 337 | ;;; Perform a pseudo-division of polynomials. (See Knuth section 4.6.1.) | ||
| 338 | ;;; This returns only the remainder from the pseudo-division. | ||
| 339 | (defun math-poly-pseudo-div (u v) | 338 | (defun math-poly-pseudo-div (u v) |
| 339 | "Perform a pseudo-division of polynomials. (See Knuth section 4.6.1.) | ||
| 340 | This returns only the remainder from the pseudo-division." | ||
| 340 | (cond ((null v) nil) | 341 | (cond ((null v) nil) |
| 341 | ((< (length u) (length v)) u) | 342 | ((< (length u) (length v)) u) |
| 342 | ((or (cdr u) (cdr v)) | 343 | ((or (cdr u) (cdr v)) |
| @@ -359,8 +360,8 @@ | |||
| 359 | (nreverse (mapcar 'math-simplify urev)))) | 360 | (nreverse (mapcar 'math-simplify urev)))) |
| 360 | (t nil))) | 361 | (t nil))) |
| 361 | 362 | ||
| 362 | ;;; Compute the GCD of two multivariate polynomials. | ||
| 363 | (defun math-poly-gcd (u v) | 363 | (defun math-poly-gcd (u v) |
| 364 | "Compute the GCD of two multivariate polynomials." | ||
| 364 | (cond ((Math-equal u v) u) | 365 | (cond ((Math-equal u v) u) |
| 365 | ((math-constp u) | 366 | ((math-constp u) |
| 366 | (if (Math-zerop u) | 367 | (if (Math-zerop u) |
| @@ -423,7 +424,7 @@ | |||
| 423 | (defun math-poly-gcd-coefs (u v) | 424 | (defun math-poly-gcd-coefs (u v) |
| 424 | (let ((d (math-poly-gcd (math-poly-gcd-list u) | 425 | (let ((d (math-poly-gcd (math-poly-gcd-list u) |
| 425 | (math-poly-gcd-list v))) | 426 | (math-poly-gcd-list v))) |
| 426 | (g 1) (h 1) (z 0) hh r delta ghd) | 427 | (g 1) (h 1) (z 0) r delta) |
| 427 | (while (and u v (Math-zerop (car u)) (Math-zerop (car v))) | 428 | (while (and u v (Math-zerop (car u)) (Math-zerop (car v))) |
| 428 | (setq u (cdr u) v (cdr v) z (1+ z))) | 429 | (setq u (cdr u) v (cdr v) z (1+ z))) |
| 429 | (or (eq d 1) | 430 | (or (eq d 1) |
| @@ -452,8 +453,8 @@ | |||
| 452 | v)) | 453 | v)) |
| 453 | 454 | ||
| 454 | 455 | ||
| 455 | ;;; Return true if is a factor containing no sums or quotients. | ||
| 456 | (defun math-atomic-factorp (expr) | 456 | (defun math-atomic-factorp (expr) |
| 457 | "Return true if is a factor containing no sums or quotients." | ||
| 457 | (cond ((eq (car-safe expr) '*) | 458 | (cond ((eq (car-safe expr) '*) |
| 458 | (and (math-atomic-factorp (nth 1 expr)) | 459 | (and (math-atomic-factorp (nth 1 expr)) |
| 459 | (math-atomic-factorp (nth 2 expr)))) | 460 | (math-atomic-factorp (nth 2 expr)))) |
| @@ -463,14 +464,13 @@ | |||
| 463 | (math-atomic-factorp (nth 1 expr))) | 464 | (math-atomic-factorp (nth 1 expr))) |
| 464 | (t t))) | 465 | (t t))) |
| 465 | 466 | ||
| 466 | ;;; Find a suitable base for dividing a by b. | ||
| 467 | ;;; The base must exist in both expressions. | ||
| 468 | ;;; The degree in the numerator must be higher or equal than the | ||
| 469 | ;;; degree in the denominator. | ||
| 470 | ;;; If the above conditions are not met the quotient is just a remainder. | ||
| 471 | ;;; Return nil if this is the case. | ||
| 472 | |||
| 473 | (defun math-poly-div-base (a b) | 467 | (defun math-poly-div-base (a b) |
| 468 | "Find a suitable base for dividing a by b. | ||
| 469 | The base must exist in both expressions. | ||
| 470 | The degree in the numerator must be higher or equal than the | ||
| 471 | degree in the denominator. | ||
| 472 | If the above conditions are not met the quotient is just a remainder. | ||
| 473 | Return nil if this is the case." | ||
| 474 | (let (a-base b-base) | 474 | (let (a-base b-base) |
| 475 | (and (setq a-base (math-total-polynomial-base a)) | 475 | (and (setq a-base (math-total-polynomial-base a)) |
| 476 | (setq b-base (math-total-polynomial-base b)) | 476 | (setq b-base (math-total-polynomial-base b)) |
| @@ -482,12 +482,11 @@ | |||
| 482 | (throw 'return (car (car a-base)))))) | 482 | (throw 'return (car (car a-base)))))) |
| 483 | (setq a-base (cdr a-base))))))) | 483 | (setq a-base (cdr a-base))))))) |
| 484 | 484 | ||
| 485 | ;;; Same as above but for gcd algorithm. | ||
| 486 | ;;; Here there is no requirement that degree(a) > degree(b). | ||
| 487 | ;;; Take the base that has the highest degree considering both a and b. | ||
| 488 | ;;; ("a^20+b^21+x^3+a+b", "a+b^2+x^5+a^22+b^10") --> (a 22) | ||
| 489 | |||
| 490 | (defun math-poly-gcd-base (a b) | 485 | (defun math-poly-gcd-base (a b) |
| 486 | "Same as `math-poly-div-base' but for gcd algorithm. | ||
| 487 | Here there is no requirement that degree(a) > degree(b). | ||
| 488 | Take the base that has the highest degree considering both a and b. | ||
| 489 | (\"a^20+b^21+x^3+a+b\", \"a+b^2+x^5+a^22+b^10\") --> (a 22)" | ||
| 491 | (let (a-base b-base) | 490 | (let (a-base b-base) |
| 492 | (and (setq a-base (math-total-polynomial-base a)) | 491 | (and (setq a-base (math-total-polynomial-base a)) |
| 493 | (setq b-base (math-total-polynomial-base b)) | 492 | (setq b-base (math-total-polynomial-base b)) |
| @@ -501,8 +500,8 @@ | |||
| 501 | (throw 'return (car (car b-base))) | 500 | (throw 'return (car (car b-base))) |
| 502 | (setq b-base (cdr b-base))))))))) | 501 | (setq b-base (cdr b-base))))))))) |
| 503 | 502 | ||
| 504 | ;;; Sort a list of polynomial bases. | ||
| 505 | (defun math-sort-poly-base-list (lst) | 503 | (defun math-sort-poly-base-list (lst) |
| 504 | "Sort a list of polynomial bases." | ||
| 506 | (sort lst (function (lambda (a b) | 505 | (sort lst (function (lambda (a b) |
| 507 | (or (> (nth 1 a) (nth 1 b)) | 506 | (or (> (nth 1 a) (nth 1 b)) |
| 508 | (and (= (nth 1 a) (nth 1 b)) | 507 | (and (= (nth 1 a) (nth 1 b)) |
| @@ -511,10 +510,11 @@ | |||
| 511 | ;;; Given an expression find all variables that are polynomial bases. | 510 | ;;; Given an expression find all variables that are polynomial bases. |
| 512 | ;;; Return list in the form '( (var1 degree1) (var2 degree2) ... ). | 511 | ;;; Return list in the form '( (var1 degree1) (var2 degree2) ... ). |
| 513 | 512 | ||
| 514 | ;; The variable math-poly-base-total-base is local to | 513 | ;; The variable math-poly-base-total-base and math-poly-base-top-expr are local |
| 515 | ;; math-total-polynomial-base, but is used by math-polynomial-p1, | 514 | ;; to math-total-polynomial-base, but used by math-polynomial-p1, which is |
| 516 | ;; which is called by math-total-polynomial-base. | 515 | ;; called by math-total-polynomial-base. |
| 517 | (defvar math-poly-base-total-base) | 516 | (defvar math-poly-base-total-base) |
| 517 | (defvar math-poly-base-top-expr) | ||
| 518 | 518 | ||
| 519 | (defun math-total-polynomial-base (expr) | 519 | (defun math-total-polynomial-base (expr) |
| 520 | (let ((math-poly-base-total-base nil) | 520 | (let ((math-poly-base-total-base nil) |
| @@ -522,11 +522,6 @@ | |||
| 522 | (math-polynomial-base expr #'math-polynomial-p1) | 522 | (math-polynomial-base expr #'math-polynomial-p1) |
| 523 | (math-sort-poly-base-list math-poly-base-total-base))) | 523 | (math-sort-poly-base-list math-poly-base-total-base))) |
| 524 | 524 | ||
| 525 | ;; The variable math-poly-base-top-expr is local to math-polynomial-base | ||
| 526 | ;; in calc-alg.el, but is used by math-polynomial-p1 which is called | ||
| 527 | ;; by math-polynomial-base. | ||
| 528 | (defvar math-poly-base-top-expr) | ||
| 529 | |||
| 530 | (defun math-polynomial-p1 (subexpr) | 525 | (defun math-polynomial-p1 (subexpr) |
| 531 | (or (assoc subexpr math-poly-base-total-base) | 526 | (or (assoc subexpr math-poly-base-total-base) |
| 532 | (memq (car subexpr) '(+ - * / neg)) | 527 | (memq (car subexpr) '(+ - * / neg)) |
| @@ -555,28 +550,30 @@ | |||
| 555 | ;; called (indirectly) by calcFunc-factors and calcFunc-factor. | 550 | ;; called (indirectly) by calcFunc-factors and calcFunc-factor. |
| 556 | (defvar math-to-list) | 551 | (defvar math-to-list) |
| 557 | 552 | ||
| 558 | (defun calcFunc-factors (math-fact-expr &optional var) | 553 | (defun calcFunc-factors (expr &optional var) |
| 559 | (let ((math-factored-vars (if var t nil)) | 554 | (let ((math-factored-vars (if var t nil)) |
| 560 | (math-to-list t) | 555 | (math-to-list t) |
| 561 | (calc-prefer-frac t)) | 556 | (calc-prefer-frac t)) |
| 562 | (or var | 557 | (or var |
| 563 | (setq var (math-polynomial-base math-fact-expr))) | 558 | (setq var (math-polynomial-base expr))) |
| 564 | (let ((res (math-factor-finish | 559 | (let ((res (math-factor-finish |
| 565 | (or (catch 'factor (math-factor-expr-try var)) | 560 | (or (catch 'factor |
| 566 | math-fact-expr)))) | 561 | (let ((math-fact-expr expr)) (math-factor-expr-try var))) |
| 562 | expr)))) | ||
| 567 | (math-simplify (if (math-vectorp res) | 563 | (math-simplify (if (math-vectorp res) |
| 568 | res | 564 | res |
| 569 | (list 'vec (list 'vec res 1))))))) | 565 | (list 'vec (list 'vec res 1))))))) |
| 570 | 566 | ||
| 571 | (defun calcFunc-factor (math-fact-expr &optional var) | 567 | (defun calcFunc-factor (expr &optional var) |
| 572 | (let ((math-factored-vars nil) | 568 | (let ((math-factored-vars nil) |
| 573 | (math-to-list nil) | 569 | (math-to-list nil) |
| 574 | (calc-prefer-frac t)) | 570 | (calc-prefer-frac t)) |
| 575 | (math-simplify (math-factor-finish | 571 | (math-simplify (math-factor-finish |
| 576 | (if var | 572 | (if var |
| 577 | (let ((math-factored-vars t)) | 573 | (let ((math-factored-vars t) |
| 578 | (or (catch 'factor (math-factor-expr-try var)) math-fact-expr)) | 574 | (math-fact-expr expr)) |
| 579 | (math-factor-expr math-fact-expr)))))) | 575 | (or (catch 'factor (math-factor-expr-try var)) expr)) |
| 576 | (math-factor-expr expr)))))) | ||
| 580 | 577 | ||
| 581 | (defun math-factor-finish (x) | 578 | (defun math-factor-finish (x) |
| 582 | (if (Math-primp x) | 579 | (if (Math-primp x) |
| @@ -590,18 +587,19 @@ | |||
| 590 | (list 'calcFunc-Fac-Prot x) | 587 | (list 'calcFunc-Fac-Prot x) |
| 591 | x)) | 588 | x)) |
| 592 | 589 | ||
| 593 | (defun math-factor-expr (math-fact-expr) | 590 | (defun math-factor-expr (expr) |
| 594 | (cond ((eq math-factored-vars t) math-fact-expr) | 591 | (cond ((eq math-factored-vars t) expr) |
| 595 | ((or (memq (car-safe math-fact-expr) '(* / ^ neg)) | 592 | ((or (memq (car-safe expr) '(* / ^ neg)) |
| 596 | (assq (car-safe math-fact-expr) calc-tweak-eqn-table)) | 593 | (assq (car-safe expr) calc-tweak-eqn-table)) |
| 597 | (cons (car math-fact-expr) (mapcar 'math-factor-expr (cdr math-fact-expr)))) | 594 | (cons (car expr) (mapcar 'math-factor-expr (cdr expr)))) |
| 598 | ((memq (car-safe math-fact-expr) '(+ -)) | 595 | ((memq (car-safe expr) '(+ -)) |
| 599 | (let* ((math-factored-vars math-factored-vars) | 596 | (let* ((math-factored-vars math-factored-vars) |
| 600 | (y (catch 'factor (math-factor-expr-part math-fact-expr)))) | 597 | (y (catch 'factor (let ((math-fact-expr expr)) |
| 598 | (math-factor-expr-part expr))))) | ||
| 601 | (if y | 599 | (if y |
| 602 | (math-factor-expr y) | 600 | (math-factor-expr y) |
| 603 | math-fact-expr))) | 601 | expr))) |
| 604 | (t math-fact-expr))) | 602 | (t expr))) |
| 605 | 603 | ||
| 606 | (defun math-factor-expr-part (x) ; uses "expr" | 604 | (defun math-factor-expr-part (x) ; uses "expr" |
| 607 | (if (memq (car-safe x) '(+ - * / ^ neg)) | 605 | (if (memq (car-safe x) '(+ - * / ^ neg)) |
| @@ -617,20 +615,20 @@ | |||
| 617 | ;; used by math-factor-poly-coefs, which is called by math-factor-expr-try. | 615 | ;; used by math-factor-poly-coefs, which is called by math-factor-expr-try. |
| 618 | (defvar math-fet-x) | 616 | (defvar math-fet-x) |
| 619 | 617 | ||
| 620 | (defun math-factor-expr-try (math-fet-x) | 618 | (defun math-factor-expr-try (x) |
| 621 | (if (eq (car-safe math-fact-expr) '*) | 619 | (if (eq (car-safe math-fact-expr) '*) |
| 622 | (let ((res1 (catch 'factor (let ((math-fact-expr (nth 1 math-fact-expr))) | 620 | (let ((res1 (catch 'factor (let ((math-fact-expr (nth 1 math-fact-expr))) |
| 623 | (math-factor-expr-try math-fet-x)))) | 621 | (math-factor-expr-try x)))) |
| 624 | (res2 (catch 'factor (let ((math-fact-expr (nth 2 math-fact-expr))) | 622 | (res2 (catch 'factor (let ((math-fact-expr (nth 2 math-fact-expr))) |
| 625 | (math-factor-expr-try math-fet-x))))) | 623 | (math-factor-expr-try x))))) |
| 626 | (and (or res1 res2) | 624 | (and (or res1 res2) |
| 627 | (throw 'factor (math-accum-factors (or res1 (nth 1 math-fact-expr)) 1 | 625 | (throw 'factor (math-accum-factors (or res1 (nth 1 math-fact-expr)) 1 |
| 628 | (or res2 (nth 2 math-fact-expr)))))) | 626 | (or res2 (nth 2 math-fact-expr)))))) |
| 629 | (let* ((p (math-is-polynomial math-fact-expr math-fet-x 30 'gen)) | 627 | (let* ((p (math-is-polynomial math-fact-expr x 30 'gen)) |
| 630 | (math-poly-modulus (math-poly-modulus math-fact-expr)) | 628 | (math-poly-modulus (math-poly-modulus math-fact-expr)) |
| 631 | res) | 629 | res) |
| 632 | (and (cdr p) | 630 | (and (cdr p) |
| 633 | (setq res (math-factor-poly-coefs p)) | 631 | (setq res (let ((math-fet-x x)) (math-factor-poly-coefs p))) |
| 634 | (throw 'factor res))))) | 632 | (throw 'factor res))))) |
| 635 | 633 | ||
| 636 | (defun math-accum-factors (fac pow facs) | 634 | (defun math-accum-factors (fac pow facs) |
| @@ -736,7 +734,6 @@ | |||
| 736 | (let ((roots (car t1)) | 734 | (let ((roots (car t1)) |
| 737 | (csign (if (math-negp (nth (1- (length p)) p)) -1 1)) | 735 | (csign (if (math-negp (nth (1- (length p)) p)) -1 1)) |
| 738 | (expr 1) | 736 | (expr 1) |
| 739 | (unfac (nth 1 t1)) | ||
| 740 | (scale (nth 2 t1))) | 737 | (scale (nth 2 t1))) |
| 741 | (while roots | 738 | (while roots |
| 742 | (let ((coef0 (car (car roots))) | 739 | (let ((coef0 (car (car roots))) |
| @@ -1109,7 +1106,7 @@ If no partial fraction representation can be found, return nil." | |||
| 1109 | (t expr))) | 1106 | (t expr))) |
| 1110 | 1107 | ||
| 1111 | (defun calcFunc-expand (expr &optional many) | 1108 | (defun calcFunc-expand (expr &optional many) |
| 1112 | (math-normalize (math-map-tree 'math-expand-term expr many))) | 1109 | (math-normalize (math-map-tree #'math-expand-term expr many))) |
| 1113 | 1110 | ||
| 1114 | (defun math-expand-power (x n &optional var else-nil) | 1111 | (defun math-expand-power (x n &optional var else-nil) |
| 1115 | (or (and (natnump n) | 1112 | (or (and (natnump n) |
diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index c79db821eb6..f155b8283b7 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; calc.el --- the GNU Emacs calculator | 1 | ;;; calc.el --- the GNU Emacs calculator -*- lexical-binding:t -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1990-1993, 2001-2018 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 1990-1993, 2001-2018 Free Software Foundation, Inc. |
| 4 | 4 | ||
| @@ -178,7 +178,7 @@ | |||
| 178 | (declare-function math-read-radix-digit "calc-misc" (dig)) | 178 | (declare-function math-read-radix-digit "calc-misc" (dig)) |
| 179 | (declare-function calc-digit-dots "calc-incom" ()) | 179 | (declare-function calc-digit-dots "calc-incom" ()) |
| 180 | (declare-function math-normalize-fancy "calc-ext" (a)) | 180 | (declare-function math-normalize-fancy "calc-ext" (a)) |
| 181 | (declare-function math-normalize-nonstandard "calc-ext" ()) | 181 | (declare-function math-normalize-nonstandard "calc-ext" (a)) |
| 182 | (declare-function math-recompile-eval-rules "calc-alg" ()) | 182 | (declare-function math-recompile-eval-rules "calc-alg" ()) |
| 183 | (declare-function math-apply-rewrites "calc-rewr" (expr rules &optional heads math-apply-rw-ruleset)) | 183 | (declare-function math-apply-rewrites "calc-rewr" (expr rules &optional heads math-apply-rw-ruleset)) |
| 184 | (declare-function calc-record-why "calc-misc" (&rest stuff)) | 184 | (declare-function calc-record-why "calc-misc" (&rest stuff)) |
| @@ -203,7 +203,7 @@ | |||
| 203 | (declare-function math-compose-expr "calccomp" (a prec &optional div)) | 203 | (declare-function math-compose-expr "calccomp" (a prec &optional div)) |
| 204 | (declare-function math-comp-width "calccomp" (c)) | 204 | (declare-function math-comp-width "calccomp" (c)) |
| 205 | (declare-function math-composition-to-string "calccomp" (c &optional width)) | 205 | (declare-function math-composition-to-string "calccomp" (c &optional width)) |
| 206 | (declare-function math-stack-value-offset-fancy "calccomp" ()) | 206 | (declare-function math-stack-value-offset-fancy "calccomp" (c)) |
| 207 | (declare-function math-format-flat-expr-fancy "calc-ext" (a prec)) | 207 | (declare-function math-format-flat-expr-fancy "calc-ext" (a prec)) |
| 208 | (declare-function math-adjust-fraction "calc-ext" (a)) | 208 | (declare-function math-adjust-fraction "calc-ext" (a)) |
| 209 | (declare-function math-format-binary "calc-bin" (a)) | 209 | (declare-function math-format-binary "calc-bin" (a)) |
| @@ -1331,16 +1331,17 @@ Notations: 3.14e6 3.14 * 10^6 | |||
| 1331 | " | 1331 | " |
| 1332 | (interactive) | 1332 | (interactive) |
| 1333 | (mapc (function ;FIXME: Why (set-default v (symbol-value v)) ?!?!? | 1333 | (mapc (function ;FIXME: Why (set-default v (symbol-value v)) ?!?!? |
| 1334 | (lambda (v) (set-default v (symbol-value v)))) calc-local-var-list) | 1334 | (lambda (v) (set-default v (symbol-value v)))) |
| 1335 | calc-local-var-list) | ||
| 1335 | (kill-all-local-variables) | 1336 | (kill-all-local-variables) |
| 1336 | (use-local-map (if (eq calc-algebraic-mode 'total) | 1337 | (use-local-map (if (eq calc-algebraic-mode 'total) |
| 1337 | (progn (require 'calc-ext) calc-alg-map) calc-mode-map)) | 1338 | (progn (require 'calc-ext) calc-alg-map) calc-mode-map)) |
| 1338 | (mapc #'make-local-variable calc-local-var-list) | 1339 | (mapc #'make-local-variable calc-local-var-list) |
| 1339 | (make-local-variable 'overlay-arrow-position) | 1340 | (make-local-variable 'overlay-arrow-position) |
| 1340 | (make-local-variable 'overlay-arrow-string) | 1341 | (make-local-variable 'overlay-arrow-string) |
| 1341 | (add-hook 'change-major-mode-hook 'font-lock-defontify nil t) | 1342 | (add-hook 'change-major-mode-hook #'font-lock-defontify nil t) |
| 1342 | (add-hook 'kill-buffer-query-functions | 1343 | (add-hook 'kill-buffer-query-functions |
| 1343 | 'calc-kill-stack-buffer | 1344 | #'calc-kill-stack-buffer |
| 1344 | t t) | 1345 | t t) |
| 1345 | (setq truncate-lines t) | 1346 | (setq truncate-lines t) |
| 1346 | (setq buffer-read-only t) | 1347 | (setq buffer-read-only t) |
| @@ -1795,7 +1796,7 @@ See calc-keypad for details." | |||
| 1795 | (if calc-hyperbolic-flag "Hyp " "") | 1796 | (if calc-hyperbolic-flag "Hyp " "") |
| 1796 | (if calc-keep-args-flag "Keep " "") | 1797 | (if calc-keep-args-flag "Keep " "") |
| 1797 | (if (/= calc-stack-top 1) "Narrow " "") | 1798 | (if (/= calc-stack-top 1) "Narrow " "") |
| 1798 | (apply 'concat calc-other-modes))))) | 1799 | (apply #'concat calc-other-modes))))) |
| 1799 | (if (equal new-mode-string mode-line-buffer-identification) | 1800 | (if (equal new-mode-string mode-line-buffer-identification) |
| 1800 | nil | 1801 | nil |
| 1801 | (setq mode-line-buffer-identification new-mode-string) | 1802 | (setq mode-line-buffer-identification new-mode-string) |
| @@ -1869,7 +1870,7 @@ See calc-keypad for details." | |||
| 1869 | (if (and (consp vals) | 1870 | (if (and (consp vals) |
| 1870 | (or (integerp (car vals)) | 1871 | (or (integerp (car vals)) |
| 1871 | (consp (car vals)))) | 1872 | (consp (car vals)))) |
| 1872 | (setq vals (mapcar 'calc-normalize vals)) | 1873 | (setq vals (mapcar #'calc-normalize vals)) |
| 1873 | (setq vals (calc-normalize vals))) | 1874 | (setq vals (calc-normalize vals))) |
| 1874 | (or (and (consp vals) | 1875 | (or (and (consp vals) |
| 1875 | (or (integerp (car vals)) | 1876 | (or (integerp (car vals)) |
| @@ -1952,8 +1953,8 @@ See calc-keypad for details." | |||
| 1952 | (mapcar (lambda (x) (calc-get-stack-element x sel-mode)) top))))) | 1953 | (mapcar (lambda (x) (calc-get-stack-element x sel-mode)) top))))) |
| 1953 | 1954 | ||
| 1954 | (defun calc-top-list-n (&optional n m sel-mode) | 1955 | (defun calc-top-list-n (&optional n m sel-mode) |
| 1955 | (mapcar 'math-check-complete | 1956 | (mapcar #'math-check-complete |
| 1956 | (mapcar 'calc-normalize (calc-top-list n m sel-mode)))) | 1957 | (mapcar #'calc-normalize (calc-top-list n m sel-mode)))) |
| 1957 | 1958 | ||
| 1958 | 1959 | ||
| 1959 | (defun calc-renumber-stack () | 1960 | (defun calc-renumber-stack () |
| @@ -2207,7 +2208,7 @@ the United States." | |||
| 2207 | (setq calc-aborted-prefix name) | 2208 | (setq calc-aborted-prefix name) |
| 2208 | (if (null arg) | 2209 | (if (null arg) |
| 2209 | (calc-enter-result 2 name (cons (or func2 func) | 2210 | (calc-enter-result 2 name (cons (or func2 func) |
| 2210 | (mapcar 'math-check-complete | 2211 | (mapcar #'math-check-complete |
| 2211 | (calc-top-list 2)))) | 2212 | (calc-top-list 2)))) |
| 2212 | (require 'calc-ext) | 2213 | (require 'calc-ext) |
| 2213 | (calc-binary-op-fancy name func arg ident unary))) | 2214 | (calc-binary-op-fancy name func arg ident unary))) |
| @@ -2619,78 +2620,78 @@ largest Emacs integer.") | |||
| 2619 | (defvar math-eval-rules-cache-other) | 2620 | (defvar math-eval-rules-cache-other) |
| 2620 | ;;; Reduce an object to canonical (normalized) form. [O o; Z Z] [Public] | 2621 | ;;; Reduce an object to canonical (normalized) form. [O o; Z Z] [Public] |
| 2621 | 2622 | ||
| 2622 | (defvar math-normalize-a) | ||
| 2623 | (defvar math-normalize-error nil | 2623 | (defvar math-normalize-error nil |
| 2624 | "Non-nil if the last call the `math-normalize' returned an error.") | 2624 | "Non-nil if the last call the `math-normalize' returned an error.") |
| 2625 | 2625 | ||
| 2626 | (defun math-normalize (math-normalize-a) | 2626 | (defun math-normalize (a) |
| 2627 | (setq math-normalize-error nil) | 2627 | (setq math-normalize-error nil) |
| 2628 | (cond | 2628 | (cond |
| 2629 | ((not (consp math-normalize-a)) | 2629 | ((not (consp a)) |
| 2630 | (if (integerp math-normalize-a) | 2630 | (if (integerp a) |
| 2631 | (if (or (>= math-normalize-a math-small-integer-size) | 2631 | (if (or (>= a math-small-integer-size) |
| 2632 | (<= math-normalize-a (- math-small-integer-size))) | 2632 | (<= a (- math-small-integer-size))) |
| 2633 | (math-bignum math-normalize-a) | 2633 | (math-bignum a) |
| 2634 | math-normalize-a) | 2634 | a) |
| 2635 | math-normalize-a)) | 2635 | a)) |
| 2636 | ((eq (car math-normalize-a) 'bigpos) | 2636 | ((eq (car a) 'bigpos) |
| 2637 | (if (eq (nth (1- (length math-normalize-a)) math-normalize-a) 0) | 2637 | (if (eq (nth (1- (length a)) a) 0) |
| 2638 | (let* ((last (setq math-normalize-a | 2638 | (let* ((last (setq a |
| 2639 | (copy-sequence math-normalize-a))) (digs math-normalize-a)) | 2639 | (copy-sequence a))) |
| 2640 | (digs a)) | ||
| 2640 | (while (setq digs (cdr digs)) | 2641 | (while (setq digs (cdr digs)) |
| 2641 | (or (eq (car digs) 0) (setq last digs))) | 2642 | (or (eq (car digs) 0) (setq last digs))) |
| 2642 | (setcdr last nil))) | 2643 | (setcdr last nil))) |
| 2643 | (if (cdr (cdr (cdr math-normalize-a))) | 2644 | (if (cdr (cdr (cdr a))) |
| 2644 | math-normalize-a | 2645 | a |
| 2645 | (cond | 2646 | (cond |
| 2646 | ((cdr (cdr math-normalize-a)) (+ (nth 1 math-normalize-a) | 2647 | ((cdr (cdr a)) (+ (nth 1 a) |
| 2647 | (* (nth 2 math-normalize-a) | 2648 | (* (nth 2 a) |
| 2648 | math-bignum-digit-size))) | 2649 | math-bignum-digit-size))) |
| 2649 | ((cdr math-normalize-a) (nth 1 math-normalize-a)) | 2650 | ((cdr a) (nth 1 a)) |
| 2650 | (t 0)))) | 2651 | (t 0)))) |
| 2651 | ((eq (car math-normalize-a) 'bigneg) | 2652 | ((eq (car a) 'bigneg) |
| 2652 | (if (eq (nth (1- (length math-normalize-a)) math-normalize-a) 0) | 2653 | (if (eq (nth (1- (length a)) a) 0) |
| 2653 | (let* ((last (setq math-normalize-a (copy-sequence math-normalize-a))) | 2654 | (let* ((last (setq a (copy-sequence a))) |
| 2654 | (digs math-normalize-a)) | 2655 | (digs a)) |
| 2655 | (while (setq digs (cdr digs)) | 2656 | (while (setq digs (cdr digs)) |
| 2656 | (or (eq (car digs) 0) (setq last digs))) | 2657 | (or (eq (car digs) 0) (setq last digs))) |
| 2657 | (setcdr last nil))) | 2658 | (setcdr last nil))) |
| 2658 | (if (cdr (cdr (cdr math-normalize-a))) | 2659 | (if (cdr (cdr (cdr a))) |
| 2659 | math-normalize-a | 2660 | a |
| 2660 | (cond | 2661 | (cond |
| 2661 | ((cdr (cdr math-normalize-a)) (- (+ (nth 1 math-normalize-a) | 2662 | ((cdr (cdr a)) (- (+ (nth 1 a) |
| 2662 | (* (nth 2 math-normalize-a) | 2663 | (* (nth 2 a) |
| 2663 | math-bignum-digit-size)))) | 2664 | math-bignum-digit-size)))) |
| 2664 | ((cdr math-normalize-a) (- (nth 1 math-normalize-a))) | 2665 | ((cdr a) (- (nth 1 a))) |
| 2665 | (t 0)))) | 2666 | (t 0)))) |
| 2666 | ((eq (car math-normalize-a) 'float) | 2667 | ((eq (car a) 'float) |
| 2667 | (math-make-float (math-normalize (nth 1 math-normalize-a)) | 2668 | (math-make-float (math-normalize (nth 1 a)) |
| 2668 | (nth 2 math-normalize-a))) | 2669 | (nth 2 a))) |
| 2669 | ((or (memq (car math-normalize-a) | 2670 | ((or (memq (car a) |
| 2670 | '(frac cplx polar hms date mod sdev intv vec var quote | 2671 | '(frac cplx polar hms date mod sdev intv vec var quote |
| 2671 | special-const calcFunc-if calcFunc-lambda | 2672 | special-const calcFunc-if calcFunc-lambda |
| 2672 | calcFunc-quote calcFunc-condition | 2673 | calcFunc-quote calcFunc-condition |
| 2673 | calcFunc-evalto)) | 2674 | calcFunc-evalto)) |
| 2674 | (integerp (car math-normalize-a)) | 2675 | (integerp (car a)) |
| 2675 | (and (consp (car math-normalize-a)) | 2676 | (and (consp (car a)) |
| 2676 | (not (eq (car (car math-normalize-a)) 'lambda)))) | 2677 | (not (eq (car (car a)) 'lambda)))) |
| 2677 | (require 'calc-ext) | 2678 | (require 'calc-ext) |
| 2678 | (math-normalize-fancy math-normalize-a)) | 2679 | (math-normalize-fancy a)) |
| 2679 | (t | 2680 | (t |
| 2680 | (or (and calc-simplify-mode | 2681 | (or (and calc-simplify-mode |
| 2681 | (require 'calc-ext) | 2682 | (require 'calc-ext) |
| 2682 | (math-normalize-nonstandard)) | 2683 | (math-normalize-nonstandard a)) |
| 2683 | (let ((args (mapcar 'math-normalize (cdr math-normalize-a)))) | 2684 | (let ((args (mapcar #'math-normalize (cdr a)))) |
| 2684 | (or (condition-case err | 2685 | (or (condition-case err |
| 2685 | (let ((func | 2686 | (let ((func |
| 2686 | (assq (car math-normalize-a) '( ( + . math-add ) | 2687 | (assq (car a) '( ( + . math-add ) |
| 2687 | ( - . math-sub ) | 2688 | ( - . math-sub ) |
| 2688 | ( * . math-mul ) | 2689 | ( * . math-mul ) |
| 2689 | ( / . math-div ) | 2690 | ( / . math-div ) |
| 2690 | ( % . math-mod ) | 2691 | ( % . math-mod ) |
| 2691 | ( ^ . math-pow ) | 2692 | ( ^ . math-pow ) |
| 2692 | ( neg . math-neg ) | 2693 | ( neg . math-neg ) |
| 2693 | ( | . math-concat ) )))) | 2694 | ( | . math-concat ) )))) |
| 2694 | (or (and var-EvalRules | 2695 | (or (and var-EvalRules |
| 2695 | (progn | 2696 | (progn |
| 2696 | (or (eq var-EvalRules math-eval-rules-cache-tag) | 2697 | (or (eq var-EvalRules math-eval-rules-cache-tag) |
| @@ -2698,59 +2699,59 @@ largest Emacs integer.") | |||
| 2698 | (require 'calc-ext) | 2699 | (require 'calc-ext) |
| 2699 | (math-recompile-eval-rules))) | 2700 | (math-recompile-eval-rules))) |
| 2700 | (and (or math-eval-rules-cache-other | 2701 | (and (or math-eval-rules-cache-other |
| 2701 | (assq (car math-normalize-a) | 2702 | (assq (car a) |
| 2702 | math-eval-rules-cache)) | 2703 | math-eval-rules-cache)) |
| 2703 | (math-apply-rewrites | 2704 | (math-apply-rewrites |
| 2704 | (cons (car math-normalize-a) args) | 2705 | (cons (car a) args) |
| 2705 | (cdr math-eval-rules-cache) | 2706 | (cdr math-eval-rules-cache) |
| 2706 | nil math-eval-rules-cache)))) | 2707 | nil math-eval-rules-cache)))) |
| 2707 | (if func | 2708 | (if func |
| 2708 | (apply (cdr func) args) | 2709 | (apply (cdr func) args) |
| 2709 | (and (or (consp (car math-normalize-a)) | 2710 | (and (or (consp (car a)) |
| 2710 | (fboundp (car math-normalize-a)) | 2711 | (fboundp (car a)) |
| 2711 | (and (not (featurep 'calc-ext)) | 2712 | (and (not (featurep 'calc-ext)) |
| 2712 | (require 'calc-ext) | 2713 | (require 'calc-ext) |
| 2713 | (fboundp (car math-normalize-a)))) | 2714 | (fboundp (car a)))) |
| 2714 | (apply (car math-normalize-a) args))))) | 2715 | (apply (car a) args))))) |
| 2715 | (wrong-number-of-arguments | 2716 | (wrong-number-of-arguments |
| 2716 | (setq math-normalize-error t) | 2717 | (setq math-normalize-error t) |
| 2717 | (calc-record-why "*Wrong number of arguments" | 2718 | (calc-record-why "*Wrong number of arguments" |
| 2718 | (cons (car math-normalize-a) args)) | 2719 | (cons (car a) args)) |
| 2719 | nil) | 2720 | nil) |
| 2720 | (wrong-type-argument | 2721 | (wrong-type-argument |
| 2721 | (or calc-next-why | 2722 | (or calc-next-why |
| 2722 | (calc-record-why "Wrong type of argument" | 2723 | (calc-record-why "Wrong type of argument" |
| 2723 | (cons (car math-normalize-a) args))) | 2724 | (cons (car a) args))) |
| 2724 | nil) | 2725 | nil) |
| 2725 | (args-out-of-range | 2726 | (args-out-of-range |
| 2726 | (setq math-normalize-error t) | 2727 | (setq math-normalize-error t) |
| 2727 | (calc-record-why "*Argument out of range" | 2728 | (calc-record-why "*Argument out of range" |
| 2728 | (cons (car math-normalize-a) args)) | 2729 | (cons (car a) args)) |
| 2729 | nil) | 2730 | nil) |
| 2730 | (inexact-result | 2731 | (inexact-result |
| 2731 | (calc-record-why "No exact representation for result" | 2732 | (calc-record-why "No exact representation for result" |
| 2732 | (cons (car math-normalize-a) args)) | 2733 | (cons (car a) args)) |
| 2733 | nil) | 2734 | nil) |
| 2734 | (math-overflow | 2735 | (math-overflow |
| 2735 | (setq math-normalize-error t) | 2736 | (setq math-normalize-error t) |
| 2736 | (calc-record-why "*Floating-point overflow occurred" | 2737 | (calc-record-why "*Floating-point overflow occurred" |
| 2737 | (cons (car math-normalize-a) args)) | 2738 | (cons (car a) args)) |
| 2738 | nil) | 2739 | nil) |
| 2739 | (math-underflow | 2740 | (math-underflow |
| 2740 | (setq math-normalize-error t) | 2741 | (setq math-normalize-error t) |
| 2741 | (calc-record-why "*Floating-point underflow occurred" | 2742 | (calc-record-why "*Floating-point underflow occurred" |
| 2742 | (cons (car math-normalize-a) args)) | 2743 | (cons (car a) args)) |
| 2743 | nil) | 2744 | nil) |
| 2744 | (void-variable | 2745 | (void-variable |
| 2745 | (setq math-normalize-error t) | 2746 | (setq math-normalize-error t) |
| 2746 | (if (eq (nth 1 err) 'var-EvalRules) | 2747 | (if (eq (nth 1 err) 'var-EvalRules) |
| 2747 | (progn | 2748 | (progn |
| 2748 | (setq var-EvalRules nil) | 2749 | (setq var-EvalRules nil) |
| 2749 | (math-normalize (cons (car math-normalize-a) args))) | 2750 | (math-normalize (cons (car a) args))) |
| 2750 | (calc-record-why "*Variable is void" (nth 1 err))))) | 2751 | (calc-record-why "*Variable is void" (nth 1 err))))) |
| 2751 | (if (consp (car math-normalize-a)) | 2752 | (if (consp (car a)) |
| 2752 | (math-dimension-error) | 2753 | (math-dimension-error) |
| 2753 | (cons (car math-normalize-a) args)))))))) | 2754 | (cons (car a) args)))))))) |
| 2754 | 2755 | ||
| 2755 | 2756 | ||
| 2756 | 2757 | ||
| @@ -2834,7 +2835,7 @@ largest Emacs integer.") | |||
| 2834 | ((eq (car a) 'frac) (math-div (math-float (nth 1 a)) (nth 2 a))) | 2835 | ((eq (car a) 'frac) (math-div (math-float (nth 1 a)) (nth 2 a))) |
| 2835 | ((eq (car a) 'float) a) | 2836 | ((eq (car a) 'float) a) |
| 2836 | ((memq (car a) '(cplx polar vec hms date sdev mod)) | 2837 | ((memq (car a) '(cplx polar vec hms date sdev mod)) |
| 2837 | (cons (car a) (mapcar 'math-float (cdr a)))) | 2838 | (cons (car a) (mapcar #'math-float (cdr a)))) |
| 2838 | (t (math-float-fancy a)))) | 2839 | (t (math-float-fancy a)))) |
| 2839 | 2840 | ||
| 2840 | 2841 | ||
| @@ -2845,7 +2846,7 @@ largest Emacs integer.") | |||
| 2845 | ((memq (car a) '(frac float)) | 2846 | ((memq (car a) '(frac float)) |
| 2846 | (list (car a) (Math-integer-neg (nth 1 a)) (nth 2 a))) | 2847 | (list (car a) (Math-integer-neg (nth 1 a)) (nth 2 a))) |
| 2847 | ((memq (car a) '(cplx vec hms date calcFunc-idn)) | 2848 | ((memq (car a) '(cplx vec hms date calcFunc-idn)) |
| 2848 | (cons (car a) (mapcar 'math-neg (cdr a)))) | 2849 | (cons (car a) (mapcar #'math-neg (cdr a)))) |
| 2849 | (t (math-neg-fancy a)))) | 2850 | (t (math-neg-fancy a)))) |
| 2850 | 2851 | ||
| 2851 | 2852 | ||
| @@ -3425,22 +3426,21 @@ largest Emacs integer.") | |||
| 3425 | (setcar (cdr entry) (calc-count-lines s)) | 3426 | (setcar (cdr entry) (calc-count-lines s)) |
| 3426 | s)) | 3427 | s)) |
| 3427 | 3428 | ||
| 3428 | ;; The variables math-svo-c, math-svo-wid and math-svo-off are local | 3429 | ;; The variables math-svo-wid and math-svo-off are local |
| 3429 | ;; to math-stack-value-offset, but are used by math-stack-value-offset-fancy | 3430 | ;; to math-stack-value-offset, but are used by math-stack-value-offset-fancy |
| 3430 | ;; in calccomp.el. | 3431 | ;; in calccomp.el. |
| 3431 | 3432 | ||
| 3432 | (defvar math-svo-c) | ||
| 3433 | (defvar math-svo-wid) | 3433 | (defvar math-svo-wid) |
| 3434 | (defvar math-svo-off) | 3434 | (defvar math-svo-off) |
| 3435 | 3435 | ||
| 3436 | (defun math-stack-value-offset (math-svo-c) | 3436 | (defun math-stack-value-offset (c) |
| 3437 | (let* ((num (if calc-line-numbering 4 0)) | 3437 | (let* ((num (if calc-line-numbering 4 0)) |
| 3438 | (math-svo-wid (calc-window-width)) | 3438 | (math-svo-wid (calc-window-width)) |
| 3439 | math-svo-off) | 3439 | math-svo-off) |
| 3440 | (if calc-display-just | 3440 | (if calc-display-just |
| 3441 | (progn | 3441 | (progn |
| 3442 | (require 'calc-ext) | 3442 | (require 'calc-ext) |
| 3443 | (math-stack-value-offset-fancy)) | 3443 | (math-stack-value-offset-fancy c)) |
| 3444 | (setq math-svo-off (or calc-display-origin 0)) | 3444 | (setq math-svo-off (or calc-display-origin 0)) |
| 3445 | (when (integerp calc-line-breaking) | 3445 | (when (integerp calc-line-breaking) |
| 3446 | (setq math-svo-wid calc-line-breaking))) | 3446 | (setq math-svo-wid calc-line-breaking))) |
| @@ -3873,7 +3873,7 @@ The prefix `calcFunc-' is added to the specified name to get the | |||
| 3873 | actual Lisp function name. | 3873 | actual Lisp function name. |
| 3874 | 3874 | ||
| 3875 | See Info node `(calc)Defining Functions'." | 3875 | See Info node `(calc)Defining Functions'." |
| 3876 | (declare (doc-string 3)) | 3876 | (declare (doc-string 3)) ;; FIXME: Edebug spec? |
| 3877 | (require 'calc-ext) | 3877 | (require 'calc-ext) |
| 3878 | (math-do-defmath func args body)) | 3878 | (math-do-defmath func args body)) |
| 3879 | 3879 | ||
diff --git a/lisp/calc/calccomp.el b/lisp/calc/calccomp.el index 858343aae93..75c7adc59ec 100644 --- a/lisp/calc/calccomp.el +++ b/lisp/calc/calccomp.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; calccomp.el --- composition functions for Calc | 1 | ;;; calccomp.el --- composition functions for Calc -*- lexical-binding:t -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1990-1993, 2001-2018 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 1990-1993, 2001-2018 Free Software Foundation, Inc. |
| 4 | 4 | ||
| @@ -121,7 +121,8 @@ | |||
| 121 | calc-lang-slash-idiv) | 121 | calc-lang-slash-idiv) |
| 122 | (math-float (nth 1 aa)) | 122 | (math-float (nth 1 aa)) |
| 123 | (nth 1 aa)) | 123 | (nth 1 aa)) |
| 124 | (nth 2 aa)) prec)) | 124 | (nth 2 aa)) |
| 125 | prec)) | ||
| 125 | (if (and (eq calc-language 'big) | 126 | (if (and (eq calc-language 'big) |
| 126 | (= (length (car calc-frac-format)) 1)) | 127 | (= (length (car calc-frac-format)) 1)) |
| 127 | (let* ((aa (math-adjust-fraction a)) | 128 | (let* ((aa (math-adjust-fraction a)) |
| @@ -202,8 +203,9 @@ | |||
| 202 | (math-comp-comma-spc (or calc-vector-commas " ")) | 203 | (math-comp-comma-spc (or calc-vector-commas " ")) |
| 203 | (math-comp-comma (or calc-vector-commas "")) | 204 | (math-comp-comma (or calc-vector-commas "")) |
| 204 | (math-comp-vector-prec (if (or (and calc-vector-commas | 205 | (math-comp-vector-prec (if (or (and calc-vector-commas |
| 205 | (math-vector-no-parens a)) | 206 | (math-vector-no-parens a)) |
| 206 | (memq 'P calc-matrix-brackets)) 0 1000)) | 207 | (memq 'P calc-matrix-brackets)) |
| 208 | 0 1000)) | ||
| 207 | (math-comp-just (cond ((eq calc-matrix-just 'right) 'vright) | 209 | (math-comp-just (cond ((eq calc-matrix-just 'right) 'vright) |
| 208 | ((eq calc-matrix-just 'center) 'vcent) | 210 | ((eq calc-matrix-just 'center) 'vcent) |
| 209 | (t 'vleft))) | 211 | (t 'vleft))) |
| @@ -803,8 +805,7 @@ | |||
| 803 | ( % . calcFunc-mod ) | 805 | ( % . calcFunc-mod ) |
| 804 | ( ^ . calcFunc-pow ) | 806 | ( ^ . calcFunc-pow ) |
| 805 | ( neg . calcFunc-neg ) | 807 | ( neg . calcFunc-neg ) |
| 806 | ( | . calcFunc-vconcat )))) | 808 | ( | . calcFunc-vconcat ))))) |
| 807 | left right args) | ||
| 808 | (if func2 | 809 | (if func2 |
| 809 | (setq func (cdr func2))) | 810 | (setq func (cdr func2))) |
| 810 | (if (setq func2 (rassq func math-expr-function-mapping)) | 811 | (if (setq func2 (rassq func math-expr-function-mapping)) |
| @@ -858,7 +859,7 @@ | |||
| 858 | (or (cdr (cdr a)) | 859 | (or (cdr (cdr a)) |
| 859 | (not (eq (car-safe (nth 1 a)) '*)))) | 860 | (not (eq (car-safe (nth 1 a)) '*)))) |
| 860 | 861 | ||
| 861 | (defun math-compose-matrix (a col cols base) | 862 | (defun math-compose-matrix (a _col cols base) |
| 862 | (let ((col 0) | 863 | (let ((col 0) |
| 863 | (res nil)) | 864 | (res nil)) |
| 864 | (while (<= (setq col (1+ col)) cols) | 865 | (while (<= (setq col (1+ col)) cols) |
| @@ -968,8 +969,8 @@ | |||
| 968 | (and (memq (car a) '(^ calcFunc-subscr)) | 969 | (and (memq (car a) '(^ calcFunc-subscr)) |
| 969 | (math-tex-expr-is-flat (nth 1 a))))) | 970 | (math-tex-expr-is-flat (nth 1 a))))) |
| 970 | 971 | ||
| 971 | (put 'calcFunc-log 'math-compose-big 'math-compose-log) | 972 | (put 'calcFunc-log 'math-compose-big #'math-compose-log) |
| 972 | (defun math-compose-log (a prec) | 973 | (defun math-compose-log (a _prec) |
| 973 | (and (= (length a) 3) | 974 | (and (= (length a) 3) |
| 974 | (list 'horiz | 975 | (list 'horiz |
| 975 | (list 'subscr "log" | 976 | (list 'subscr "log" |
| @@ -979,8 +980,8 @@ | |||
| 979 | (math-compose-expr (nth 1 a) 1000) | 980 | (math-compose-expr (nth 1 a) 1000) |
| 980 | ")"))) | 981 | ")"))) |
| 981 | 982 | ||
| 982 | (put 'calcFunc-log10 'math-compose-big 'math-compose-log10) | 983 | (put 'calcFunc-log10 'math-compose-big #'math-compose-log10) |
| 983 | (defun math-compose-log10 (a prec) | 984 | (defun math-compose-log10 (a _prec) |
| 984 | (and (= (length a) 2) | 985 | (and (= (length a) 2) |
| 985 | (list 'horiz | 986 | (list 'horiz |
| 986 | (list 'subscr "log" "10") | 987 | (list 'subscr "log" "10") |
| @@ -988,8 +989,8 @@ | |||
| 988 | (math-compose-expr (nth 1 a) 1000) | 989 | (math-compose-expr (nth 1 a) 1000) |
| 989 | ")"))) | 990 | ")"))) |
| 990 | 991 | ||
| 991 | (put 'calcFunc-deriv 'math-compose-big 'math-compose-deriv) | 992 | (put 'calcFunc-deriv 'math-compose-big #'math-compose-deriv) |
| 992 | (put 'calcFunc-tderiv 'math-compose-big 'math-compose-deriv) | 993 | (put 'calcFunc-tderiv 'math-compose-big #'math-compose-deriv) |
| 993 | (defun math-compose-deriv (a prec) | 994 | (defun math-compose-deriv (a prec) |
| 994 | (when (= (length a) 3) | 995 | (when (= (length a) 3) |
| 995 | (math-compose-expr (list '/ | 996 | (math-compose-expr (list '/ |
| @@ -1003,8 +1004,8 @@ | |||
| 1003 | (nth 2 a)))) | 1004 | (nth 2 a)))) |
| 1004 | prec))) | 1005 | prec))) |
| 1005 | 1006 | ||
| 1006 | (put 'calcFunc-sqrt 'math-compose-big 'math-compose-sqrt) | 1007 | (put 'calcFunc-sqrt 'math-compose-big #'math-compose-sqrt) |
| 1007 | (defun math-compose-sqrt (a prec) | 1008 | (defun math-compose-sqrt (a _prec) |
| 1008 | (when (= (length a) 2) | 1009 | (when (= (length a) 2) |
| 1009 | (let* ((c (math-compose-expr (nth 1 a) 0)) | 1010 | (let* ((c (math-compose-expr (nth 1 a) 0)) |
| 1010 | (a (math-comp-ascent c)) | 1011 | (a (math-comp-ascent c)) |
| @@ -1024,8 +1025,8 @@ | |||
| 1024 | " " | 1025 | " " |
| 1025 | c))))) | 1026 | c))))) |
| 1026 | 1027 | ||
| 1027 | (put 'calcFunc-choose 'math-compose-big 'math-compose-choose) | 1028 | (put 'calcFunc-choose 'math-compose-big #'math-compose-choose) |
| 1028 | (defun math-compose-choose (a prec) | 1029 | (defun math-compose-choose (a _prec) |
| 1029 | (let ((a1 (math-compose-expr (nth 1 a) 0)) | 1030 | (let ((a1 (math-compose-expr (nth 1 a) 0)) |
| 1030 | (a2 (math-compose-expr (nth 2 a) 0))) | 1031 | (a2 (math-compose-expr (nth 2 a) 0))) |
| 1031 | (list 'horiz | 1032 | (list 'horiz |
| @@ -1035,7 +1036,7 @@ | |||
| 1035 | a1 " " a2) | 1036 | a1 " " a2) |
| 1036 | ")"))) | 1037 | ")"))) |
| 1037 | 1038 | ||
| 1038 | (put 'calcFunc-integ 'math-compose-big 'math-compose-integ) | 1039 | (put 'calcFunc-integ 'math-compose-big #'math-compose-integ) |
| 1039 | (defun math-compose-integ (a prec) | 1040 | (defun math-compose-integ (a prec) |
| 1040 | (and (memq (length a) '(3 5)) | 1041 | (and (memq (length a) '(3 5)) |
| 1041 | (eq (car-safe (nth 2 a)) 'var) | 1042 | (eq (car-safe (nth 2 a)) 'var) |
| @@ -1072,7 +1073,7 @@ | |||
| 1072 | (list 'horiz " d" var)) | 1073 | (list 'horiz " d" var)) |
| 1073 | (if parens ")" ""))))) | 1074 | (if parens ")" ""))))) |
| 1074 | 1075 | ||
| 1075 | (put 'calcFunc-sum 'math-compose-big 'math-compose-sum) | 1076 | (put 'calcFunc-sum 'math-compose-big #'math-compose-sum) |
| 1076 | (defun math-compose-sum (a prec) | 1077 | (defun math-compose-sum (a prec) |
| 1077 | (and (memq (length a) '(3 5 6)) | 1078 | (and (memq (length a) '(3 5 6)) |
| 1078 | (let* ((expr (math-compose-expr (nth 1 a) 185)) | 1079 | (let* ((expr (math-compose-expr (nth 1 a) 185)) |
| @@ -1097,7 +1098,7 @@ | |||
| 1097 | expr | 1098 | expr |
| 1098 | (if (memq prec '(180 201)) ")" ""))))) | 1099 | (if (memq prec '(180 201)) ")" ""))))) |
| 1099 | 1100 | ||
| 1100 | (put 'calcFunc-prod 'math-compose-big 'math-compose-prod) | 1101 | (put 'calcFunc-prod 'math-compose-big #'math-compose-prod) |
| 1101 | (defun math-compose-prod (a prec) | 1102 | (defun math-compose-prod (a prec) |
| 1102 | (and (memq (length a) '(3 5 6)) | 1103 | (and (memq (length a) '(3 5 6)) |
| 1103 | (let* ((expr (math-compose-expr (nth 1 a) 198)) | 1104 | (let* ((expr (math-compose-expr (nth 1 a) 198)) |
| @@ -1124,12 +1125,11 @@ | |||
| 1124 | ;; The variables math-svo-c, math-svo-wid and math-svo-off are local | 1125 | ;; The variables math-svo-c, math-svo-wid and math-svo-off are local |
| 1125 | ;; to math-stack-value-offset in calc.el, but are used by | 1126 | ;; to math-stack-value-offset in calc.el, but are used by |
| 1126 | ;; math-stack-value-offset-fancy, which is called by math-stack-value-offset.. | 1127 | ;; math-stack-value-offset-fancy, which is called by math-stack-value-offset.. |
| 1127 | (defvar math-svo-c) | ||
| 1128 | (defvar math-svo-wid) | 1128 | (defvar math-svo-wid) |
| 1129 | (defvar math-svo-off) | 1129 | (defvar math-svo-off) |
| 1130 | 1130 | ||
| 1131 | (defun math-stack-value-offset-fancy () | 1131 | (defun math-stack-value-offset-fancy (c) |
| 1132 | (let ((cwid (+ (math-comp-width math-svo-c)))) | 1132 | (let ((cwid (+ (math-comp-width c)))) |
| 1133 | (cond ((eq calc-display-just 'right) | 1133 | (cond ((eq calc-display-just 'right) |
| 1134 | (if calc-display-origin | 1134 | (if calc-display-origin |
| 1135 | (setq math-svo-wid (max calc-display-origin 5)) | 1135 | (setq math-svo-wid (max calc-display-origin 5)) |
| @@ -1215,7 +1215,7 @@ | |||
| 1215 | ;; which are called by math-comp-to-string-flat. | 1215 | ;; which are called by math-comp-to-string-flat. |
| 1216 | (defvar math-comp-pos) | 1216 | (defvar math-comp-pos) |
| 1217 | 1217 | ||
| 1218 | (defun math-comp-to-string-flat (c math-comp-full-width) | 1218 | (defun math-comp-to-string-flat (c full-width) |
| 1219 | (if math-comp-sel-hpos | 1219 | (if math-comp-sel-hpos |
| 1220 | (let ((math-comp-pos 0)) | 1220 | (let ((math-comp-pos 0)) |
| 1221 | (math-comp-sel-flat-term c)) | 1221 | (math-comp-sel-flat-term c)) |
| @@ -1224,6 +1224,7 @@ | |||
| 1224 | (math-comp-pos 0) | 1224 | (math-comp-pos 0) |
| 1225 | (math-comp-margin 0) | 1225 | (math-comp-margin 0) |
| 1226 | (math-comp-highlight (and math-comp-selected calc-show-selections)) | 1226 | (math-comp-highlight (and math-comp-selected calc-show-selections)) |
| 1227 | (math-comp-full-width full-width) | ||
| 1227 | (math-comp-level -1)) | 1228 | (math-comp-level -1)) |
| 1228 | (math-comp-to-string-flat-term '(set -1 0)) | 1229 | (math-comp-to-string-flat-term '(set -1 0)) |
| 1229 | (math-comp-to-string-flat-term c) | 1230 | (math-comp-to-string-flat-term c) |
| @@ -1387,7 +1388,7 @@ | |||
| 1387 | (defvar math-comp-hpos) | 1388 | (defvar math-comp-hpos) |
| 1388 | (defvar math-comp-vpos) | 1389 | (defvar math-comp-vpos) |
| 1389 | 1390 | ||
| 1390 | (defun math-comp-simplify (c full-width) | 1391 | (defun math-comp-simplify (c _full-width) |
| 1391 | (let ((math-comp-buf (list "")) | 1392 | (let ((math-comp-buf (list "")) |
| 1392 | (math-comp-base 0) | 1393 | (math-comp-base 0) |
| 1393 | (math-comp-hgt 1) | 1394 | (math-comp-hgt 1) |