aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJay Belanger2004-11-09 20:29:34 +0000
committerJay Belanger2004-11-09 20:29:34 +0000
commit722401eb1289ca370b82a229b46819bd7e275222 (patch)
tree47937323340488f9bcd812c07b810bf760351a95
parent3e58bf8b8f1b4b1ba5724f9381b39684e144ddf0 (diff)
downloademacs-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.el85
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)