diff options
| author | Jay Belanger | 2004-11-09 20:29:34 +0000 |
|---|---|---|
| committer | Jay Belanger | 2004-11-09 20:29:34 +0000 |
| commit | 722401eb1289ca370b82a229b46819bd7e275222 (patch) | |
| tree | 47937323340488f9bcd812c07b810bf760351a95 | |
| parent | 3e58bf8b8f1b4b1ba5724f9381b39684e144ddf0 (diff) | |
| download | emacs-722401eb1289ca370b82a229b46819bd7e275222.tar.gz emacs-722401eb1289ca370b82a229b46819bd7e275222.zip | |
(calc-init-extensions): Remove old code.
(math-expr-data, math-mt-many, math-mt-func, calc-z-prefix-buf)
(calc-z-prefix-msgs): New variables.
(calc-z-prefix-help, calc-user-function-list): Use declared variables
calc-z-prefix-buf, calc-z-prefix-msgs.
(math-normalize-nonstandard): Use declared variable math-normalize-a.
(math-map-tree, math-map-tree-rec): Use declared variables
math-mt-many, math-mt-func.
(math-read-expression, math-read-string): Use declared variable math-expr-data.
| -rw-r--r-- | lisp/calc/calc-ext.el | 85 |
1 files changed, 43 insertions, 42 deletions
diff --git a/lisp/calc/calc-ext.el b/lisp/calc/calc-ext.el index 214ad24834d..2c7662277d6 100644 --- a/lisp/calc/calc-ext.el +++ b/lisp/calc/calc-ext.el | |||
| @@ -663,16 +663,6 @@ | |||
| 663 | (define-key calc-alg-map "\e\C-m" 'calc-last-args-stub) | 663 | (define-key calc-alg-map "\e\C-m" 'calc-last-args-stub) |
| 664 | (define-key calc-alg-map "\e\177" 'calc-pop-above) | 664 | (define-key calc-alg-map "\e\177" 'calc-pop-above) |
| 665 | 665 | ||
| 666 | ;; The following is a relic for backward compatability only. | ||
| 667 | ;; The calc-define property list is now the recommended method. | ||
| 668 | (if (and (boundp 'calc-ext-defs) | ||
| 669 | calc-ext-defs) | ||
| 670 | (progn | ||
| 671 | (calc-need-macros) | ||
| 672 | (message "Evaluating calc-ext-defs...") | ||
| 673 | (eval (cons 'progn calc-ext-defs)) | ||
| 674 | (setq calc-ext-defs nil))) | ||
| 675 | |||
| 676 | ;;;; (Autoloads here) | 666 | ;;;; (Autoloads here) |
| 677 | (mapcar (function (lambda (x) | 667 | (mapcar (function (lambda (x) |
| 678 | (mapcar (function (lambda (func) | 668 | (mapcar (function (lambda (func) |
| @@ -1770,10 +1760,13 @@ calc-kill calc-kill-region calc-yank)))) | |||
| 1770 | (cdr res) | 1760 | (cdr res) |
| 1771 | res))) | 1761 | res))) |
| 1772 | 1762 | ||
| 1763 | (defvar calc-z-prefix-buf nil) | ||
| 1764 | (defvar calc-z-prefix-msgs nil) | ||
| 1765 | |||
| 1773 | (defun calc-z-prefix-help () | 1766 | (defun calc-z-prefix-help () |
| 1774 | (interactive) | 1767 | (interactive) |
| 1775 | (let* ((msgs nil) | 1768 | (let* ((calc-z-prefix-msgs nil) |
| 1776 | (buf "") | 1769 | (calc-z-prefix-buf "") |
| 1777 | (kmap (sort (copy-sequence (calc-user-key-map)) | 1770 | (kmap (sort (copy-sequence (calc-user-key-map)) |
| 1778 | (function (lambda (x y) (< (car x) (car y)))))) | 1771 | (function (lambda (x y) (< (car x) (car y)))))) |
| 1779 | (flags (apply 'logior | 1772 | (flags (apply 'logior |
| @@ -1784,12 +1777,12 @@ calc-kill calc-kill-region calc-yank)))) | |||
| 1784 | (if (= (logand flags 8) 0) | 1777 | (if (= (logand flags 8) 0) |
| 1785 | (calc-user-function-list kmap 7) | 1778 | (calc-user-function-list kmap 7) |
| 1786 | (calc-user-function-list kmap 1) | 1779 | (calc-user-function-list kmap 1) |
| 1787 | (setq msgs (cons buf msgs) | 1780 | (setq calc-z-prefix-msgs (cons calc-z-prefix-buf calc-z-prefix-msgs) |
| 1788 | buf "") | 1781 | calc-z-prefix-buf "") |
| 1789 | (calc-user-function-list kmap 6)) | 1782 | (calc-user-function-list kmap 6)) |
| 1790 | (if (/= flags 0) | 1783 | (if (/= flags 0) |
| 1791 | (setq msgs (cons buf msgs))) | 1784 | (setq calc-z-prefix-msgs (cons calc-z-prefix-buf calc-z-prefix-msgs))) |
| 1792 | (calc-do-prefix-help (nreverse msgs) "user" ?z))) | 1785 | (calc-do-prefix-help (nreverse calc-z-prefix-msgs) "user" ?z))) |
| 1793 | 1786 | ||
| 1794 | (defun calc-user-function-classify (key) | 1787 | (defun calc-user-function-classify (key) |
| 1795 | (cond ((/= key (downcase key)) ; upper-case | 1788 | (cond ((/= key (downcase key)) ; upper-case |
| @@ -1823,14 +1816,15 @@ calc-kill calc-kill-region calc-yank)))) | |||
| 1823 | (upcase key) | 1816 | (upcase key) |
| 1824 | (downcase name)))) | 1817 | (downcase name)))) |
| 1825 | (char-to-string (upcase key))))) | 1818 | (char-to-string (upcase key))))) |
| 1826 | (if (= (length buf) 0) | 1819 | (if (= (length calc-z-prefix-buf) 0) |
| 1827 | (setq buf (concat (if (= flags 1) "SHIFT + " "") | 1820 | (setq calc-z-prefix-buf (concat (if (= flags 1) "SHIFT + " "") |
| 1828 | desc)) | 1821 | desc)) |
| 1829 | (if (> (+ (length buf) (length desc)) 58) | 1822 | (if (> (+ (length calc-z-prefix-buf) (length desc)) 58) |
| 1830 | (setq msgs (cons buf msgs) | 1823 | (setq calc-z-prefix-msgs |
| 1831 | buf (concat (if (= flags 1) "SHIFT + " "") | 1824 | (cons calc-z-prefix-buf calc-z-prefix-msgs) |
| 1825 | calc-z-prefix-buf (concat (if (= flags 1) "SHIFT + " "") | ||
| 1832 | desc)) | 1826 | desc)) |
| 1833 | (setq buf (concat buf ", " desc)))))) | 1827 | (setq calc-z-prefix-buf (concat calc-z-prefix-buf ", " desc)))))) |
| 1834 | (calc-user-function-list (cdr map) flags)))) | 1828 | (calc-user-function-list (cdr map) flags)))) |
| 1835 | 1829 | ||
| 1836 | 1830 | ||
| @@ -2224,25 +2218,25 @@ calc-kill calc-kill-region calc-yank)))) | |||
| 2224 | (math-normalize (car a)) | 2218 | (math-normalize (car a)) |
| 2225 | (error "Can't use multi-valued function in an expression"))))) | 2219 | (error "Can't use multi-valued function in an expression"))))) |
| 2226 | 2220 | ||
| 2227 | (defun math-normalize-nonstandard () ; uses "a" | 2221 | (defun math-normalize-nonstandard () |
| 2228 | (if (consp calc-simplify-mode) | 2222 | (if (consp calc-simplify-mode) |
| 2229 | (progn | 2223 | (progn |
| 2230 | (setq calc-simplify-mode 'none | 2224 | (setq calc-simplify-mode 'none |
| 2231 | math-simplify-only (car-safe (cdr-safe a))) | 2225 | math-simplify-only (car-safe (cdr-safe math-normalize-a))) |
| 2232 | nil) | 2226 | nil) |
| 2233 | (and (symbolp (car a)) | 2227 | (and (symbolp (car math-normalize-a)) |
| 2234 | (or (eq calc-simplify-mode 'none) | 2228 | (or (eq calc-simplify-mode 'none) |
| 2235 | (and (eq calc-simplify-mode 'num) | 2229 | (and (eq calc-simplify-mode 'num) |
| 2236 | (let ((aptr (setq a (cons | 2230 | (let ((aptr (setq math-normalize-a |
| 2237 | (car a) | 2231 | (cons |
| 2238 | (mapcar 'math-normalize (cdr a)))))) | 2232 | (car math-normalize-a) |
| 2233 | (mapcar 'math-normalize | ||
| 2234 | (cdr math-normalize-a)))))) | ||
| 2239 | (while (and aptr (math-constp (car aptr))) | 2235 | (while (and aptr (math-constp (car aptr))) |
| 2240 | (setq aptr (cdr aptr))) | 2236 | (setq aptr (cdr aptr))) |
| 2241 | aptr))) | 2237 | aptr))) |
| 2242 | (cons (car a) (mapcar 'math-normalize (cdr a)))))) | 2238 | (cons (car math-normalize-a) |
| 2243 | 2239 | (mapcar 'math-normalize (cdr math-normalize-a)))))) | |
| 2244 | |||
| 2245 | |||
| 2246 | 2240 | ||
| 2247 | 2241 | ||
| 2248 | ;;; Normalize a bignum digit list by trimming high-end zeros. [L l] | 2242 | ;;; Normalize a bignum digit list by trimming high-end zeros. [L l] |
| @@ -2620,22 +2614,27 @@ calc-kill calc-kill-region calc-yank)))) | |||
| 2620 | 2614 | ||
| 2621 | (defvar var-FactorRules 'calc-FactorRules) | 2615 | (defvar var-FactorRules 'calc-FactorRules) |
| 2622 | 2616 | ||
| 2623 | (defun math-map-tree (mmt-func mmt-expr &optional mmt-many) | 2617 | (defvar math-mt-many nil) |
| 2624 | (or mmt-many (setq mmt-many 1000000)) | 2618 | (defvar math-mt-func nil) |
| 2619 | |||
| 2620 | (defun math-map-tree (math-mt-func mmt-expr &optional math-mt-many) | ||
| 2621 | (or math-mt-many (setq math-mt-many 1000000)) | ||
| 2625 | (math-map-tree-rec mmt-expr)) | 2622 | (math-map-tree-rec mmt-expr)) |
| 2626 | 2623 | ||
| 2627 | (defun math-map-tree-rec (mmt-expr) | 2624 | (defun math-map-tree-rec (mmt-expr) |
| 2628 | (or (= mmt-many 0) | 2625 | (or (= math-mt-many 0) |
| 2629 | (let ((mmt-done nil) | 2626 | (let ((mmt-done nil) |
| 2630 | mmt-nextval) | 2627 | mmt-nextval) |
| 2631 | (while (not mmt-done) | 2628 | (while (not mmt-done) |
| 2632 | (while (and (/= mmt-many 0) | 2629 | (while (and (/= math-mt-many 0) |
| 2633 | (setq mmt-nextval (funcall mmt-func mmt-expr)) | 2630 | (setq mmt-nextval (funcall math-mt-func mmt-expr)) |
| 2634 | (not (equal mmt-expr mmt-nextval))) | 2631 | (not (equal mmt-expr mmt-nextval))) |
| 2635 | (setq mmt-expr mmt-nextval | 2632 | (setq mmt-expr mmt-nextval |
| 2636 | mmt-many (if (> mmt-many 0) (1- mmt-many) (1+ mmt-many)))) | 2633 | math-mt-many (if (> math-mt-many 0) |
| 2634 | (1- math-mt-many) | ||
| 2635 | (1+ math-mt-many)))) | ||
| 2637 | (if (or (Math-primp mmt-expr) | 2636 | (if (or (Math-primp mmt-expr) |
| 2638 | (<= mmt-many 0)) | 2637 | (<= math-mt-many 0)) |
| 2639 | (setq mmt-done t) | 2638 | (setq mmt-done t) |
| 2640 | (setq mmt-nextval (cons (car mmt-expr) | 2639 | (setq mmt-nextval (cons (car mmt-expr) |
| 2641 | (mapcar 'math-map-tree-rec | 2640 | (mapcar 'math-map-tree-rec |
| @@ -2886,11 +2885,13 @@ calc-kill calc-kill-region calc-yank)))) | |||
| 2886 | 2885 | ||
| 2887 | ;;; Expression parsing. | 2886 | ;;; Expression parsing. |
| 2888 | 2887 | ||
| 2888 | (defvar math-expr-data) | ||
| 2889 | |||
| 2889 | (defun math-read-expr (exp-str) | 2890 | (defun math-read-expr (exp-str) |
| 2890 | (let ((exp-pos 0) | 2891 | (let ((exp-pos 0) |
| 2891 | (exp-old-pos 0) | 2892 | (exp-old-pos 0) |
| 2892 | (exp-keep-spaces nil) | 2893 | (exp-keep-spaces nil) |
| 2893 | exp-token exp-data) | 2894 | exp-token math-expr-data) |
| 2894 | (while (setq exp-token (string-match "\\.\\.\\([^.]\\|.[^.]\\)" exp-str)) | 2895 | (while (setq exp-token (string-match "\\.\\.\\([^.]\\|.[^.]\\)" exp-str)) |
| 2895 | (setq exp-str (concat (substring exp-str 0 exp-token) "\\dots" | 2896 | (setq exp-str (concat (substring exp-str 0 exp-token) "\\dots" |
| 2896 | (substring exp-str (+ exp-token 2))))) | 2897 | (substring exp-str (+ exp-token 2))))) |
| @@ -2914,8 +2915,8 @@ calc-kill calc-kill-region calc-yank)))) | |||
| 2914 | 2915 | ||
| 2915 | 2916 | ||
| 2916 | (defun math-read-string () | 2917 | (defun math-read-string () |
| 2917 | (let ((str (read-from-string (concat exp-data "\"")))) | 2918 | (let ((str (read-from-string (concat math-expr-data "\"")))) |
| 2918 | (or (and (= (cdr str) (1+ (length exp-data))) | 2919 | (or (and (= (cdr str) (1+ (length math-expr-data))) |
| 2919 | (stringp (car str))) | 2920 | (stringp (car str))) |
| 2920 | (throw 'syntax "Error in string constant")) | 2921 | (throw 'syntax "Error in string constant")) |
| 2921 | (math-read-token) | 2922 | (math-read-token) |