From 4710da05cb3e569a3701b06b83a16a63cc3ac24c Mon Sep 17 00:00:00 2001 From: Jay Belanger Date: Sun, 7 Nov 2004 23:33:29 +0000 Subject: (math-linear-subst-tried): New variable. (math-do-integral): Set `math-linear-subst-tried' to nil. (math-do-integral-methods): Use `math-linear-subst-tried' to determine what type of substitution to try. (math-integ-try-linear-substituion): Set `math-linear-subst-tried' to t. --- lisp/calc/calcalg2.el | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) (limited to 'lisp/calc') diff --git a/lisp/calc/calcalg2.el b/lisp/calc/calcalg2.el index 2a463009e58..7e8484ea79f 100644 --- a/lisp/calc/calcalg2.el +++ b/lisp/calc/calcalg2.el @@ -738,8 +738,12 @@ (setcar (cdr cur-record) 'cancelled))) (math-replace-integral-parts (car expr))))))) +(defvar math-linear-subst-tried t + "Non-nil means that a linear substitution has been tried.") + (defun math-do-integral (expr) - (let (t1 t2) + (let ((math-linear-subst-tried nil) + t1 t2) (or (cond ((not (math-expr-contains expr math-integ-var)) (math-mul expr math-integ-var)) ((equal expr math-integ-var) @@ -977,7 +981,7 @@ ;; Integration by substitution, for various likely sub-expressions. ;; (In first pass, we look only for sub-exprs that are linear in X.) - (or (if math-enable-subst + (or (if math-linear-subst-tried (math-integ-try-substitutions expr) (math-integ-try-linear-substitutions expr)) @@ -1189,6 +1193,7 @@ ;;; Look for substitutions of the form u = a x + b. (defun math-integ-try-linear-substitutions (sub-expr) + (setq math-linear-subst-tried t) (and (not (Math-primp sub-expr)) (or (and (not (memq (car sub-expr) '(+ - * / neg))) (not (and (eq (car sub-expr) '^) -- cgit v1.2.1 From f1e0e03c67fb21caa994e5b5474ca3abb371d131 Mon Sep 17 00:00:00 2001 From: Jay Belanger Date: Mon, 8 Nov 2004 02:21:11 +0000 Subject: (math-do-integral-methods): Try linear, then non-linear, substitutions. --- lisp/calc/calcalg2.el | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) (limited to 'lisp/calc') diff --git a/lisp/calc/calcalg2.el b/lisp/calc/calcalg2.el index 7e8484ea79f..ff23c3e5421 100644 --- a/lisp/calc/calcalg2.el +++ b/lisp/calc/calcalg2.el @@ -981,9 +981,8 @@ ;; Integration by substitution, for various likely sub-expressions. ;; (In first pass, we look only for sub-exprs that are linear in X.) - (or (if math-linear-subst-tried - (math-integ-try-substitutions expr) - (math-integ-try-linear-substitutions expr)) + (or (math-integ-try-linear-substitutions expr) + (math-integ-try-substitutions expr) ;; If function has sines and cosines, try tan(x/2) substitution. (and (let ((p (setq rat-in (math-expr-rational-in expr)))) -- cgit v1.2.1 From f55320b5c435a53b2a1dda4b0c485c324dacf740 Mon Sep 17 00:00:00 2001 From: Jay Belanger Date: Tue, 9 Nov 2004 04:43:03 +0000 Subject: (calc-mode-hook, calc-trail-mode-hook, calc-start-hook, calc-end-hook) (calc-load-hook): New variables. (calc, calc-trail-display, calc-mode): Removed obsolete sections. (calc-x-paste-text): Removed. --- lisp/calc/calc.el | 78 ++++++++++++++++++++----------------------------------- 1 file changed, 28 insertions(+), 50 deletions(-) (limited to 'lisp/calc') diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index 4ace5fb6780..75e6d534e4e 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el @@ -654,6 +654,20 @@ If nil, selections displayed but ignored.") calc-word-size calc-internal-prec)) +(defvar calc-mode-hook nil + "Hook run when entering calc-mode.") + +(defvar calc-trail-mode-hook nil + "Hook run when entering calc-trail-mode.") + +(defvar calc-start-hook nil + "Hook run when calc is started.") + +(defvar calc-end-hook nil + "Hook run when calc is quit.") + +(defvar calc-load-hook nil + "Hook run when calc.el is loaded.") ;; Verify that Calc is running on the right kind of system. (defvar calc-emacs-type-lucid (not (not (string-match "Lucid" emacs-version)))) @@ -1056,9 +1070,6 @@ Notations: 3.14e6 3.14 * 10^6 (progn (setq calc-loaded-settings-file t) (load calc-settings-file t))) ; t = missing-ok - (if (and (eq window-system 'x) (boundp 'mouse-map)) - (substitute-key-definition 'x-paste-text 'calc-x-paste-text - mouse-map)) (let ((p command-line-args)) (while p (and (equal (car p) "-f") @@ -1069,14 +1080,6 @@ Notations: 3.14e6 3.14 * 10^6 (run-hooks 'calc-mode-hook) (calc-refresh t) (calc-set-mode-line) - ;; The calc-defs variable is a relic. Use calc-define properties instead. - (when (and (boundp 'calc-defs) - calc-defs) - (message "Evaluating calc-defs...") - (calc-need-macros) - (eval (cons 'progn calc-defs)) - (setq calc-defs nil) - (calc-set-mode-line)) (calc-check-defines)) (defvar calc-check-defines 'calc-check-defines) ; suitable for run-hooks @@ -1163,20 +1166,18 @@ commands given here will actually operate on the *Calculator* stack." (switch-to-buffer (current-buffer) t) (if (get-buffer-window (current-buffer)) (select-window (get-buffer-window (current-buffer))) - (if (and (boundp 'calc-window-hook) calc-window-hook) - (run-hooks 'calc-window-hook) - (let ((w (get-largest-window))) - (if (and pop-up-windows - (> (window-height w) - (+ window-min-height calc-window-height 2))) - (progn - (setq w (split-window w - (- (window-height w) - calc-window-height 2) - nil)) - (set-window-buffer w (current-buffer)) - (select-window w)) - (pop-to-buffer (current-buffer))))))) + (let ((w (get-largest-window))) + (if (and pop-up-windows + (> (window-height w) + (+ window-min-height calc-window-height 2))) + (progn + (setq w (split-window w + (- (window-height w) + calc-window-height 2) + nil)) + (set-window-buffer w (current-buffer)) + (select-window w)) + (pop-to-buffer (current-buffer)))))) (save-excursion (set-buffer (calc-trail-buffer)) (and calc-display-trail @@ -1722,27 +1723,6 @@ See calc-keypad for details." (calc-refresh align))) (setq calc-refresh-count (1+ calc-refresh-count))) - -(defun calc-x-paste-text (arg) - "Move point to mouse position and insert window system cut buffer contents. -If mouse is pressed in Calc window, push cut buffer contents onto the stack." - (x-mouse-select arg) - (if (memq major-mode '(calc-mode calc-trail-mode)) - (progn - (calc-wrapper - (calc-extensions) - (let* ((buf (x-get-cut-buffer)) - (val (math-read-exprs (calc-clean-newlines buf)))) - (if (eq (car-safe val) 'error) - (progn - (setq val (math-read-exprs buf)) - (if (eq (car-safe val) 'error) - (error "%s in yanked data" (nth 2 val))))) - (calc-enter-result 0 "Xynk" val)))) - (x-paste-text arg))) - - - ;;;; The Calc Trail buffer. (defun calc-check-trail-aligned () @@ -1808,10 +1788,8 @@ If mouse is pressed in Calc window, push cut buffer contents onto the stack." (not (if flag (memq flag '(nil 0)) win))) (if (null win) (progn - (if (and (boundp 'calc-trail-window-hook) calc-trail-window-hook) - (run-hooks 'calc-trail-window-hook) - (let ((w (split-window nil (/ (* (window-width) 2) 3) t))) - (set-window-buffer w calc-trail-buffer))) + (let ((w (split-window nil (/ (* (window-width) 2) 3) t))) + (set-window-buffer w calc-trail-buffer)) (calc-wrapper (setq overlay-arrow-string calc-trail-overlay overlay-arrow-position calc-trail-pointer) -- cgit v1.2.1 From 5f16f8be790080ed7c0892b85344c9d2ba716c20 Mon Sep 17 00:00:00 2001 From: Jay Belanger Date: Tue, 9 Nov 2004 04:49:01 +0000 Subject: (calc-init-extensions): Bound calc-yank to mouse-2. --- lisp/calc/calc-ext.el | 1 + 1 file changed, 1 insertion(+) (limited to 'lisp/calc') diff --git a/lisp/calc/calc-ext.el b/lisp/calc/calc-ext.el index 4679cf8abaa..214ad24834d 100644 --- a/lisp/calc/calc-ext.el +++ b/lisp/calc/calc-ext.el @@ -108,6 +108,7 @@ (define-key calc-mode-map "\C-w" 'calc-kill-region) (define-key calc-mode-map "\M-w" 'calc-copy-region-as-kill) (define-key calc-mode-map "\C-y" 'calc-yank) + (define-key calc-mode-map [mouse-2] 'calc-yank) (define-key calc-mode-map "\C-_" 'calc-undo) (define-key calc-mode-map "\C-xu" 'calc-undo) (define-key calc-mode-map "\M-\C-m" 'calc-last-args) -- cgit v1.2.1 From 722401eb1289ca370b82a229b46819bd7e275222 Mon Sep 17 00:00:00 2001 From: Jay Belanger Date: Tue, 9 Nov 2004 20:29:34 +0000 Subject: (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. --- lisp/calc/calc-ext.el | 85 ++++++++++++++++++++++++++------------------------- 1 file changed, 43 insertions(+), 42 deletions(-) (limited to 'lisp/calc') 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 @@ (define-key calc-alg-map "\e\C-m" 'calc-last-args-stub) (define-key calc-alg-map "\e\177" 'calc-pop-above) - ;; The following is a relic for backward compatability only. - ;; The calc-define property list is now the recommended method. - (if (and (boundp 'calc-ext-defs) - calc-ext-defs) - (progn - (calc-need-macros) - (message "Evaluating calc-ext-defs...") - (eval (cons 'progn calc-ext-defs)) - (setq calc-ext-defs nil))) - ;;;; (Autoloads here) (mapcar (function (lambda (x) (mapcar (function (lambda (func) @@ -1770,10 +1760,13 @@ calc-kill calc-kill-region calc-yank)))) (cdr res) res))) +(defvar calc-z-prefix-buf nil) +(defvar calc-z-prefix-msgs nil) + (defun calc-z-prefix-help () (interactive) - (let* ((msgs nil) - (buf "") + (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)))))) (flags (apply 'logior @@ -1784,12 +1777,12 @@ calc-kill calc-kill-region calc-yank)))) (if (= (logand flags 8) 0) (calc-user-function-list kmap 7) (calc-user-function-list kmap 1) - (setq msgs (cons buf msgs) - buf "") + (setq calc-z-prefix-msgs (cons calc-z-prefix-buf calc-z-prefix-msgs) + calc-z-prefix-buf "") (calc-user-function-list kmap 6)) (if (/= flags 0) - (setq msgs (cons buf msgs))) - (calc-do-prefix-help (nreverse msgs) "user" ?z))) + (setq calc-z-prefix-msgs (cons calc-z-prefix-buf calc-z-prefix-msgs))) + (calc-do-prefix-help (nreverse calc-z-prefix-msgs) "user" ?z))) (defun calc-user-function-classify (key) (cond ((/= key (downcase key)) ; upper-case @@ -1823,14 +1816,15 @@ calc-kill calc-kill-region calc-yank)))) (upcase key) (downcase name)))) (char-to-string (upcase key))))) - (if (= (length buf) 0) - (setq buf (concat (if (= flags 1) "SHIFT + " "") + (if (= (length calc-z-prefix-buf) 0) + (setq calc-z-prefix-buf (concat (if (= flags 1) "SHIFT + " "") desc)) - (if (> (+ (length buf) (length desc)) 58) - (setq msgs (cons buf msgs) - buf (concat (if (= flags 1) "SHIFT + " "") + (if (> (+ (length calc-z-prefix-buf) (length desc)) 58) + (setq calc-z-prefix-msgs + (cons calc-z-prefix-buf calc-z-prefix-msgs) + calc-z-prefix-buf (concat (if (= flags 1) "SHIFT + " "") desc)) - (setq buf (concat buf ", " desc)))))) + (setq calc-z-prefix-buf (concat calc-z-prefix-buf ", " desc)))))) (calc-user-function-list (cdr map) flags)))) @@ -2224,25 +2218,25 @@ calc-kill calc-kill-region calc-yank)))) (math-normalize (car a)) (error "Can't use multi-valued function in an expression"))))) -(defun math-normalize-nonstandard () ; uses "a" +(defun math-normalize-nonstandard () (if (consp calc-simplify-mode) (progn (setq calc-simplify-mode 'none - math-simplify-only (car-safe (cdr-safe a))) + math-simplify-only (car-safe (cdr-safe math-normalize-a))) nil) - (and (symbolp (car a)) + (and (symbolp (car math-normalize-a)) (or (eq calc-simplify-mode 'none) (and (eq calc-simplify-mode 'num) - (let ((aptr (setq a (cons - (car a) - (mapcar 'math-normalize (cdr a)))))) + (let ((aptr (setq math-normalize-a + (cons + (car math-normalize-a) + (mapcar 'math-normalize + (cdr math-normalize-a)))))) (while (and aptr (math-constp (car aptr))) (setq aptr (cdr aptr))) aptr))) - (cons (car a) (mapcar 'math-normalize (cdr a)))))) - - - + (cons (car math-normalize-a) + (mapcar 'math-normalize (cdr math-normalize-a)))))) ;;; Normalize a bignum digit list by trimming high-end zeros. [L l] @@ -2620,22 +2614,27 @@ calc-kill calc-kill-region calc-yank)))) (defvar var-FactorRules 'calc-FactorRules) -(defun math-map-tree (mmt-func mmt-expr &optional mmt-many) - (or mmt-many (setq mmt-many 1000000)) +(defvar math-mt-many nil) +(defvar math-mt-func nil) + +(defun math-map-tree (math-mt-func mmt-expr &optional math-mt-many) + (or math-mt-many (setq math-mt-many 1000000)) (math-map-tree-rec mmt-expr)) (defun math-map-tree-rec (mmt-expr) - (or (= mmt-many 0) + (or (= math-mt-many 0) (let ((mmt-done nil) mmt-nextval) (while (not mmt-done) - (while (and (/= mmt-many 0) - (setq mmt-nextval (funcall mmt-func mmt-expr)) + (while (and (/= math-mt-many 0) + (setq mmt-nextval (funcall math-mt-func mmt-expr)) (not (equal mmt-expr mmt-nextval))) (setq mmt-expr mmt-nextval - mmt-many (if (> mmt-many 0) (1- mmt-many) (1+ mmt-many)))) + math-mt-many (if (> math-mt-many 0) + (1- math-mt-many) + (1+ math-mt-many)))) (if (or (Math-primp mmt-expr) - (<= mmt-many 0)) + (<= math-mt-many 0)) (setq mmt-done t) (setq mmt-nextval (cons (car mmt-expr) (mapcar 'math-map-tree-rec @@ -2886,11 +2885,13 @@ calc-kill calc-kill-region calc-yank)))) ;;; Expression parsing. +(defvar math-expr-data) + (defun math-read-expr (exp-str) (let ((exp-pos 0) (exp-old-pos 0) (exp-keep-spaces nil) - exp-token exp-data) + exp-token math-expr-data) (while (setq exp-token (string-match "\\.\\.\\([^.]\\|.[^.]\\)" exp-str)) (setq exp-str (concat (substring exp-str 0 exp-token) "\\dots" (substring exp-str (+ exp-token 2))))) @@ -2914,8 +2915,8 @@ calc-kill calc-kill-region calc-yank)))) (defun math-read-string () - (let ((str (read-from-string (concat exp-data "\"")))) - (or (and (= (cdr str) (1+ (length exp-data))) + (let ((str (read-from-string (concat math-expr-data "\"")))) + (or (and (= (cdr str) (1+ (length math-expr-data))) (stringp (car str))) (throw 'syntax "Error in string constant")) (math-read-token) -- cgit v1.2.1 From dc78141338626ca255d34b58f0ec035c4a0d22c3 Mon Sep 17 00:00:00 2001 From: Jay Belanger Date: Tue, 9 Nov 2004 20:30:10 +0000 Subject: (math-normalize-a): New variable. (math-normalize): Use declared variable math-normalize-a. --- lisp/calc/calc.el | 123 ++++++++++++++++++++++++++++++------------------------ 1 file changed, 68 insertions(+), 55 deletions(-) (limited to 'lisp/calc') diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index 75e6d534e4e..6480b1960a5 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el @@ -2232,62 +2232,72 @@ See calc-keypad for details." (defvar math-eval-rules-cache) (defvar math-eval-rules-cache-other) ;;; Reduce an object to canonical (normalized) form. [O o; Z Z] [Public] -(defun math-normalize (a) + +(defvar math-normalize-a) +(defun math-normalize (math-normalize-a) (cond - ((not (consp a)) - (if (integerp a) - (if (or (>= a 1000000) (<= a -1000000)) - (math-bignum a) - a) - a)) - ((eq (car a) 'bigpos) - (if (eq (nth (1- (length a)) a) 0) - (let* ((last (setq a (copy-sequence a))) (digs a)) + ((not (consp math-normalize-a)) + (if (integerp math-normalize-a) + (if (or (>= math-normalize-a 1000000) (<= math-normalize-a -1000000)) + (math-bignum math-normalize-a) + math-normalize-a) + math-normalize-a)) + ((eq (car math-normalize-a) 'bigpos) + (if (eq (nth (1- (length math-normalize-a)) math-normalize-a) 0) + (let* ((last (setq math-normalize-a + (copy-sequence math-normalize-a))) (digs math-normalize-a)) (while (setq digs (cdr digs)) (or (eq (car digs) 0) (setq last digs))) (setcdr last nil))) - (if (cdr (cdr (cdr a))) - a + (if (cdr (cdr (cdr math-normalize-a))) + math-normalize-a (cond - ((cdr (cdr a)) (+ (nth 1 a) (* (nth 2 a) 1000))) - ((cdr a) (nth 1 a)) + ((cdr (cdr math-normalize-a)) (+ (nth 1 math-normalize-a) + (* (nth 2 math-normalize-a) 1000))) + ((cdr math-normalize-a) (nth 1 math-normalize-a)) (t 0)))) - ((eq (car a) 'bigneg) - (if (eq (nth (1- (length a)) a) 0) - (let* ((last (setq a (copy-sequence a))) (digs a)) + ((eq (car math-normalize-a) 'bigneg) + (if (eq (nth (1- (length math-normalize-a)) math-normalize-a) 0) + (let* ((last (setq math-normalize-a (copy-sequence math-normalize-a))) + (digs math-normalize-a)) (while (setq digs (cdr digs)) (or (eq (car digs) 0) (setq last digs))) (setcdr last nil))) - (if (cdr (cdr (cdr a))) - a + (if (cdr (cdr (cdr math-normalize-a))) + math-normalize-a (cond - ((cdr (cdr a)) (- (+ (nth 1 a) (* (nth 2 a) 1000)))) - ((cdr a) (- (nth 1 a))) + ((cdr (cdr math-normalize-a)) (- (+ (nth 1 math-normalize-a) + (* (nth 2 math-normalize-a) 1000)))) + ((cdr math-normalize-a) (- (nth 1 math-normalize-a))) (t 0)))) - ((eq (car a) 'float) - (math-make-float (math-normalize (nth 1 a)) (nth 2 a))) - ((or (memq (car a) '(frac cplx polar hms date mod sdev intv vec var quote - special-const calcFunc-if calcFunc-lambda - calcFunc-quote calcFunc-condition - calcFunc-evalto)) - (integerp (car a)) - (and (consp (car a)) (not (eq (car (car a)) 'lambda)))) + ((eq (car math-normalize-a) 'float) + (math-make-float (math-normalize (nth 1 math-normalize-a)) + (nth 2 math-normalize-a))) + ((or (memq (car math-normalize-a) + '(frac cplx polar hms date mod sdev intv vec var quote + special-const calcFunc-if calcFunc-lambda + calcFunc-quote calcFunc-condition + calcFunc-evalto)) + (integerp (car math-normalize-a)) + (and (consp (car math-normalize-a)) + (not (eq (car (car math-normalize-a)) 'lambda)))) (calc-extensions) - (math-normalize-fancy a)) + (math-normalize-fancy math-normalize-a)) (t (or (and calc-simplify-mode (calc-extensions) (math-normalize-nonstandard)) - (let ((args (mapcar 'math-normalize (cdr a)))) + (let ((args (mapcar 'math-normalize (cdr math-normalize-a)))) (or (condition-case err - (let ((func (assq (car a) '( ( + . math-add ) - ( - . math-sub ) - ( * . math-mul ) - ( / . math-div ) - ( % . math-mod ) - ( ^ . math-pow ) - ( neg . math-neg ) - ( | . math-concat ) )))) + (let ((func + (assq (car math-normalize-a) '( ( + . math-add ) + ( - . math-sub ) + ( * . math-mul ) + ( / . math-div ) + ( % . math-mod ) + ( ^ . math-pow ) + ( neg . math-neg ) + ( | . math-concat ) )))) (or (and var-EvalRules (progn (or (eq var-EvalRules math-eval-rules-cache-tag) @@ -2295,51 +2305,54 @@ See calc-keypad for details." (calc-extensions) (math-recompile-eval-rules))) (and (or math-eval-rules-cache-other - (assq (car a) math-eval-rules-cache)) + (assq (car math-normalize-a) + math-eval-rules-cache)) (math-apply-rewrites - (cons (car a) args) + (cons (car math-normalize-a) args) (cdr math-eval-rules-cache) nil math-eval-rules-cache)))) (if func (apply (cdr func) args) - (and (or (consp (car a)) - (fboundp (car a)) + (and (or (consp (car math-normalize-a)) + (fboundp (car math-normalize-a)) (and (not calc-extensions-loaded) (calc-extensions) - (fboundp (car a)))) - (apply (car a) args))))) + (fboundp (car math-normalize-a)))) + (apply (car math-normalize-a) args))))) (wrong-number-of-arguments (calc-record-why "*Wrong number of arguments" - (cons (car a) args)) + (cons (car math-normalize-a) args)) nil) (wrong-type-argument - (or calc-next-why (calc-record-why "Wrong type of argument" - (cons (car a) args))) + (or calc-next-why + (calc-record-why "Wrong type of argument" + (cons (car math-normalize-a) args))) nil) (args-out-of-range - (calc-record-why "*Argument out of range" (cons (car a) args)) + (calc-record-why "*Argument out of range" + (cons (car math-normalize-a) args)) nil) (inexact-result (calc-record-why "No exact representation for result" - (cons (car a) args)) + (cons (car math-normalize-a) args)) nil) (math-overflow (calc-record-why "*Floating-point overflow occurred" - (cons (car a) args)) + (cons (car math-normalize-a) args)) nil) (math-underflow (calc-record-why "*Floating-point underflow occurred" - (cons (car a) args)) + (cons (car math-normalize-a) args)) nil) (void-variable (if (eq (nth 1 err) 'var-EvalRules) (progn (setq var-EvalRules nil) - (math-normalize (cons (car a) args))) + (math-normalize (cons (car math-normalize-a) args))) (calc-record-why "*Variable is void" (nth 1 err))))) - (if (consp (car a)) + (if (consp (car math-normalize-a)) (math-dimension-error) - (cons (car a) args)))))))) + (cons (car math-normalize-a) args)))))))) -- cgit v1.2.1 From f7917133cb39354f3cb1e4b9ce768a10858fce6d Mon Sep 17 00:00:00 2001 From: Jay Belanger Date: Tue, 9 Nov 2004 20:30:40 +0000 Subject: (math-expand-form): Use declared variable math-mt-many. --- lisp/calc/calc-poly.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp/calc') diff --git a/lisp/calc/calc-poly.el b/lisp/calc/calc-poly.el index 213b7dc4474..6ede0888319 100644 --- a/lisp/calc/calc-poly.el +++ b/lisp/calc/calc-poly.el @@ -1040,7 +1040,7 @@ (memq (car-safe (nth 1 expr)) '(+ -)) (integerp (nth 2 expr)) (if (> (nth 2 expr) 0) - (or (and (or (> mmt-many 500000) (< mmt-many -500000)) + (or (and (or (> math-mt-many 500000) (< math-mt-many -500000)) (math-expand-power (nth 1 expr) (nth 2 expr) nil t)) (list '* -- cgit v1.2.1 From ce037856d4c8168dc5ec71bdbab9811aa8199d78 Mon Sep 17 00:00:00 2001 From: Jay Belanger Date: Tue, 9 Nov 2004 20:31:12 +0000 Subject: (math-rewrite, math-rewrite-phase): Use declared variable math-mt-many. (math-rewrite): Use declared variable math-mt-func. --- lisp/calc/calc-rewr.el | 40 ++++++++++++++++++++-------------------- 1 file changed, 20 insertions(+), 20 deletions(-) (limited to 'lisp/calc') diff --git a/lisp/calc/calc-rewr.el b/lisp/calc/calc-rewr.el index 47b48bd88d8..fd361bd3eee 100644 --- a/lisp/calc/calc-rewr.el +++ b/lisp/calc/calc-rewr.el @@ -166,7 +166,7 @@ -(defun math-rewrite (whole-expr rules &optional mmt-many) +(defun math-rewrite (whole-expr rules &optional math-mt-many) (let ((crules (math-compile-rewrites rules)) (heads (math-rewrite-heads whole-expr)) (trace-buffer (get-buffer "*Trace*")) @@ -176,20 +176,20 @@ (calc-line-numbering nil) (calc-show-selections t) (calc-why nil) - (mmt-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)))) - (save-excursion - (set-buffer trace-buffer) - (insert "\nrewrite to\n" fmt "\n")))) - (setq heads (math-rewrite-heads result heads t)))) - result))))) + (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)))) + (save-excursion + (set-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 whole-expr nil nil)))) (save-excursion @@ -197,22 +197,22 @@ (setq truncate-lines t) (goto-char (point-max)) (insert "\n\nBegin rewriting\n" fmt "\n")))) - (or mmt-many (setq mmt-many (or (nth 1 (car crules)) + (or math-mt-many (setq math-mt-many (or (nth 1 (car crules)) math-rewrite-default-iters))) - (if (equal mmt-many '(var inf var-inf)) (setq mmt-many 1000000)) - (if (equal mmt-many '(neg (var inf var-inf))) (setq mmt-many -1000000)) + (if (equal math-mt-many '(var inf var-inf)) (setq math-mt-many 1000000)) + (if (equal math-mt-many '(neg (var inf var-inf))) (setq math-mt-many -1000000)) (math-rewrite-phase (nth 3 (car crules))) (if trace-buffer (let ((fmt (math-format-stack-value (list whole-expr nil nil)))) (save-excursion (set-buffer trace-buffer) (insert "\nDone rewriting" - (if (= mmt-many 0) " (reached iteration limit)" "") + (if (= math-mt-many 0) " (reached iteration limit)" "") ":\n" fmt "\n")))) whole-expr)) (defun math-rewrite-phase (sched) - (while (and sched (/= mmt-many 0)) + (while (and sched (/= math-mt-many 0)) (if (listp (car sched)) (while (let ((save-expr whole-expr)) (math-rewrite-phase (car sched)) -- cgit v1.2.1 From 5c8a5f96c73fd16f8c215d1b26c71b5f4ee1cefe Mon Sep 17 00:00:00 2001 From: Jay Belanger Date: Tue, 9 Nov 2004 20:31:40 +0000 Subject: (math-read-brackets, math-read-vector, math-read-matrix): Use declared variable math-expr-data. --- lisp/calc/calc-vec.el | 44 ++++++++++++++++++++++---------------------- 1 file changed, 22 insertions(+), 22 deletions(-) (limited to 'lisp/calc') diff --git a/lisp/calc/calc-vec.el b/lisp/calc/calc-vec.el index 51d7450278e..c09d2715889 100644 --- a/lisp/calc/calc-vec.el +++ b/lisp/calc/calc-vec.el @@ -1468,7 +1468,7 @@ (math-read-token) (while (eq exp-token 'space) (math-read-token)) - (if (or (equal exp-data close) + (if (or (equal math-expr-data close) (eq exp-token 'end)) (progn (math-read-token) @@ -1476,10 +1476,10 @@ (let ((save-exp-pos exp-pos) (save-exp-old-pos exp-old-pos) (save-exp-token exp-token) - (save-exp-data exp-data) + (save-exp-data math-expr-data) (vals (let ((exp-keep-spaces space-sep)) - (if (or (equal exp-data "\\dots") - (equal exp-data "\\ldots")) + (if (or (equal math-expr-data "\\dots") + (equal math-expr-data "\\ldots")) '(vec (neg (var inf var-inf))) (catch 'syntax (math-read-vector)))))) (if (stringp vals) @@ -1490,12 +1490,12 @@ (setq exp-pos save-exp-pos exp-old-pos save-exp-old-pos exp-token save-exp-token - exp-data save-exp-data) + math-expr-data save-exp-data) (let ((exp-keep-spaces nil)) (setq vals2 (catch 'syntax (math-read-vector)))) (if (and (not (stringp vals2)) - (or (assoc exp-data '(("\\ldots") ("\\dots") (";"))) - (equal exp-data close) + (or (assoc math-expr-data '(("\\ldots") ("\\dots") (";"))) + (equal math-expr-data close) (eq exp-token 'end))) (setq space-sep nil vals vals2) @@ -1503,30 +1503,30 @@ exp-old-pos error-exp-old-pos) (throw 'syntax vals))) (throw 'syntax vals))) - (if (or (equal exp-data "\\dots") - (equal exp-data "\\ldots")) + (if (or (equal math-expr-data "\\dots") + (equal math-expr-data "\\ldots")) (progn (math-read-token) (setq vals (if (> (length vals) 2) (cons 'calcFunc-mul (cdr vals)) (nth 1 vals))) - (let ((exp2 (if (or (equal exp-data close) - (equal exp-data ")") + (let ((exp2 (if (or (equal math-expr-data close) + (equal math-expr-data ")") (eq exp-token 'end)) '(var inf var-inf) (math-read-expr-level 0)))) (setq vals (list 'intv - (if (equal exp-data ")") 2 3) + (if (equal math-expr-data ")") 2 3) vals exp2))) - (if (not (or (equal exp-data close) - (equal exp-data ")") + (if (not (or (equal math-expr-data close) + (equal math-expr-data ")") (eq exp-token 'end))) (throw 'syntax "Expected `]'"))) - (if (equal exp-data ";") + (if (equal math-expr-data ";") (let ((exp-keep-spaces space-sep)) (setq vals (cons 'vec (math-read-matrix (list vals)))))) - (if (not (or (equal exp-data close) + (if (not (or (equal math-expr-data close) (eq exp-token 'end))) (throw 'syntax "Expected `]'"))) (or (eq exp-token 'end) @@ -1556,11 +1556,11 @@ (while (eq exp-token 'space) (math-read-token)) (and (not (eq exp-token 'end)) - (not (equal exp-data ";")) - (not (equal exp-data close)) - (not (equal exp-data "\\dots")) - (not (equal exp-data "\\ldots")))) - (if (equal exp-data ",") + (not (equal math-expr-data ";")) + (not (equal math-expr-data close)) + (not (equal math-expr-data "\\dots")) + (not (equal math-expr-data "\\ldots")))) + (if (equal math-expr-data ",") (math-read-token)) (while (eq exp-token 'space) (math-read-token)) @@ -1570,7 +1570,7 @@ (cons 'vec val))) (defun math-read-matrix (mat) - (while (equal exp-data ";") + (while (equal math-expr-data ";") (math-read-token) (while (eq exp-token 'space) (math-read-token)) -- cgit v1.2.1 From 54961aa0cacb28bb28a71cec28e92cc5fb0b1761 Mon Sep 17 00:00:00 2001 From: Jay Belanger Date: Tue, 9 Nov 2004 20:32:13 +0000 Subject: (math-parse-fortran-vector, math-parse-fortran-vector-end, math-parse-tex-sum, math-parse-eqn-matrix, math-parse-eqn-prime, math-read-math-subscr): Use declared variable math-expr-data. --- lisp/calc/calc-lang.el | 28 ++++++++++++++-------------- 1 file changed, 14 insertions(+), 14 deletions(-) (limited to 'lisp/calc') diff --git a/lisp/calc/calc-lang.el b/lisp/calc/calc-lang.el index bb6699a4ac9..93935f14406 100644 --- a/lisp/calc/calc-lang.el +++ b/lisp/calc/calc-lang.el @@ -264,14 +264,14 @@ (prog1 (math-read-brackets t "]") (setq exp-token (car math-parsing-fortran-vector) - exp-data (cdr math-parsing-fortran-vector))))) + math-expr-data (cdr math-parsing-fortran-vector))))) (defun math-parse-fortran-vector-end (x op) (if math-parsing-fortran-vector (progn - (setq math-parsing-fortran-vector (cons exp-token exp-data) + (setq math-parsing-fortran-vector (cons exp-token math-expr-data) exp-token 'end - exp-data "\000") + math-expr-data "\000") x) (throw 'syntax "Unmatched closing `/'"))) @@ -384,7 +384,7 @@ (defun math-parse-tex-sum (f val) (let (low high save) - (or (equal exp-data "_") (throw 'syntax "Expected `_'")) + (or (equal math-expr-data "_") (throw 'syntax "Expected `_'")) (math-read-token) (setq save exp-old-pos) (setq low (math-read-factor)) @@ -392,7 +392,7 @@ (progn (setq exp-old-pos (1+ save)) (throw 'syntax "Expected equation"))) - (or (equal exp-data "^") (throw 'syntax "Expected `^'")) + (or (equal math-expr-data "^") (throw 'syntax "Expected `^'")) (math-read-token) (setq high (math-read-factor)) (list (nth 2 f) (math-read-factor) (nth 1 low) (nth 2 low) high))) @@ -484,30 +484,30 @@ (defun math-parse-eqn-matrix (f sym) (let ((vec nil)) - (while (assoc exp-data '(("ccol") ("lcol") ("rcol"))) + (while (assoc math-expr-data '(("ccol") ("lcol") ("rcol"))) (math-read-token) - (or (equal exp-data calc-function-open) + (or (equal math-expr-data calc-function-open) (throw 'syntax "Expected `{'")) (math-read-token) (setq vec (cons (cons 'vec (math-read-expr-list)) vec)) - (or (equal exp-data calc-function-close) + (or (equal math-expr-data calc-function-close) (throw 'syntax "Expected `}'")) (math-read-token)) - (or (equal exp-data calc-function-close) + (or (equal math-expr-data calc-function-close) (throw 'syntax "Expected `}'")) (math-read-token) (math-transpose (cons 'vec (nreverse vec))))) (defun math-parse-eqn-prime (x sym) (if (eq (car-safe x) 'var) - (if (equal exp-data calc-function-open) + (if (equal math-expr-data calc-function-open) (progn (math-read-token) - (let ((args (if (or (equal exp-data calc-function-close) + (let ((args (if (or (equal math-expr-data calc-function-close) (eq exp-token 'end)) nil (math-read-expr-list)))) - (if (not (or (equal exp-data calc-function-close) + (if (not (or (equal math-expr-data calc-function-close) (eq exp-token 'end))) (throw 'syntax "Expected `)'")) (math-read-token) @@ -622,10 +622,10 @@ (defun math-read-math-subscr (x op) (let ((idx (math-read-expr-level 0))) - (or (and (equal exp-data "]") + (or (and (equal math-expr-data "]") (progn (math-read-token) - (equal exp-data "]"))) + (equal math-expr-data "]"))) (throw 'syntax "Expected ']]'")) (math-read-token) (list 'calcFunc-subscr x idx))) -- cgit v1.2.1 From abd880c33ecde1e4549934094b6b645ffadf89e2 Mon Sep 17 00:00:00 2001 From: Jay Belanger Date: Tue, 9 Nov 2004 20:32:37 +0000 Subject: (math-read-exprs, math-read-expr-list, math-read-expr-level, math-read-token, calc-check-user-syntax, calc-match-user-syntax, math-read-if, math-factor-after, math-read-factor): Use declared variable math-expr-data. --- lisp/calc/calc-aent.el | 162 ++++++++++++++++++++++++------------------------- 1 file changed, 81 insertions(+), 81 deletions(-) (limited to 'lisp/calc') diff --git a/lisp/calc/calc-aent.el b/lisp/calc/calc-aent.el index 2db722ccb2d..fef561742dc 100644 --- a/lisp/calc/calc-aent.el +++ b/lisp/calc/calc-aent.el @@ -464,7 +464,7 @@ (let ((exp-pos 0) (exp-old-pos 0) (exp-keep-spaces nil) - exp-token exp-data) + exp-token math-expr-data) (if calc-language-input-filter (setq exp-str (funcall calc-language-input-filter exp-str))) (while (setq exp-token (string-match "\\.\\.\\([^.]\\|.[^.]\\)" exp-str)) @@ -483,7 +483,7 @@ (let* ((exp-keep-spaces nil) (val (list (math-read-expr-level 0))) (last val)) - (while (equal exp-data ",") + (while (equal math-expr-data ",") (math-read-token) (let ((rest (list (math-read-expr-level 0)))) (setcdr last rest) @@ -545,21 +545,21 @@ (if (>= exp-pos (length exp-str)) (setq exp-old-pos exp-pos exp-token 'end - exp-data "\000") + math-expr-data "\000") (let ((ch (aref exp-str exp-pos))) (setq exp-old-pos exp-pos) (cond ((memq ch '(32 10 9)) (setq exp-pos (1+ exp-pos)) (if exp-keep-spaces (setq exp-token 'space - exp-data " ") + math-expr-data " ") (math-read-token))) ((and (memq ch calc-user-token-chars) (let ((case-fold-search nil)) (eq (string-match calc-user-tokens exp-str exp-pos) exp-pos))) (setq exp-token 'punc - exp-data (math-match-substring exp-str 0) + math-expr-data (math-match-substring exp-str 0) exp-pos (match-end 0))) ((or (and (>= ch ?a) (<= ch ?z)) (and (>= ch ?A) (<= ch ?Z))) @@ -569,21 +569,21 @@ exp-str exp-pos) (setq exp-token 'symbol exp-pos (match-end 0) - exp-data (math-restore-dashes + math-expr-data (math-restore-dashes (math-match-substring exp-str 0))) (if (eq calc-language 'eqn) - (let ((code (assoc exp-data math-eqn-ignore-words))) + (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 exp-data (cdr code)) - (setq exp-data (format "%s %s" - (car code) exp-data)))) + (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 exp-token 'punc - exp-data (nth 2 code))) + math-expr-data (nth 2 code))) (t (math-read-token) (math-read-token)))))) @@ -602,7 +602,7 @@ (string-match "0[xX][0-9a-fA-F]+" exp-str exp-pos)) (string-match "_?\\([0-9]+.?0*@ *\\)?\\([0-9]+.?0*' *\\)?\\(0*\\([2-9]\\|1[0-4]\\)\\(#\\|\\^\\^\\)[0-9a-dA-D.]+[eE][-+_]?[0-9]+\\|0*\\([2-9]\\|[0-2][0-9]\\|3[0-6]\\)\\(#\\|\\^\\^\\)[0-9a-zA-Z:.]+\\|[0-9]+:[0-9:]+\\|[0-9.]+\\([eE][-+_]?[0-9]+\\)?\"?\\)?" exp-str exp-pos)) (setq exp-token 'number - exp-data (math-match-substring exp-str 0) + math-expr-data (math-match-substring exp-str 0) exp-pos (match-end 0))) ((eq ch ?\$) (if (and (eq calc-language 'pascal) @@ -611,30 +611,30 @@ exp-str exp-pos) exp-pos)) (setq exp-token 'number - exp-data (math-match-substring exp-str 1) + math-expr-data (math-match-substring exp-str 1) exp-pos (match-end 1)) (if (eq (string-match "\\$\\([1-9][0-9]*\\)" exp-str exp-pos) exp-pos) - (setq exp-data (- (string-to-int (math-match-substring + (setq math-expr-data (- (string-to-int (math-match-substring exp-str 1)))) (string-match "\\$+" exp-str exp-pos) - (setq exp-data (- (match-end 0) (match-beginning 0)))) + (setq math-expr-data (- (match-end 0) (match-beginning 0)))) (setq exp-token 'dollar exp-pos (match-end 0)))) ((eq ch ?\#) (if (eq (string-match "#\\([1-9][0-9]*\\)" exp-str exp-pos) exp-pos) - (setq exp-data (string-to-int + (setq math-expr-data (string-to-int (math-match-substring exp-str 1)) exp-pos (match-end 0)) - (setq exp-data 1 + (setq math-expr-data 1 exp-pos (1+ exp-pos))) (setq exp-token 'hash)) ((eq (string-match "~=\\|<=\\|>=\\|<>\\|/=\\|\\+/-\\|\\\\dots\\|\\\\ldots\\|\\*\\*\\|<<\\|>>\\|==\\|!=\\|&&&\\||||\\|!!!\\|&&\\|||\\|!!\\|:=\\|::\\|=>" exp-str exp-pos) exp-pos) (setq exp-token 'punc - exp-data (math-match-substring exp-str 0) + math-expr-data (math-match-substring exp-str 0) exp-pos (match-end 0))) ((and (eq ch ?\") (string-match "\\(\"\\([^\"\\]\\|\\\\.\\)*\\)\\(\"\\|\\'\\)" exp-str exp-pos)) @@ -646,7 +646,7 @@ (aset exp-str (match-end 1) ?\})) (math-read-token)) (setq exp-token 'string - exp-data (math-match-substring exp-str 1) + math-expr-data (math-match-substring exp-str 1) exp-pos (match-end 0)))) ((and (= ch ?\\) (eq calc-language 'tex) (< exp-pos (1- (length exp-str)))) @@ -654,20 +654,20 @@ (string-match "\\(\\\\\\([a-zA-Z]+\\|[^a-zA-Z]\\)\\)" exp-str exp-pos)) (setq exp-token 'symbol exp-pos (match-end 0) - exp-data (math-restore-dashes + math-expr-data (math-restore-dashes (math-match-substring exp-str 1))) - (let ((code (assoc exp-data math-tex-ignore-words))) + (let ((code (assoc math-expr-data math-tex-ignore-words))) (cond ((null code)) ((null (cdr code)) (math-read-token)) ((eq (nth 1 code) 'punc) (setq exp-token 'punc - exp-data (nth 2 code))) + math-expr-data (nth 2 code))) ((and (eq (nth 1 code) 'mat) (string-match " *{" exp-str exp-pos)) (setq exp-pos (match-end 0) exp-token 'punc - exp-data "[") + math-expr-data "[") (let ((right (string-match "}" exp-str exp-pos))) (and right (setq exp-str (copy-sequence exp-str)) @@ -676,24 +676,24 @@ (eq (string-match "\\.[a-zA-Z][a-zA-Z][a-zA-Z]?\\." exp-str exp-pos) exp-pos)) (setq exp-token 'punc - exp-data (upcase (math-match-substring exp-str 0)) + math-expr-data (upcase (math-match-substring exp-str 0)) exp-pos (match-end 0))) ((and (eq calc-language 'math) (eq (string-match "\\[\\[\\|->\\|:>" exp-str exp-pos) exp-pos)) (setq exp-token 'punc - exp-data (math-match-substring exp-str 0) + math-expr-data (math-match-substring exp-str 0) exp-pos (match-end 0))) ((and (eq calc-language 'eqn) (eq (string-match "->\\|<-\\|+-\\|\\\\dots\\|~\\|\\^" exp-str exp-pos) exp-pos)) (setq exp-token 'punc - exp-data (math-match-substring exp-str 0) + math-expr-data (math-match-substring exp-str 0) exp-pos (match-end 0)) (and (eq (string-match "\\\\dots\\." exp-str exp-pos) exp-pos) (setq exp-pos (match-end 0))) - (if (memq (aref exp-data 0) '(?~ ?^)) + (if (memq (aref math-expr-data 0) '(?~ ?^)) (math-read-token))) ((eq (string-match "%%.*$" exp-str exp-pos) exp-pos) (setq exp-pos (match-end 0)) @@ -706,7 +706,7 @@ (if (and (eq ch ?\&) (eq calc-language 'tex)) (setq ch ?\,)) (setq exp-token 'punc - exp-data (char-to-string ch) + math-expr-data (char-to-string ch) exp-pos (1+ exp-pos))))))) @@ -716,10 +716,10 @@ (setq op (calc-check-user-syntax x exp-prec)) (setq x op op '("2x" ident 999999 -1))) - (and (setq op (assoc exp-data math-expr-opers)) + (and (setq op (assoc math-expr-data math-expr-opers)) (/= (nth 2 op) -1) (or (and (setq op2 (assoc - exp-data + math-expr-data (cdr (memq op math-expr-opers)))) (eq (= (nth 3 op) -1) (/= (nth 3 op2) -1)) @@ -729,12 +729,12 @@ t)) (and (or (eq (nth 2 op) -1) (memq exp-token '(symbol number dollar hash)) - (equal exp-data "(") - (and (equal exp-data "[") + (equal math-expr-data "(") + (and (equal math-expr-data "[") (not (eq calc-language 'math)) (not (and exp-keep-spaces (eq (car-safe x) 'vec))))) - (or (not (setq op (assoc exp-data math-expr-opers))) + (or (not (setq op (assoc math-expr-data math-expr-opers))) (/= (nth 2 op) -1)) (or (not calc-user-parse-table) (not (eq exp-token 'symbol)) @@ -744,11 +744,11 @@ (car (car (car p))))) (not (equal (nth 1 (car (car p))) - exp-data)))) + math-expr-data)))) (setq p (cdr p))) (not p))) (setq op (assoc "2x" math-expr-opers)))) - (not (and exp-term (equal exp-data exp-term))) + (not (and exp-term (equal math-expr-data exp-term))) (>= (nth 2 op) exp-prec)) (if (not (equal (car op) "2x")) (math-read-token)) @@ -787,13 +787,13 @@ (if x (and (integerp (car rule)) (>= (car rule) prec) - (equal exp-data + (equal math-expr-data (car (setq rule (cdr rule))))) - (equal exp-data (car rule))))) + (equal math-expr-data (car rule))))) (let ((save-exp-pos exp-pos) (save-exp-old-pos exp-old-pos) (save-exp-token exp-token) - (save-exp-data exp-data)) + (save-exp-data math-expr-data)) (or (not (listp (setq matches (calc-match-user-syntax rule)))) (let ((args (progn @@ -858,7 +858,7 @@ match args matches))) (setq exp-old-pos save-exp-old-pos exp-token save-exp-token - exp-data save-exp-data + math-expr-data save-exp-data exp-pos save-exp-pos))))))) (setq p (cdr p))) (and p match))) @@ -868,10 +868,10 @@ (save-exp-pos exp-pos) (save-exp-old-pos exp-old-pos) (save-exp-token exp-token) - (save-exp-data exp-data)) + (save-exp-data math-expr-data)) (while (and p (cond ((stringp (car p)) - (and (equal exp-data (car p)) + (and (equal math-expr-data (car p)) (progn (math-read-token) t))) @@ -918,7 +918,7 @@ (setq exp-pos save-exp-pos exp-old-pos save-exp-old-pos exp-token save-exp-token - exp-data save-exp-data + math-expr-data save-exp-data matches "Failed")) matches)) @@ -940,25 +940,25 @@ (defun math-read-if (cond op) (let ((then (math-read-expr-level 0))) - (or (equal exp-data ":") + (or (equal math-expr-data ":") (throw 'syntax "Expected ':'")) (math-read-token) (list 'calcFunc-if cond then (math-read-expr-level (nth 3 op))))) (defun math-factor-after () (let ((exp-pos exp-pos) - exp-old-pos exp-token exp-data) + exp-old-pos exp-token math-expr-data) (math-read-token) (or (memq exp-token '(number symbol dollar hash string)) - (and (assoc exp-data '(("-") ("+") ("!") ("|") ("/"))) - (assoc (concat "u" exp-data) math-expr-opers)) - (eq (nth 2 (assoc exp-data math-expr-opers)) -1) - (assoc exp-data '(("(") ("[") ("{")))))) + (and (assoc math-expr-data '(("-") ("+") ("!") ("|") ("/"))) + (assoc (concat "u" math-expr-data) math-expr-opers)) + (eq (nth 2 (assoc math-expr-data math-expr-opers)) -1) + (assoc math-expr-data '(("(") ("[") ("{")))))) (defun math-read-factor () (let (op) (cond ((eq exp-token 'number) - (let ((num (math-read-number exp-data))) + (let ((num (math-read-number math-expr-data))) (if (not num) (progn (setq exp-old-pos exp-pos) @@ -971,14 +971,14 @@ ((and calc-user-parse-table (setq op (calc-check-user-syntax))) op) - ((or (equal exp-data "-") - (equal exp-data "+") - (equal exp-data "!") - (equal exp-data "|") - (equal exp-data "/")) - (setq exp-data (concat "u" exp-data)) + ((or (equal math-expr-data "-") + (equal math-expr-data "+") + (equal math-expr-data "!") + (equal math-expr-data "|") + (equal math-expr-data "/")) + (setq math-expr-data (concat "u" math-expr-data)) (math-read-factor)) - ((and (setq op (assoc exp-data math-expr-opers)) + ((and (setq op (assoc math-expr-data math-expr-opers)) (eq (nth 2 op) -1)) (if (consp (nth 1 op)) (funcall (car (nth 1 op)) op) @@ -991,18 +991,18 @@ (math-neg val)) (t (list (nth 1 op) val)))))) ((eq exp-token 'symbol) - (let ((sym (intern exp-data))) + (let ((sym (intern math-expr-data))) (math-read-token) - (if (equal exp-data calc-function-open) + (if (equal math-expr-data calc-function-open) (let ((f (assq sym math-expr-function-mapping))) (math-read-token) (if (consp (cdr f)) (funcall (car (cdr f)) f sym) - (let ((args (if (or (equal exp-data calc-function-close) + (let ((args (if (or (equal math-expr-data calc-function-close) (eq exp-token 'end)) nil (math-read-expr-list)))) - (if (not (or (equal exp-data calc-function-close) + (if (not (or (equal math-expr-data calc-function-close) (eq exp-token 'end))) (throw 'syntax "Expected `)'")) (math-read-token) @@ -1045,18 +1045,18 @@ 4)) (cdr v)))))) (while (and (memq calc-language '(c pascal maple)) - (equal exp-data "[")) + (equal math-expr-data "[")) (math-read-token) (setq val (append (list 'calcFunc-subscr val) (math-read-expr-list))) - (if (equal exp-data "]") + (if (equal math-expr-data "]") (math-read-token) (throw 'syntax "Expected ']'"))) val))))) ((eq exp-token 'dollar) - (let ((abs (if (> exp-data 0) exp-data (- exp-data)))) + (let ((abs (if (> math-expr-data 0) math-expr-data (- math-expr-data)))) (if (>= (length calc-dollar-values) abs) - (let ((num exp-data)) + (let ((num math-expr-data)) (math-read-token) (setq calc-dollar-used (max calc-dollar-used num)) (math-check-complete (nth (1- abs) calc-dollar-values))) @@ -1067,22 +1067,22 @@ (or calc-hashes-used (throw 'syntax "#'s not allowed in this context")) (calc-extensions) - (if (<= exp-data (length calc-arg-values)) - (let ((num exp-data)) + (if (<= math-expr-data (length calc-arg-values)) + (let ((num math-expr-data)) (math-read-token) (setq calc-hashes-used (max calc-hashes-used num)) (nth (1- num) calc-arg-values)) (throw 'syntax "Too many # arguments"))) - ((equal exp-data "(") + ((equal math-expr-data "(") (let* ((exp (let ((exp-keep-spaces nil)) (math-read-token) - (if (or (equal exp-data "\\dots") - (equal exp-data "\\ldots")) + (if (or (equal math-expr-data "\\dots") + (equal math-expr-data "\\ldots")) '(neg (var inf var-inf)) (math-read-expr-level 0))))) (let ((exp-keep-spaces nil)) (cond - ((equal exp-data ",") + ((equal math-expr-data ",") (progn (math-read-token) (let ((exp2 (math-read-expr-level 0))) @@ -1090,7 +1090,7 @@ (if (and exp2 (Math-realp exp) (Math-realp exp2)) (math-normalize (list 'cplx exp exp2)) (list '+ exp (list '* exp2 '(var i var-i)))))))) - ((equal exp-data ";") + ((equal math-expr-data ";") (progn (math-read-token) (let ((exp2 (math-read-expr-level 0))) @@ -1103,22 +1103,22 @@ (list '* (math-to-radians-2 exp2) '(var i var-i))))))))) - ((or (equal exp-data "\\dots") - (equal exp-data "\\ldots")) + ((or (equal math-expr-data "\\dots") + (equal math-expr-data "\\ldots")) (progn (math-read-token) - (let ((exp2 (if (or (equal exp-data ")") - (equal exp-data "]") + (let ((exp2 (if (or (equal math-expr-data ")") + (equal math-expr-data "]") (eq exp-token 'end)) '(var inf var-inf) (math-read-expr-level 0)))) (setq exp (list 'intv - (if (equal exp-data ")") 0 1) + (if (equal math-expr-data ")") 0 1) exp exp2))))))) - (if (not (or (equal exp-data ")") - (and (equal exp-data "]") (eq (car-safe exp) 'intv)) + (if (not (or (equal math-expr-data ")") + (and (equal math-expr-data "]") (eq (car-safe exp) 'intv)) (eq exp-token 'end))) (throw 'syntax "Expected `)'")) (math-read-token) @@ -1126,13 +1126,13 @@ ((eq exp-token 'string) (calc-extensions) (math-read-string)) - ((equal exp-data "[") + ((equal math-expr-data "[") (calc-extensions) (math-read-brackets t "]")) - ((equal exp-data "{") + ((equal math-expr-data "{") (calc-extensions) (math-read-brackets nil "}")) - ((equal exp-data "<") + ((equal math-expr-data "<") (calc-extensions) (math-read-angle-brackets)) (t (throw 'syntax "Expected a number"))))) -- cgit v1.2.1 From 3cedbf72177e9126af44caa02be0ccd27a5cd6bc Mon Sep 17 00:00:00 2001 From: Jay Belanger Date: Thu, 11 Nov 2004 05:48:50 +0000 Subject: (calc-do-quick-calc): Use kill-new to append string to kill-ring. (calc-alg-exp, math-toks, math-exp-pos,math-exp-old-pos) (math-exp-token, math-exp-keep-spaces, math-exp-str): New variables. (calc-do-alg-entry, calcAlg-equals, calcAlg-edit, calcAlg-enter): Use declared variable calc-alg-exp. (math-build-parse-table, math-find-user-token): Use declared variable math-toks. (math-read-exprs, math-read-token, calc-check-user-syntax, calc-match-user-syntax, match-factor-after, math-read-factor): Use declared variables math-exp-pos math-exp-old-pos. (math-read-exprs, math-read-token, math-read-expr-level) (calc-check-user-syntax, calc-match-user-syntax, match-factor-after) (math-read-factor): Use declared variable math-exp-token. (math-read-exprs, math-read-expr-list, math-read-token, math-read-factor): Use declared variable math-exp-keep-spaces. (math-read-exprs, math-read-token): Use declared variable math-exp-str. (calc-match-user-syntax): Made m a local variable. --- lisp/calc/calc-aent.el | 335 ++++++++++++++++++++++++++----------------------- 1 file changed, 177 insertions(+), 158 deletions(-) (limited to 'lisp/calc') diff --git a/lisp/calc/calc-aent.el b/lisp/calc/calc-aent.el index fef561742dc..182b3b0635c 100644 --- a/lisp/calc/calc-aent.el +++ b/lisp/calc/calc-aent.el @@ -101,10 +101,7 @@ (message "Result: %s" buf))) (if (eq last-command-char 10) (insert shortbuf) - (setq kill-ring (cons shortbuf kill-ring)) - (when (> (length kill-ring) kill-ring-max) - (setcdr (nthcdr (1- kill-ring-max) kill-ring) nil)) - (setq kill-ring-yank-pointer kill-ring))))) + (kill-new shortbuf))))) (defun calc-do-calc-eval (str separator args) (calc-check-defines) @@ -301,10 +298,12 @@ (defvar calc-alg-ent-esc-map nil "The keymap used for escapes in algebraic entry.") +(defvar calc-alg-exp) + (defun calc-do-alg-entry (&optional initial prompt no-normalize) (let* ((calc-buffer (current-buffer)) (blink-paren-function 'calcAlg-blink-matching-open) - (alg-exp 'error)) + (calc-alg-exp 'error)) (unless calc-alg-ent-map (setq calc-alg-ent-map (copy-keymap minibuffer-local-map)) (define-key calc-alg-ent-map "'" 'calcAlg-previous) @@ -328,13 +327,13 @@ (let ((buf (read-from-minibuffer (or prompt "Algebraic: ") (or initial "") calc-alg-ent-map nil))) - (when (eq alg-exp 'error) - (when (eq (car-safe (setq alg-exp (math-read-exprs buf))) 'error) - (setq alg-exp nil))) + (when (eq calc-alg-exp 'error) + (when (eq (car-safe (setq calc-alg-exp (math-read-exprs buf))) 'error) + (setq calc-alg-exp nil))) (setq calc-aborted-prefix "alg'") (or no-normalize - (and alg-exp (setq alg-exp (mapcar 'calc-normalize alg-exp)))) - alg-exp))) + (and calc-alg-exp (setq calc-alg-exp (mapcar 'calc-normalize calc-alg-exp)))) + calc-alg-exp))) (defun calcAlg-plus-minus () (interactive) @@ -364,8 +363,8 @@ (interactive) (unwind-protect (calcAlg-enter) - (if (consp alg-exp) - (progn (setq prefix-arg (length alg-exp)) + (if (consp calc-alg-exp) + (progn (setq prefix-arg (length calc-alg-exp)) (calc-unread-command ?=))))) (defun calcAlg-escape () @@ -383,8 +382,8 @@ (calc-minibuffer-contains "\\`\\([^\"]*\"[^\"]*\"\\)*[^\"]*\"[^\"]*\\'")) (insert "`") - (setq alg-exp (minibuffer-contents)) - (and (> (length alg-exp) 0) (setq calc-previous-alg-entry alg-exp)) + (setq calc-alg-exp (minibuffer-contents)) + (and (> (length calc-alg-exp) 0) (setq calc-previous-alg-entry calc-alg-exp)) (exit-minibuffer))) (defun calcAlg-enter () @@ -402,7 +401,7 @@ (calc-temp-minibuffer-message (concat " [" (or (nth 2 exp) "Error") "]")) (calc-clear-unread-commands)) - (setq alg-exp (if (calc-minibuffer-contains "\\` *\\[ *\\'") + (setq calc-alg-exp (if (calc-minibuffer-contains "\\` *\\[ *\\'") '((incomplete vec)) exp)) (and (> (length str) 0) (setq calc-previous-alg-entry str)) @@ -460,27 +459,36 @@ ;;; Algebraic expression parsing. [Public] -(defun math-read-exprs (exp-str) - (let ((exp-pos 0) - (exp-old-pos 0) - (exp-keep-spaces nil) - exp-token math-expr-data) +;;; The next few variables are local to math-read-exprs (and math-read-expr) +;;; but are set in functions they call. + +(defvar math-exp-pos) +(defvar math-exp-str) +(defvar math-exp-old-pos) +(defvar math-exp-token) +(defvar math-exp-keep-spaces) + +(defun math-read-exprs (math-exp-str) + (let ((math-exp-pos 0) + (math-exp-old-pos 0) + (math-exp-keep-spaces nil) + math-exp-token math-expr-data) (if calc-language-input-filter - (setq exp-str (funcall calc-language-input-filter exp-str))) - (while (setq exp-token (string-match "\\.\\.\\([^.]\\|.[^.]\\)" exp-str)) - (setq exp-str (concat (substring exp-str 0 exp-token) "\\dots" - (substring exp-str (+ exp-token 2))))) + (setq math-exp-str (funcall calc-language-input-filter math-exp-str))) + (while (setq math-exp-token (string-match "\\.\\.\\([^.]\\|.[^.]\\)" math-exp-str)) + (setq math-exp-str (concat (substring math-exp-str 0 math-exp-token) "\\dots" + (substring math-exp-str (+ math-exp-token 2))))) (math-build-parse-table) (math-read-token) (let ((val (catch 'syntax (math-read-expr-list)))) (if (stringp val) - (list 'error exp-old-pos val) - (if (equal exp-token 'end) + (list 'error math-exp-old-pos val) + (if (equal math-exp-token 'end) val - (list 'error exp-old-pos "Syntax error")))))) + (list 'error math-exp-old-pos "Syntax error")))))) (defun math-read-expr-list () - (let* ((exp-keep-spaces nil) + (let* ((math-exp-keep-spaces nil) (val (list (math-read-expr-level 0))) (last val)) (while (equal math-expr-data ",") @@ -496,20 +504,23 @@ (defvar calc-user-tokens nil) (defvar calc-user-token-chars nil) +(defvar math-toks nil + "Tokens to pass between math-build-parse-table and math-find-user-tokens.") + (defun math-build-parse-table () (let ((mtab (cdr (assq nil calc-user-parse-tables))) (ltab (cdr (assq calc-language calc-user-parse-tables)))) (or (and (eq mtab calc-last-main-parse-table) (eq ltab calc-last-lang-parse-table)) (let ((p (append mtab ltab)) - (toks nil)) + (math-toks nil)) (setq calc-user-parse-table p) (setq calc-user-token-chars nil) (while p (math-find-user-tokens (car (car p))) (setq p (cdr p))) (setq calc-user-tokens (mapconcat 'identity - (sort (mapcar 'car toks) + (sort (mapcar 'car math-toks) (function (lambda (x y) (> (length x) (length y))))) @@ -517,7 +528,7 @@ calc-last-main-parse-table mtab calc-last-lang-parse-table ltab))))) -(defun math-find-user-tokens (p) ; uses "toks" +(defun math-find-user-tokens (p) (while p (cond ((and (stringp (car p)) (or (> (length (car p)) 1) (equal (car p) "$") @@ -528,9 +539,9 @@ (setq s (concat "\\<" s))) (if (string-match "[a-zA-Z0-9]\\'" s) (setq s (concat s "\\>"))) - (or (assoc s toks) + (or (assoc s math-toks) (progn - (setq toks (cons (list s) toks)) + (setq math-toks (cons (list s) math-toks)) (or (memq (aref (car p) 0) calc-user-token-chars) (setq calc-user-token-chars (cons (aref (car p) 0) @@ -542,35 +553,35 @@ (setq p (cdr p)))) (defun math-read-token () - (if (>= exp-pos (length exp-str)) - (setq exp-old-pos exp-pos - exp-token 'end + (if (>= math-exp-pos (length math-exp-str)) + (setq math-exp-old-pos math-exp-pos + math-exp-token 'end math-expr-data "\000") - (let ((ch (aref exp-str exp-pos))) - (setq exp-old-pos exp-pos) + (let ((ch (aref math-exp-str math-exp-pos))) + (setq math-exp-old-pos math-exp-pos) (cond ((memq ch '(32 10 9)) - (setq exp-pos (1+ exp-pos)) - (if exp-keep-spaces - (setq exp-token 'space + (setq math-exp-pos (1+ math-exp-pos)) + (if math-exp-keep-spaces + (setq math-exp-token 'space math-expr-data " ") (math-read-token))) ((and (memq ch calc-user-token-chars) (let ((case-fold-search nil)) - (eq (string-match calc-user-tokens exp-str exp-pos) - exp-pos))) - (setq exp-token 'punc - math-expr-data (math-match-substring exp-str 0) - exp-pos (match-end 0))) + (eq (string-match calc-user-tokens math-exp-str math-exp-pos) + math-exp-pos))) + (setq math-exp-token 'punc + math-expr-data (math-match-substring math-exp-str 0) + math-exp-pos (match-end 0))) ((or (and (>= ch ?a) (<= ch ?z)) (and (>= ch ?A) (<= ch ?Z))) (string-match (if (memq calc-language '(c fortran pascal maple)) "[a-zA-Z0-9_#]*" "[a-zA-Z0-9'#]*") - exp-str exp-pos) - (setq exp-token 'symbol - exp-pos (match-end 0) + math-exp-str math-exp-pos) + (setq math-exp-token 'symbol + math-exp-pos (match-end 0) math-expr-data (math-restore-dashes - (math-match-substring exp-str 0))) + (math-match-substring math-exp-str 0))) (if (eq calc-language 'eqn) (let ((code (assoc math-expr-data math-eqn-ignore-words))) (cond ((null code)) @@ -582,121 +593,128 @@ (setq math-expr-data (format "%s %s" (car code) math-expr-data)))) ((eq (nth 1 code) 'punc) - (setq exp-token 'punc + (setq math-exp-token 'punc math-expr-data (nth 2 code))) (t (math-read-token) (math-read-token)))))) ((or (and (>= ch ?0) (<= ch ?9)) (and (eq ch '?\.) - (eq (string-match "\\.[0-9]" exp-str exp-pos) exp-pos)) + (eq (string-match "\\.[0-9]" math-exp-str math-exp-pos) + math-exp-pos)) (and (eq ch '?_) - (eq (string-match "_\\.?[0-9]" exp-str exp-pos) exp-pos) - (or (eq exp-pos 0) + (eq (string-match "_\\.?[0-9]" math-exp-str math-exp-pos) + math-exp-pos) + (or (eq math-exp-pos 0) (and (memq calc-language '(nil flat big unform tex eqn)) (eq (string-match "[^])}\"a-zA-Z0-9'$]_" - exp-str (1- exp-pos)) - (1- exp-pos)))))) + math-exp-str (1- math-exp-pos)) + (1- math-exp-pos)))))) (or (and (eq calc-language 'c) - (string-match "0[xX][0-9a-fA-F]+" exp-str exp-pos)) - (string-match "_?\\([0-9]+.?0*@ *\\)?\\([0-9]+.?0*' *\\)?\\(0*\\([2-9]\\|1[0-4]\\)\\(#\\|\\^\\^\\)[0-9a-dA-D.]+[eE][-+_]?[0-9]+\\|0*\\([2-9]\\|[0-2][0-9]\\|3[0-6]\\)\\(#\\|\\^\\^\\)[0-9a-zA-Z:.]+\\|[0-9]+:[0-9:]+\\|[0-9.]+\\([eE][-+_]?[0-9]+\\)?\"?\\)?" exp-str exp-pos)) - (setq exp-token 'number - math-expr-data (math-match-substring exp-str 0) - exp-pos (match-end 0))) + (string-match "0[xX][0-9a-fA-F]+" math-exp-str math-exp-pos)) + (string-match "_?\\([0-9]+.?0*@ *\\)?\\([0-9]+.?0*' *\\)?\\(0*\\([2-9]\\|1[0-4]\\)\\(#\\|\\^\\^\\)[0-9a-dA-D.]+[eE][-+_]?[0-9]+\\|0*\\([2-9]\\|[0-2][0-9]\\|3[0-6]\\)\\(#\\|\\^\\^\\)[0-9a-zA-Z:.]+\\|[0-9]+:[0-9:]+\\|[0-9.]+\\([eE][-+_]?[0-9]+\\)?\"?\\)?" + math-exp-str math-exp-pos)) + (setq math-exp-token 'number + math-expr-data (math-match-substring math-exp-str 0) + math-exp-pos (match-end 0))) ((eq ch ?\$) (if (and (eq calc-language 'pascal) (eq (string-match "\\(\\$[0-9a-fA-F]+\\)\\($\\|[^0-9a-zA-Z]\\)" - exp-str exp-pos) - exp-pos)) - (setq exp-token 'number - math-expr-data (math-match-substring exp-str 1) - exp-pos (match-end 1)) - (if (eq (string-match "\\$\\([1-9][0-9]*\\)" exp-str exp-pos) - exp-pos) + math-exp-str math-exp-pos) + math-exp-pos)) + (setq math-exp-token 'number + math-expr-data (math-match-substring math-exp-str 1) + math-exp-pos (match-end 1)) + (if (eq (string-match "\\$\\([1-9][0-9]*\\)" math-exp-str math-exp-pos) + math-exp-pos) (setq math-expr-data (- (string-to-int (math-match-substring - exp-str 1)))) - (string-match "\\$+" exp-str exp-pos) + math-exp-str 1)))) + (string-match "\\$+" math-exp-str math-exp-pos) (setq math-expr-data (- (match-end 0) (match-beginning 0)))) - (setq exp-token 'dollar - exp-pos (match-end 0)))) + (setq math-exp-token 'dollar + math-exp-pos (match-end 0)))) ((eq ch ?\#) - (if (eq (string-match "#\\([1-9][0-9]*\\)" exp-str exp-pos) - exp-pos) + (if (eq (string-match "#\\([1-9][0-9]*\\)" math-exp-str math-exp-pos) + math-exp-pos) (setq math-expr-data (string-to-int - (math-match-substring exp-str 1)) - exp-pos (match-end 0)) + (math-match-substring math-exp-str 1)) + math-exp-pos (match-end 0)) (setq math-expr-data 1 - exp-pos (1+ exp-pos))) - (setq exp-token 'hash)) + math-exp-pos (1+ math-exp-pos))) + (setq math-exp-token 'hash)) ((eq (string-match "~=\\|<=\\|>=\\|<>\\|/=\\|\\+/-\\|\\\\dots\\|\\\\ldots\\|\\*\\*\\|<<\\|>>\\|==\\|!=\\|&&&\\||||\\|!!!\\|&&\\|||\\|!!\\|:=\\|::\\|=>" - exp-str exp-pos) - exp-pos) - (setq exp-token 'punc - math-expr-data (math-match-substring exp-str 0) - exp-pos (match-end 0))) + math-exp-str math-exp-pos) + math-exp-pos) + (setq math-exp-token 'punc + math-expr-data (math-match-substring math-exp-str 0) + math-exp-pos (match-end 0))) ((and (eq ch ?\") - (string-match "\\(\"\\([^\"\\]\\|\\\\.\\)*\\)\\(\"\\|\\'\\)" exp-str exp-pos)) + (string-match "\\(\"\\([^\"\\]\\|\\\\.\\)*\\)\\(\"\\|\\'\\)" + math-exp-str math-exp-pos)) (if (eq calc-language 'eqn) (progn - (setq exp-str (copy-sequence exp-str)) - (aset exp-str (match-beginning 1) ?\{) - (if (< (match-end 1) (length exp-str)) - (aset exp-str (match-end 1) ?\})) + (setq math-exp-str (copy-sequence math-exp-str)) + (aset math-exp-str (match-beginning 1) ?\{) + (if (< (match-end 1) (length math-exp-str)) + (aset math-exp-str (match-end 1) ?\})) (math-read-token)) - (setq exp-token 'string - math-expr-data (math-match-substring exp-str 1) - exp-pos (match-end 0)))) + (setq math-exp-token 'string + math-expr-data (math-match-substring math-exp-str 1) + math-exp-pos (match-end 0)))) ((and (= ch ?\\) (eq calc-language 'tex) - (< exp-pos (1- (length exp-str)))) - (or (string-match "\\\\hbox *{\\([a-zA-Z0-9]+\\)}" exp-str exp-pos) - (string-match "\\(\\\\\\([a-zA-Z]+\\|[^a-zA-Z]\\)\\)" exp-str exp-pos)) - (setq exp-token 'symbol - exp-pos (match-end 0) + (< math-exp-pos (1- (length math-exp-str)))) + (or (string-match "\\\\hbox *{\\([a-zA-Z0-9]+\\)}" + math-exp-str math-exp-pos) + (string-match "\\(\\\\\\([a-zA-Z]+\\|[^a-zA-Z]\\)\\)" + math-exp-str math-exp-pos)) + (setq math-exp-token 'symbol + math-exp-pos (match-end 0) math-expr-data (math-restore-dashes - (math-match-substring exp-str 1))) + (math-match-substring math-exp-str 1))) (let ((code (assoc math-expr-data math-tex-ignore-words))) (cond ((null code)) ((null (cdr code)) (math-read-token)) ((eq (nth 1 code) 'punc) - (setq exp-token 'punc + (setq math-exp-token 'punc math-expr-data (nth 2 code))) ((and (eq (nth 1 code) 'mat) - (string-match " *{" exp-str exp-pos)) - (setq exp-pos (match-end 0) - exp-token 'punc + (string-match " *{" math-exp-str math-exp-pos)) + (setq math-exp-pos (match-end 0) + math-exp-token 'punc math-expr-data "[") - (let ((right (string-match "}" exp-str exp-pos))) + (let ((right (string-match "}" math-exp-str math-exp-pos))) (and right - (setq exp-str (copy-sequence exp-str)) - (aset exp-str right ?\]))))))) + (setq math-exp-str (copy-sequence math-exp-str)) + (aset math-exp-str right ?\]))))))) ((and (= ch ?\.) (eq calc-language 'fortran) (eq (string-match "\\.[a-zA-Z][a-zA-Z][a-zA-Z]?\\." - exp-str exp-pos) exp-pos)) - (setq exp-token 'punc - math-expr-data (upcase (math-match-substring exp-str 0)) - exp-pos (match-end 0))) + math-exp-str math-exp-pos) math-exp-pos)) + (setq math-exp-token 'punc + math-expr-data (upcase (math-match-substring math-exp-str 0)) + math-exp-pos (match-end 0))) ((and (eq calc-language 'math) - (eq (string-match "\\[\\[\\|->\\|:>" exp-str exp-pos) - exp-pos)) - (setq exp-token 'punc - math-expr-data (math-match-substring exp-str 0) - exp-pos (match-end 0))) + (eq (string-match "\\[\\[\\|->\\|:>" math-exp-str math-exp-pos) + math-exp-pos)) + (setq math-exp-token 'punc + math-expr-data (math-match-substring math-exp-str 0) + math-exp-pos (match-end 0))) ((and (eq calc-language 'eqn) (eq (string-match "->\\|<-\\|+-\\|\\\\dots\\|~\\|\\^" - exp-str exp-pos) - exp-pos)) - (setq exp-token 'punc - math-expr-data (math-match-substring exp-str 0) - exp-pos (match-end 0)) - (and (eq (string-match "\\\\dots\\." exp-str exp-pos) exp-pos) - (setq exp-pos (match-end 0))) + math-exp-str math-exp-pos) + math-exp-pos)) + (setq math-exp-token 'punc + math-expr-data (math-match-substring math-exp-str 0) + math-exp-pos (match-end 0)) + (and (eq (string-match "\\\\dots\\." math-exp-str math-exp-pos) + math-exp-pos) + (setq math-exp-pos (match-end 0))) (if (memq (aref math-expr-data 0) '(?~ ?^)) (math-read-token))) - ((eq (string-match "%%.*$" exp-str exp-pos) exp-pos) - (setq exp-pos (match-end 0)) + ((eq (string-match "%%.*$" math-exp-str math-exp-pos) math-exp-pos) + (setq math-exp-pos (match-end 0)) (math-read-token)) (t (if (and (eq ch ?\{) (memq calc-language '(tex eqn))) @@ -705,9 +723,9 @@ (setq ch ?\))) (if (and (eq ch ?\&) (eq calc-language 'tex)) (setq ch ?\,)) - (setq exp-token 'punc + (setq math-exp-token 'punc math-expr-data (char-to-string ch) - exp-pos (1+ exp-pos))))))) + math-exp-pos (1+ math-exp-pos))))))) (defun math-read-expr-level (exp-prec &optional exp-term) @@ -728,16 +746,16 @@ (setq op op2)) t)) (and (or (eq (nth 2 op) -1) - (memq exp-token '(symbol number dollar hash)) + (memq math-exp-token '(symbol number dollar hash)) (equal math-expr-data "(") (and (equal math-expr-data "[") (not (eq calc-language 'math)) - (not (and exp-keep-spaces + (not (and math-exp-keep-spaces (eq (car-safe x) 'vec))))) (or (not (setq op (assoc math-expr-data math-expr-opers))) (/= (nth 2 op) -1)) (or (not calc-user-parse-table) - (not (eq exp-token 'symbol)) + (not (eq math-exp-token 'symbol)) (let ((p calc-user-parse-table)) (while (and p (or (not (integerp @@ -790,9 +808,9 @@ (equal math-expr-data (car (setq rule (cdr rule))))) (equal math-expr-data (car rule))))) - (let ((save-exp-pos exp-pos) - (save-exp-old-pos exp-old-pos) - (save-exp-token exp-token) + (let ((save-exp-pos math-exp-pos) + (save-exp-old-pos math-exp-old-pos) + (save-exp-token math-exp-token) (save-exp-data math-expr-data)) (or (not (listp (setq matches (calc-match-user-syntax rule)))) @@ -856,19 +874,20 @@ (if match (not (setq match (math-multi-subst match args matches))) - (setq exp-old-pos save-exp-old-pos - exp-token save-exp-token + (setq math-exp-old-pos save-exp-old-pos + math-exp-token save-exp-token math-expr-data save-exp-data - exp-pos save-exp-pos))))))) + math-exp-pos save-exp-pos))))))) (setq p (cdr p))) (and p match))) (defun calc-match-user-syntax (p &optional term) (let ((matches nil) - (save-exp-pos exp-pos) - (save-exp-old-pos exp-old-pos) - (save-exp-token exp-token) - (save-exp-data math-expr-data)) + (save-exp-pos math-exp-pos) + (save-exp-old-pos math-exp-old-pos) + (save-exp-token math-exp-token) + (save-exp-data math-expr-data) + m) (while (and p (cond ((stringp (car p)) (and (equal math-expr-data (car p)) @@ -895,7 +914,7 @@ (cons 'vec (and (listp m) m)))))) (or (listp m) (not (nth 2 (car p))) (not (eq (aref (car (nth 2 (car p))) 0) ?\$)) - (eq exp-token 'end))) + (eq math-exp-token 'end))) (t (setq m (calc-match-user-syntax (nth 1 (car p)) (car (nth 2 (car p))))) @@ -903,21 +922,21 @@ (let ((vec (cons 'vec m)) opos mm) (while (and (listp - (setq opos exp-pos + (setq opos math-exp-pos mm (calc-match-user-syntax (or (nth 2 (car p)) (nth 1 (car p))) (car (nth 2 (car p)))))) - (> exp-pos opos)) + (> math-exp-pos opos)) (setq vec (nconc vec mm))) (setq matches (nconc matches (list vec)))) (and (eq (car (car p)) '*) (setq matches (nconc matches (list '(vec))))))))) (setq p (cdr p))) (if p - (setq exp-pos save-exp-pos - exp-old-pos save-exp-old-pos - exp-token save-exp-token + (setq math-exp-pos save-exp-pos + math-exp-old-pos save-exp-old-pos + math-exp-token save-exp-token math-expr-data save-exp-data matches "Failed")) matches)) @@ -946,10 +965,10 @@ (list 'calcFunc-if cond then (math-read-expr-level (nth 3 op))))) (defun math-factor-after () - (let ((exp-pos exp-pos) - exp-old-pos exp-token math-expr-data) + (let ((math-exp-pos math-exp-pos) + math-exp-old-pos math-exp-token math-expr-data) (math-read-token) - (or (memq exp-token '(number symbol dollar hash string)) + (or (memq math-exp-token '(number symbol dollar hash string)) (and (assoc math-expr-data '(("-") ("+") ("!") ("|") ("/"))) (assoc (concat "u" math-expr-data) math-expr-opers)) (eq (nth 2 (assoc math-expr-data math-expr-opers)) -1) @@ -957,11 +976,11 @@ (defun math-read-factor () (let (op) - (cond ((eq exp-token 'number) + (cond ((eq math-exp-token 'number) (let ((num (math-read-number math-expr-data))) (if (not num) (progn - (setq exp-old-pos exp-pos) + (setq math-exp-old-pos math-exp-pos) (throw 'syntax "Bad format"))) (math-read-token) (if (and math-read-expr-quotes @@ -990,7 +1009,7 @@ (equal (car op) "u-")) (math-neg val)) (t (list (nth 1 op) val)))))) - ((eq exp-token 'symbol) + ((eq math-exp-token 'symbol) (let ((sym (intern math-expr-data))) (math-read-token) (if (equal math-expr-data calc-function-open) @@ -999,11 +1018,11 @@ (if (consp (cdr f)) (funcall (car (cdr f)) f sym) (let ((args (if (or (equal math-expr-data calc-function-close) - (eq exp-token 'end)) + (eq math-exp-token 'end)) nil (math-read-expr-list)))) (if (not (or (equal math-expr-data calc-function-close) - (eq exp-token 'end))) + (eq math-exp-token 'end))) (throw 'syntax "Expected `)'")) (math-read-token) (if (and (eq calc-language 'fortran) args @@ -1053,7 +1072,7 @@ (math-read-token) (throw 'syntax "Expected ']'"))) val))))) - ((eq exp-token 'dollar) + ((eq math-exp-token 'dollar) (let ((abs (if (> math-expr-data 0) math-expr-data (- math-expr-data)))) (if (>= (length calc-dollar-values) abs) (let ((num math-expr-data)) @@ -1063,7 +1082,7 @@ (throw 'syntax (if calc-dollar-values "Too many $'s" "$'s not allowed in this context"))))) - ((eq exp-token 'hash) + ((eq math-exp-token 'hash) (or calc-hashes-used (throw 'syntax "#'s not allowed in this context")) (calc-extensions) @@ -1074,13 +1093,13 @@ (nth (1- num) calc-arg-values)) (throw 'syntax "Too many # arguments"))) ((equal math-expr-data "(") - (let* ((exp (let ((exp-keep-spaces nil)) + (let* ((exp (let ((math-exp-keep-spaces nil)) (math-read-token) (if (or (equal math-expr-data "\\dots") (equal math-expr-data "\\ldots")) '(neg (var inf var-inf)) (math-read-expr-level 0))))) - (let ((exp-keep-spaces nil)) + (let ((math-exp-keep-spaces nil)) (cond ((equal math-expr-data ",") (progn @@ -1109,7 +1128,7 @@ (math-read-token) (let ((exp2 (if (or (equal math-expr-data ")") (equal math-expr-data "]") - (eq exp-token 'end)) + (eq math-exp-token 'end)) '(var inf var-inf) (math-read-expr-level 0)))) (setq exp @@ -1119,11 +1138,11 @@ exp2))))))) (if (not (or (equal math-expr-data ")") (and (equal math-expr-data "]") (eq (car-safe exp) 'intv)) - (eq exp-token 'end))) + (eq math-exp-token 'end))) (throw 'syntax "Expected `)'")) (math-read-token) exp)) - ((eq exp-token 'string) + ((eq math-exp-token 'string) (calc-extensions) (math-read-string)) ((equal math-expr-data "[") -- cgit v1.2.1 From e59b8655da9616b4966bb1d5ed6419f1bfe029db Mon Sep 17 00:00:00 2001 From: Jay Belanger Date: Thu, 11 Nov 2004 05:50:09 +0000 Subject: (math-read-expr): Use declared variables math-exp-pos, math-exp-old-pos, math-exp-str, math-exp-token, math-exp-keep-spaces. --- lisp/calc/calc-ext.el | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) (limited to 'lisp/calc') diff --git a/lisp/calc/calc-ext.el b/lisp/calc/calc-ext.el index 2c7662277d6..ae6e6001c5e 100644 --- a/lisp/calc/calc-ext.el +++ b/lisp/calc/calc-ext.el @@ -2887,22 +2887,22 @@ calc-kill calc-kill-region calc-yank)))) (defvar math-expr-data) -(defun math-read-expr (exp-str) - (let ((exp-pos 0) - (exp-old-pos 0) - (exp-keep-spaces nil) - exp-token math-expr-data) - (while (setq exp-token (string-match "\\.\\.\\([^.]\\|.[^.]\\)" exp-str)) - (setq exp-str (concat (substring exp-str 0 exp-token) "\\dots" - (substring exp-str (+ exp-token 2))))) +(defun math-read-expr (math-exp-str) + (let ((math-exp-pos 0) + (math-exp-old-pos 0) + (math-exp-keep-spaces nil) + math-exp-token math-expr-data) + (while (setq math-exp-token (string-match "\\.\\.\\([^.]\\|.[^.]\\)" math-exp-str)) + (setq math-exp-str (concat (substring math-exp-str 0 math-exp-token) "\\dots" + (substring math-exp-str (+ math-exp-token 2))))) (math-build-parse-table) (math-read-token) (let ((val (catch 'syntax (math-read-expr-level 0)))) (if (stringp val) - (list 'error exp-old-pos val) - (if (equal exp-token 'end) + (list 'error math-exp-old-pos val) + (if (equal math-exp-token 'end) val - (list 'error exp-old-pos "Syntax error")))))) + (list 'error math-exp-old-pos "Syntax error")))))) (defun math-read-plain-expr (exp-str &optional error-check) (let* ((calc-language nil) -- cgit v1.2.1 From 97660b3e631d72d24c63e7cc0cd482e8eb0cd2c8 Mon Sep 17 00:00:00 2001 From: Jay Belanger Date: Thu, 11 Nov 2004 05:51:24 +0000 Subject: (math-read-angle-bracket): Use declared variables math-exp-pos, math-exp-str. --- lisp/calc/calc-forms.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'lisp/calc') diff --git a/lisp/calc/calc-forms.el b/lisp/calc/calc-forms.el index 31f9e776a0c..e64983ad33d 100644 --- a/lisp/calc/calc-forms.el +++ b/lisp/calc/calc-forms.el @@ -1791,8 +1791,8 @@ and ends on the last Sunday of October at 2 a.m." (defun math-read-angle-brackets () - (let* ((last (or (math-check-for-commas t) (length exp-str))) - (str (substring exp-str exp-pos last)) + (let* ((last (or (math-check-for-commas t) (length math-exp-str))) + (str (substring math-exp-str math-exp-pos last)) (res (if (string-match "\\` *\\([a-zA-Z#][a-zA-Z0-9#]* *,? *\\)*:" str) (let ((str1 (substring str 0 (1- (match-end 0)))) @@ -1818,7 +1818,7 @@ and ends on the last Sunday of October at 2 a.m." (throw 'syntax res)) (if (eq (car-safe res) 'error) (throw 'syntax (nth 2 res))) - (setq exp-pos (1+ last)) + (setq math-exp-pos (1+ last)) (math-read-token) res)) -- cgit v1.2.1 From 679e2630d32217a70c8970788da415558613b38f Mon Sep 17 00:00:00 2001 From: Jay Belanger Date: Thu, 11 Nov 2004 05:52:17 +0000 Subject: (math-parse-tex-sum): Use declared variable math-exp-old-pos. (math-parse-fortran-vector, math-parse-fortran-vector-end) (math-parse-eqn-prime): Use declared variable math-exp-token. --- lisp/calc/calc-lang.el | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) (limited to 'lisp/calc') diff --git a/lisp/calc/calc-lang.el b/lisp/calc/calc-lang.el index 93935f14406..ee00e022553 100644 --- a/lisp/calc/calc-lang.el +++ b/lisp/calc/calc-lang.el @@ -263,14 +263,14 @@ (let ((math-parsing-fortran-vector '(end . "\000"))) (prog1 (math-read-brackets t "]") - (setq exp-token (car math-parsing-fortran-vector) + (setq math-exp-token (car math-parsing-fortran-vector) math-expr-data (cdr math-parsing-fortran-vector))))) (defun math-parse-fortran-vector-end (x op) (if math-parsing-fortran-vector (progn - (setq math-parsing-fortran-vector (cons exp-token math-expr-data) - exp-token 'end + (setq math-parsing-fortran-vector (cons math-exp-token math-expr-data) + math-exp-token 'end math-expr-data "\000") x) (throw 'syntax "Unmatched closing `/'"))) @@ -386,11 +386,11 @@ (let (low high save) (or (equal math-expr-data "_") (throw 'syntax "Expected `_'")) (math-read-token) - (setq save exp-old-pos) + (setq save math-exp-old-pos) (setq low (math-read-factor)) (or (eq (car-safe low) 'calcFunc-eq) (progn - (setq exp-old-pos (1+ save)) + (setq math-exp-old-pos (1+ save)) (throw 'syntax "Expected equation"))) (or (equal math-expr-data "^") (throw 'syntax "Expected `^'")) (math-read-token) @@ -504,11 +504,11 @@ (progn (math-read-token) (let ((args (if (or (equal math-expr-data calc-function-close) - (eq exp-token 'end)) + (eq math-exp-token 'end)) nil (math-read-expr-list)))) (if (not (or (equal math-expr-data calc-function-close) - (eq exp-token 'end))) + (eq math-exp-token 'end))) (throw 'syntax "Expected `)'")) (math-read-token) (cons (intern (format "calcFunc-%s'" (nth 1 x))) args))) -- cgit v1.2.1 From 411b1407624dc3f8de89532f58f6bdb8138435f3 Mon Sep 17 00:00:00 2001 From: Jay Belanger Date: Thu, 11 Nov 2004 05:53:19 +0000 Subject: (math-read-brackets, math-check-for-commas): Use declared variable math-exp-pos. (math-check-for-commas): Use declared variable math-exp-str. (math-read-brackets): Use declared variables math-exp-old-pos, math-exp-keep-spaces. (math-read-brackets, math-read-vector, math-read-matrix): Use declared variable math-exp-token. --- lisp/calc/calc-vec.el | 60 +++++++++++++++++++++++++-------------------------- 1 file changed, 30 insertions(+), 30 deletions(-) (limited to 'lisp/calc') diff --git a/lisp/calc/calc-vec.el b/lisp/calc/calc-vec.el index c09d2715889..a78f98ec3cc 100644 --- a/lisp/calc/calc-vec.el +++ b/lisp/calc/calc-vec.el @@ -1466,41 +1466,41 @@ (defun math-read-brackets (space-sep close) (and space-sep (setq space-sep (not (math-check-for-commas)))) (math-read-token) - (while (eq exp-token 'space) + (while (eq math-exp-token 'space) (math-read-token)) (if (or (equal math-expr-data close) - (eq exp-token 'end)) + (eq math-exp-token 'end)) (progn (math-read-token) '(vec)) - (let ((save-exp-pos exp-pos) - (save-exp-old-pos exp-old-pos) - (save-exp-token exp-token) + (let ((save-exp-pos math-exp-pos) + (save-exp-old-pos math-exp-old-pos) + (save-exp-token math-exp-token) (save-exp-data math-expr-data) - (vals (let ((exp-keep-spaces space-sep)) + (vals (let ((math-exp-keep-spaces space-sep)) (if (or (equal math-expr-data "\\dots") (equal math-expr-data "\\ldots")) '(vec (neg (var inf var-inf))) (catch 'syntax (math-read-vector)))))) (if (stringp vals) (if space-sep - (let ((error-exp-pos exp-pos) - (error-exp-old-pos exp-old-pos) + (let ((error-exp-pos math-exp-pos) + (error-exp-old-pos math-exp-old-pos) vals2) - (setq exp-pos save-exp-pos - exp-old-pos save-exp-old-pos - exp-token save-exp-token + (setq math-exp-pos save-exp-pos + math-exp-old-pos save-exp-old-pos + math-exp-token save-exp-token math-expr-data save-exp-data) - (let ((exp-keep-spaces nil)) + (let ((math-exp-keep-spaces nil)) (setq vals2 (catch 'syntax (math-read-vector)))) (if (and (not (stringp vals2)) (or (assoc math-expr-data '(("\\ldots") ("\\dots") (";"))) (equal math-expr-data close) - (eq exp-token 'end))) + (eq math-exp-token 'end))) (setq space-sep nil vals vals2) - (setq exp-pos error-exp-pos - exp-old-pos error-exp-old-pos) + (setq math-exp-pos error-exp-pos + math-exp-old-pos error-exp-old-pos) (throw 'syntax vals))) (throw 'syntax vals))) (if (or (equal math-expr-data "\\dots") @@ -1511,7 +1511,7 @@ (cons 'calcFunc-mul (cdr vals)) (nth 1 vals))) (let ((exp2 (if (or (equal math-expr-data close) (equal math-expr-data ")") - (eq exp-token 'end)) + (eq math-exp-token 'end)) '(var inf var-inf) (math-read-expr-level 0)))) (setq vals @@ -1521,48 +1521,48 @@ exp2))) (if (not (or (equal math-expr-data close) (equal math-expr-data ")") - (eq exp-token 'end))) + (eq math-exp-token 'end))) (throw 'syntax "Expected `]'"))) (if (equal math-expr-data ";") - (let ((exp-keep-spaces space-sep)) + (let ((math-exp-keep-spaces space-sep)) (setq vals (cons 'vec (math-read-matrix (list vals)))))) (if (not (or (equal math-expr-data close) - (eq exp-token 'end))) + (eq math-exp-token 'end))) (throw 'syntax "Expected `]'"))) - (or (eq exp-token 'end) + (or (eq math-exp-token 'end) (math-read-token)) vals))) (defun math-check-for-commas (&optional balancing) (let ((count 0) - (pos (1- exp-pos))) + (pos (1- math-exp-pos))) (while (and (>= count 0) (setq pos (string-match (if balancing "[],[{}()<>]" "[],[{}()]") - exp-str (1+ pos))) - (or (/= (aref exp-str pos) ?,) (> count 0) balancing)) - (cond ((memq (aref exp-str pos) '(?\[ ?\{ ?\( ?\<)) + math-exp-str (1+ pos))) + (or (/= (aref math-exp-str pos) ?,) (> count 0) balancing)) + (cond ((memq (aref math-exp-str pos) '(?\[ ?\{ ?\( ?\<)) (setq count (1+ count))) - ((memq (aref exp-str pos) '(?\] ?\} ?\) ?\>)) + ((memq (aref math-exp-str pos) '(?\] ?\} ?\) ?\>)) (setq count (1- count))))) (if balancing pos - (and pos (= (aref exp-str pos) ?,))))) + (and pos (= (aref math-exp-str pos) ?,))))) (defun math-read-vector () (let* ((val (list (math-read-expr-level 0))) (last val)) (while (progn - (while (eq exp-token 'space) + (while (eq math-exp-token 'space) (math-read-token)) - (and (not (eq exp-token 'end)) + (and (not (eq math-exp-token 'end)) (not (equal math-expr-data ";")) (not (equal math-expr-data close)) (not (equal math-expr-data "\\dots")) (not (equal math-expr-data "\\ldots")))) (if (equal math-expr-data ",") (math-read-token)) - (while (eq exp-token 'space) + (while (eq math-exp-token 'space) (math-read-token)) (let ((rest (list (math-read-expr-level 0)))) (setcdr last rest) @@ -1572,7 +1572,7 @@ (defun math-read-matrix (mat) (while (equal math-expr-data ";") (math-read-token) - (while (eq exp-token 'space) + (while (eq math-exp-token 'space) (math-read-token)) (setq mat (nconc mat (list (math-read-vector))))) mat) -- cgit v1.2.1 From fe1f8500f81321cfed5a396e773d3efa0920d811 Mon Sep 17 00:00:00 2001 From: Jay Belanger Date: Thu, 11 Nov 2004 20:16:15 +0000 Subject: (math-defcache): Use defvar for the new variables it creates. --- lisp/calc/calc-ext.el | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) (limited to 'lisp/calc') diff --git a/lisp/calc/calc-ext.el b/lisp/calc/calc-ext.el index ae6e6001c5e..77057fd4a7a 100644 --- a/lisp/calc/calc-ext.el +++ b/lisp/calc/calc-ext.el @@ -1849,10 +1849,10 @@ calc-kill calc-kill-region calc-yank)))) (last-prec (intern (concat (symbol-name name) "-last-prec"))) (last-val (intern (concat (symbol-name name) "-last")))) (list 'progn - (list 'setq cache-prec (if init (math-numdigs (nth 1 init)) -100)) - (list 'setq cache-val (list 'quote init)) - (list 'setq last-prec -100) - (list 'setq last-val nil) + (list 'defvar cache-prec (if init (math-numdigs (nth 1 init)) -100)) + (list 'defvar cache-val (list 'quote init)) + (list 'defvar last-prec -100) + (list 'defvar last-val nil) (list 'setq 'math-cache-list (list 'cons (list 'quote cache-prec) -- cgit v1.2.1 From 8d7498c1ff4370d90cadb418c447b6f3a5143502 Mon Sep 17 00:00:00 2001 From: Jay Belanger Date: Thu, 11 Nov 2004 20:59:02 +0000 Subject: (math-prime-factors-finished): Declared it as a variable. (calcFunc-dfac): Replaced max by n. (math-stirling-local-cache): New variable. (math-stirling-number, math-stirling-1, math-stirling-2): Replaced the variable `cache' by the declared variable math-stirling-local-cache. (var-RandSeed): Declared it. (math-init-random-base, math-random-digit): Don't check to see if var-RandSeed is bound. (math-random-cache, math-gaussian-cache, calc-verbose-nextprime): Declared them instead of just setting them. (math-init-random-base): Made i a local variable. (math-random-digit): Made math-random-last a local variable. (math-prime-test-cache): Moved declaration to before it is used. (math-prime-test-cache-k, math-prime-test-cache-q, math-prime-test-cache-nm1, math-prime-factors-finished): Declared them as variables. --- lisp/calc/calc-comb.el | 68 +++++++++++++++++++++++++++++++++----------------- 1 file changed, 45 insertions(+), 23 deletions(-) (limited to 'lisp/calc') diff --git a/lisp/calc/calc-comb.el b/lisp/calc/calc-comb.el index c7ecbecc80b..8b0dffe3f15 100644 --- a/lisp/calc/calc-comb.el +++ b/lisp/calc/calc-comb.el @@ -82,6 +82,11 @@ 4877 4889 4903 4909 4919 4931 4933 4937 4943 4951 4957 4967 4969 4973 4987 4993 4999 5003]) +;; The variable math-prime-factors-finished is set by calcFunc-prfac to +;; indicate whether factoring is complete, and used by calcFunc-factors, +;; calcFunc-totient and calcFunc-moebius. +(defvar math-prime-factors-finished) + ;;; Combinatorics (defun calc-gcd (arg) @@ -195,6 +200,8 @@ (res (math-prime-test n iters))) (calc-report-prime-test res)))) +(defvar calc-verbose-nextprime nil) + (defun calc-next-prime (iters) (interactive "p") (calc-slow-wrapper @@ -386,7 +393,7 @@ (if (math-evenp temp) even (math-div (calcFunc-fact n) even)))) - (list 'calcFunc-dfact max)))) + (list 'calcFunc-dfact n)))) ((equal n '(var inf var-inf)) n) (t (calc-record-why 'natnump n) (list 'calcFunc-dfact n)))) @@ -484,6 +491,12 @@ (math-stirling-number n m 0)) (defvar math-stirling-cache (vector [[1]] [[1]])) + +;; The variable math-stirling-local-cache is local to +;; math-stirling-number, but is used by math-stirling-1 +;; and math-stirling-2, which are called by math-stirling-number. +(defvar math-stirling-local-cache) + (defun math-stirling-number (n m k) (or (math-num-natnump n) (math-reject-arg n 'natnump)) (or (math-num-natnump m) (math-reject-arg m 'natnump)) @@ -493,14 +506,16 @@ (or (integerp m) (math-reject-arg m 'fixnump)) (if (< n m) 0 - (let ((cache (aref math-stirling-cache k))) - (while (<= (length cache) n) - (let ((i (1- (length cache))) + (let ((math-stirling-local-cache (aref math-stirling-cache k))) + (while (<= (length math-stirling-local-cache) n) + (let ((i (1- (length math-stirling-local-cache))) row) - (setq cache (vconcat cache (make-vector (length cache) nil))) - (aset math-stirling-cache k cache) - (while (< (setq i (1+ i)) (length cache)) - (aset cache i (setq row (make-vector (1+ i) nil))) + (setq math-stirling-local-cache + (vconcat math-stirling-local-cache + (make-vector (length math-stirling-local-cache) nil))) + (aset math-stirling-cache k math-stirling-local-cache) + (while (< (setq i (1+ i)) (length math-stirling-local-cache)) + (aset math-stirling-local-cache i (setq row (make-vector (1+ i) nil))) (aset row 0 0) (aset row i 1)))) (if (= k 1) @@ -508,14 +523,14 @@ (math-stirling-2 n m))))) (defun math-stirling-1 (n m) - (or (aref (aref cache n) m) - (aset (aref cache n) m + (or (aref (aref math-stirling-local-cache n) m) + (aset (aref math-stirling-local-cache n) m (math-add (math-stirling-1 (1- n) (1- m)) (math-mul (- 1 n) (math-stirling-1 (1- n) m)))))) (defun math-stirling-2 (n m) - (or (aref (aref cache n) m) - (aset (aref cache n) m + (or (aref (aref math-stirling-local-cache n) m) + (aset (aref math-stirling-local-cache n) m (math-add (math-stirling-2 (1- n) (1- m)) (math-mul m (math-stirling-2 (1- n) m)))))) @@ -527,8 +542,13 @@ ;;; Produce a random 10-bit integer, with (random) if no seed provided, ;;; or else with Numerical Recipes algorithm ran3 / Knuth 3.2.2-A. + +(defvar var-RandSeed nil) +(defvar math-random-cache nil) +(defvar math-gaussian-cache nil) + (defun math-init-random-base () - (if (and (boundp 'var-RandSeed) var-RandSeed) + (if var-RandSeed (if (eq (car-safe var-RandSeed) 'vec) nil (if (Math-integerp var-RandSeed) @@ -555,13 +575,13 @@ (random t) (setq var-RandSeed nil math-random-cache nil - i 0 math-random-shift -4) ; assume RAND_MAX >= 16383 ;; This exercises the random number generator and also helps ;; deduce a better value for RAND_MAX. - (while (< (setq i (1+ i)) 30) - (if (> (lsh (math-abs (random)) math-random-shift) 4095) - (setq math-random-shift (1- math-random-shift))))) + (let ((i 0)) + (while (< (setq i (1+ i)) 30) + (if (> (lsh (math-abs (random)) math-random-shift) 4095) + (setq math-random-shift (1- math-random-shift)))))) (setq math-last-RandSeed var-RandSeed math-gaussian-cache nil)) @@ -583,8 +603,8 @@ ;;; Avoid various pitfalls that may lurk in the built-in (random) function! ;;; Shuffling algorithm from Numerical Recipes, section 7.1. (defun math-random-digit () - (let (i) - (or (and (boundp 'var-RandSeed) (eq var-RandSeed math-last-RandSeed)) + (let (i math-random-last) + (or (eq var-RandSeed math-last-RandSeed) (math-init-random-base)) (or math-random-cache (progn @@ -599,7 +619,6 @@ (aset math-random-cache i (math-random-base)) (>= math-random-last 1000))) math-random-last)) -(setq math-random-cache nil) ;;; Produce an N-digit random integer. (defun math-random-digits (n) @@ -639,7 +658,6 @@ (setq math-gaussian-cache (cons calc-internal-prec (math-mul v1 fac))) (math-mul v2 fac)))))) -(setq math-gaussian-cache nil) ;;; Produce a random integer or real 0 <= N < MAX. (defun calcFunc-random (max) @@ -765,6 +783,12 @@ ;;; (nil unknown) if non-prime with no known factors, ;;; (t) if prime, ;;; (maybe N P) if probably prime (after N iters with probability P%) +(defvar math-prime-test-cache '(-1)) + +(defvar math-prime-test-cache-k) +(defvar math-prime-test-cache-q) +(defvar math-prime-test-cache-nm1) + (defun math-prime-test (n iters) (if (and (Math-vectorp n) (cdr n)) (setq n (nth (1- (length n)) n))) @@ -849,7 +873,6 @@ (1- iters) 0))) res)) -(defvar math-prime-test-cache '(-1)) (defun calcFunc-prime (n &optional iters) (or (math-num-integerp n) (math-reject-arg n 'integerp)) @@ -965,7 +988,6 @@ (if (Math-realp n) (calcFunc-nextprime (math-trunc n) iters) (math-reject-arg n 'integerp)))) -(setq calc-verbose-nextprime nil) (defun calcFunc-prevprime (n &optional iters) (if (Math-integerp n) -- cgit v1.2.1 From 68d1b30d251b4771f739d20f507cd9523ae3919b Mon Sep 17 00:00:00 2001 From: Jay Belanger Date: Fri, 12 Nov 2004 22:35:21 +0000 Subject: (calc-dumb-map): Declared it. (calc-graph-show-dumb): Check if calc-dumb-map is non-nil rather than unbound. (calc-graph-name): Made `end' a local variable. (calc-graph-lookup): Made `varname' a local variable. (var-DUMMY, var-DUMMY2, var-PlotRejects, calc-gnuplot-trail-mark): Declared them. (calc-graph-format-data): Don't check if var-PlotRejects is bound. (calc-graph-plot, calc-graph-compute-3d): Removed references to the unused variable y3vec. (calc-graph-show-dumb): Removed reference to unused variable found-pt. (calc-graph-kill-hook, calc-graph-plot): Removed reference to calc-graph-prev-kill-hook. (calc-graph-yvalue, calc-graph-yvec, calc-graph-numsteps, calc-graph-numsteps3, calc-graph-xvalue, calc-graph-xvec, calc-graph-xname, calc-graph-yname, calc-graph-xstep, calc-graph-ycache, calc-graph-ycacheptr, calc-graph-refine, calc-graph-keep-file, calc-graph-xval, calc-graph-xlow, calc-graph-xhigh, calc-graph-yval, calc-graph-yp, calc-graph-xp, calc-graph-zp, calc-graph-yvector, calc-graph-resolution, calc-graph-y3value, calc-graph-y3name, calc-graph-y3step, calc-graph-y3step, calc-graph-zval, calc-graph-stepcount, calc-graph-is-splot, calc-graph-surprise-splot, calc-graph-blank, calc-graph-non-blank, calc-graph-curve-num): New variables. (calc-graph-plot, calc-graph-compute-2d, calc-graph-refine-2d) (calc-graph-recompute-2d, calc-graph-compute-3d, calc-graph-format-data): Replaced undeclared variables with the above declared variables. --- lisp/calc/calc-graph.el | 688 +++++++++++++++++++++++++----------------------- 1 file changed, 364 insertions(+), 324 deletions(-) (limited to 'lisp/calc') diff --git a/lisp/calc/calc-graph.el b/lisp/calc/calc-graph.el index cec7a5d2136..ff537109816 100644 --- a/lisp/calc/calc-graph.el +++ b/lisp/calc/calc-graph.el @@ -66,6 +66,7 @@ (defvar calc-graph-data-cache-limit 10) (defvar calc-graph-no-auto-view nil) (defvar calc-graph-no-wait nil) +(defvar calc-gnuplot-trail-mark) (defun calc-graph-fast (many) (interactive "P") @@ -224,11 +225,10 @@ thing (let ((found (assoc thing calc-graph-var-cache))) (or found - (progn - (setq varname (concat "PlotData" - (int-to-string - (1+ (length calc-graph-var-cache)))) - var (list 'var (intern varname) + (let ((varname (concat "PlotData" + (int-to-string + (1+ (length calc-graph-var-cache)))))) + (setq var (list 'var (intern varname) (intern (concat "var-" varname))) found (cons thing var) calc-graph-var-cache (cons found calc-graph-var-cache)) @@ -275,6 +275,47 @@ (interactive "P") (calc-graph-plot flag t)) +(defvar var-DUMMY) +(defvar var-DUMMY2) +(defvar var-PlotRejects) + +;; The following variables are local to calc-graph-plot, but are +;; used in the functions calc-graph-compute-2d, calc-graph-refine-2d, +;; calc-graph-recompute-2d, calc-graph-compute-3d and +;; calc-graph-format-data, which are called by calc-graph-plot. +(defvar calc-graph-yvalue) +(defvar calc-graph-yvec) +(defvar calc-graph-numsteps) +(defvar calc-graph-numsteps3) +(defvar calc-graph-xvalue) +(defvar calc-graph-xvec) +(defvar calc-graph-xname) +(defvar calc-graph-yname) +(defvar calc-graph-xstep) +(defvar calc-graph-ycache) +(defvar calc-graph-ycacheptr) +(defvar calc-graph-refine) +(defvar calc-graph-keep-file) +(defvar calc-graph-xval) +(defvar calc-graph-xlow) +(defvar calc-graph-xhigh) +(defvar calc-graph-yval) +(defvar calc-graph-yp) +(defvar calc-graph-xp) +(defvar calc-graph-zp) +(defvar calc-graph-yvector) +(defvar calc-graph-resolution) +(defvar calc-graph-y3value) +(defvar calc-graph-y3name) +(defvar calc-graph-y3step) +(defvar calc-graph-zval) +(defvar calc-graph-stepcount) +(defvar calc-graph-is-splot) +(defvar calc-graph-surprise-splot) +(defvar calc-graph-blank) +(defvar calc-graph-non-blank) +(defvar calc-graph-curve-num) + (defun calc-graph-plot (flag &optional printing) (interactive "P") (calc-slow-wrapper @@ -282,22 +323,20 @@ (tempbuf (get-buffer-create "*Gnuplot Temp-2*")) (tempbuftop 1) (tempoutfile nil) - (curve-num 0) - (refine (and flag (> (prefix-numeric-value flag) 0))) + (calc-graph-curve-num 0) + (calc-graph-refine (and flag (> (prefix-numeric-value flag) 0))) (recompute (and flag (< (prefix-numeric-value flag) 0))) - (surprise-splot nil) + (calc-graph-surprise-splot nil) (tty-output nil) - cache-env is-splot device output resolution precision samples-pos) - (or (boundp 'calc-graph-prev-kill-hook) - (setq calc-graph-prev-kill-hook nil) - (add-hook 'kill-emacs-hook 'calc-graph-kill-hook)) + cache-env calc-graph-is-splot device output calc-graph-resolution precision samples-pos) + (add-hook 'kill-emacs-hook 'calc-graph-kill-hook) (save-excursion (calc-graph-init) (set-buffer tempbuf) (erase-buffer) (set-buffer calc-gnuplot-input) (goto-char (point-min)) - (setq is-splot (re-search-forward "^splot[ \t]" nil t)) + (setq calc-graph-is-splot (re-search-forward "^splot[ \t]" nil t)) (let ((str (buffer-string)) (ver calc-gnuplot-version)) (set-buffer (get-buffer-create "*Gnuplot Temp*")) @@ -313,14 +352,14 @@ "set nogrid\nset nokey\nset nopolar\n")) (if (>= ver 3) (insert "set surface\nset nocontour\n" - "set " (if is-splot "" "no") "parametric\n" + "set " (if calc-graph-is-splot "" "no") "parametric\n" "set notime\nset border\nset ztics\nset zeroaxis\n" "set view 60,30,1,1\nset offsets 0,0,0,0\n")) (setq samples-pos (point)) (insert "\n\n" str)) (goto-char (point-min)) - (if is-splot - (if refine + (if calc-graph-is-splot + (if calc-graph-refine (error "This option works only for 2d plots") (setq recompute t))) (let ((calc-gnuplot-input (current-buffer)) @@ -366,10 +405,10 @@ (if (equal output "STDOUT") "" (prin1-to-string output))))) - (setq resolution (calc-graph-find-command "samples")) - (if resolution - (setq resolution (string-to-int resolution)) - (setq resolution (if is-splot + (setq calc-graph-resolution (calc-graph-find-command "samples")) + (if calc-graph-resolution + (setq calc-graph-resolution (string-to-int calc-graph-resolution)) + (setq calc-graph-resolution (if calc-graph-is-splot calc-graph-default-resolution-3d calc-graph-default-resolution))) (setq precision (calc-graph-find-command "precision")) @@ -381,8 +420,8 @@ (calc-graph-set-command "samples") (calc-graph-set-command "precision")) (goto-char samples-pos) - (insert "set samples " (int-to-string (max (if is-splot 20 200) - (+ 5 resolution))) "\n") + (insert "set samples " (int-to-string (max (if calc-graph-is-splot 20 200) + (+ 5 calc-graph-resolution))) "\n") (while (re-search-forward "{\\*[^}]+}[^,\n]*" nil t) (delete-region (match-beginning 0) (match-end 0)) (if (looking-at ",") @@ -398,7 +437,7 @@ calc-simplify-mode calc-infinite-mode calc-word-size - precision is-splot)) + precision calc-graph-is-splot)) (if (and (not recompute) (equal (cdr (car calc-graph-data-cache)) cache-env)) (while (> (length calc-graph-data-cache) @@ -408,88 +447,88 @@ (setq calc-graph-data-cache (list (cons nil cache-env))))) (calc-graph-find-plot t t) (while (re-search-forward - (if is-splot + (if calc-graph-is-splot "{\\([^{}:\n]+\\):\\([^{}:\n]+\\):\\([^{}:\n]+\\)}" "{\\([^{}:\n]+\\)\\(:\\)\\([^{}:\n]+\\)}") nil t) - (setq curve-num (1+ curve-num)) - (let* ((xname (buffer-substring (match-beginning 1) (match-end 1))) - (xvar (intern (concat "var-" xname))) - (xvalue (math-evaluate-expr (calc-var-value xvar))) - (y3name (and is-splot + (setq calc-graph-curve-num (1+ calc-graph-curve-num)) + (let* ((calc-graph-xname (buffer-substring (match-beginning 1) (match-end 1))) + (xvar (intern (concat "var-" calc-graph-xname))) + (calc-graph-xvalue (math-evaluate-expr (calc-var-value xvar))) + (calc-graph-y3name (and calc-graph-is-splot (buffer-substring (match-beginning 2) (match-end 2)))) - (y3var (and is-splot (intern (concat "var-" y3name)))) - (y3value (and is-splot (calc-var-value y3var))) - (yname (buffer-substring (match-beginning 3) (match-end 3))) - (yvar (intern (concat "var-" yname))) - (yvalue (calc-var-value yvar)) + (y3var (and calc-graph-is-splot (intern (concat "var-" calc-graph-y3name)))) + (calc-graph-y3value (and calc-graph-is-splot (calc-var-value y3var))) + (calc-graph-yname (buffer-substring (match-beginning 3) (match-end 3))) + (yvar (intern (concat "var-" calc-graph-yname))) + (calc-graph-yvalue (calc-var-value yvar)) filename) (delete-region (match-beginning 0) (match-end 0)) - (setq filename (calc-temp-file-name curve-num)) + (setq filename (calc-temp-file-name calc-graph-curve-num)) (save-excursion (set-buffer calcbuf) (let (tempbuftop - (xp xvalue) - (yp yvalue) - (zp nil) - (xlow nil) (xhigh nil) (y3low nil) (y3high nil) - xvec xval xstep var-DUMMY - y3vec y3val y3step var-DUMMY2 (zval nil) - yvec yval ycache ycacheptr yvector - numsteps numsteps3 - (keep-file (and (not is-splot) (file-exists-p filename))) - (stepcount 0) + (calc-graph-xp calc-graph-xvalue) + (calc-graph-yp calc-graph-yvalue) + (calc-graph-zp nil) + (calc-graph-xlow nil) (calc-graph-xhigh nil) (y3low nil) (y3high nil) + calc-graph-xvec calc-graph-xval calc-graph-xstep var-DUMMY + y3val calc-graph-y3step var-DUMMY2 (calc-graph-zval nil) + calc-graph-yvec calc-graph-yval calc-graph-ycache calc-graph-ycacheptr calc-graph-yvector + calc-graph-numsteps calc-graph-numsteps3 + (calc-graph-keep-file (and (not calc-graph-is-splot) (file-exists-p filename))) + (calc-graph-stepcount 0) (calc-symbolic-mode nil) (calc-prefer-frac nil) (calc-internal-prec (max 3 precision)) (calc-simplify-mode (and (not (memq calc-simplify-mode '(none num))) calc-simplify-mode)) - (blank t) - (non-blank nil) + (calc-graph-blank t) + (calc-graph-non-blank nil) (math-working-step 0) (math-working-step-2 nil)) (save-excursion - (if is-splot + (if calc-graph-is-splot (calc-graph-compute-3d) (calc-graph-compute-2d)) (set-buffer tempbuf) (goto-char (point-max)) - (insert "\n" xname) - (if is-splot - (insert ":" y3name)) - (insert ":" yname "\n\n") + (insert "\n" calc-graph-xname) + (if calc-graph-is-splot + (insert ":" calc-graph-y3name)) + (insert ":" calc-graph-yname "\n\n") (setq tempbuftop (point)) (let ((calc-group-digits nil) (calc-leading-zeros nil) (calc-number-radix 10) - (entry (and (not is-splot) - (list xp yp xhigh numsteps)))) + (entry (and (not calc-graph-is-splot) + (list calc-graph-xp calc-graph-yp calc-graph-xhigh calc-graph-numsteps)))) (or (equal entry - (nth 1 (nth (1+ curve-num) + (nth 1 (nth (1+ calc-graph-curve-num) calc-graph-file-cache))) - (setq keep-file nil)) - (setcar (cdr (nth (1+ curve-num) calc-graph-file-cache)) + (setq calc-graph-keep-file nil)) + (setcar (cdr (nth (1+ calc-graph-curve-num) calc-graph-file-cache)) entry) - (or keep-file + (or calc-graph-keep-file (calc-graph-format-data))) - (or keep-file + (or calc-graph-keep-file (progn - (or non-blank + (or calc-graph-non-blank (error "No valid data points for %s:%s" - xname yname)) + calc-graph-xname calc-graph-yname)) (write-region tempbuftop (point-max) filename nil 'quiet)))))) (insert (prin1-to-string filename)))) - (if surprise-splot + (if calc-graph-surprise-splot (setcdr cache-env nil)) - (if (= curve-num 0) + (if (= calc-graph-curve-num 0) (progn (calc-gnuplot-command "clear") (calc-clear-command-flag 'clear-message) (message "No data to plot!")) - (setq calc-graph-data-cache-limit (max curve-num + (setq calc-graph-data-cache-limit (max calc-graph-curve-num calc-graph-data-cache-limit) filename (calc-temp-file-name 0)) (write-region (point-min) (point-max) filename nil 'quiet) @@ -517,325 +556,325 @@ (eval command)))))))))) (defun calc-graph-compute-2d () - (if (setq yvec (eq (car-safe yvalue) 'vec)) - (if (= (setq numsteps (1- (length yvalue))) 0) + (if (setq calc-graph-yvec (eq (car-safe calc-graph-yvalue) 'vec)) + (if (= (setq calc-graph-numsteps (1- (length calc-graph-yvalue))) 0) (error "Can't plot an empty vector") - (if (setq xvec (eq (car-safe xvalue) 'vec)) - (or (= (1- (length xvalue)) numsteps) - (error "%s and %s have different lengths" xname yname)) - (if (and (eq (car-safe xvalue) 'intv) - (math-constp xvalue)) - (setq xstep (math-div (math-sub (nth 3 xvalue) - (nth 2 xvalue)) - (1- numsteps)) - xvalue (nth 2 xvalue)) - (if (math-realp xvalue) - (setq xstep 1) - (error "%s is not a suitable basis for %s" xname yname))))) - (or (math-realp yvalue) + (if (setq calc-graph-xvec (eq (car-safe calc-graph-xvalue) 'vec)) + (or (= (1- (length calc-graph-xvalue)) calc-graph-numsteps) + (error "%s and %s have different lengths" calc-graph-xname calc-graph-yname)) + (if (and (eq (car-safe calc-graph-xvalue) 'intv) + (math-constp calc-graph-xvalue)) + (setq calc-graph-xstep (math-div (math-sub (nth 3 calc-graph-xvalue) + (nth 2 calc-graph-xvalue)) + (1- calc-graph-numsteps)) + calc-graph-xvalue (nth 2 calc-graph-xvalue)) + (if (math-realp calc-graph-xvalue) + (setq calc-graph-xstep 1) + (error "%s is not a suitable basis for %s" calc-graph-xname calc-graph-yname))))) + (or (math-realp calc-graph-yvalue) (let ((arglist nil)) - (setq yvalue (math-evaluate-expr yvalue)) - (calc-default-formula-arglist yvalue) + (setq calc-graph-yvalue (math-evaluate-expr calc-graph-yvalue)) + (calc-default-formula-arglist calc-graph-yvalue) (or arglist - (error "%s does not contain any unassigned variables" yname)) + (error "%s does not contain any unassigned variables" calc-graph-yname)) (and (cdr arglist) (error "%s contains more than one variable: %s" - yname arglist)) - (setq yvalue (math-expr-subst yvalue + calc-graph-yname arglist)) + (setq calc-graph-yvalue (math-expr-subst calc-graph-yvalue (math-build-var-name (car arglist)) '(var DUMMY var-DUMMY))))) - (setq ycache (assoc yvalue calc-graph-data-cache)) - (delq ycache calc-graph-data-cache) + (setq calc-graph-ycache (assoc calc-graph-yvalue calc-graph-data-cache)) + (delq calc-graph-ycache calc-graph-data-cache) (nconc calc-graph-data-cache - (list (or ycache (setq ycache (list yvalue))))) - (if (and (not (setq xvec (eq (car-safe xvalue) 'vec))) - refine (cdr (cdr ycache))) + (list (or calc-graph-ycache (setq calc-graph-ycache (list calc-graph-yvalue))))) + (if (and (not (setq calc-graph-xvec (eq (car-safe calc-graph-xvalue) 'vec))) + calc-graph-refine (cdr (cdr calc-graph-ycache))) (calc-graph-refine-2d) (calc-graph-recompute-2d)))) (defun calc-graph-refine-2d () - (setq keep-file nil - ycacheptr (cdr ycache)) - (if (and (setq xval (calc-graph-find-command "xrange")) + (setq calc-graph-keep-file nil + calc-graph-ycacheptr (cdr calc-graph-ycache)) + (if (and (setq calc-graph-xval (calc-graph-find-command "xrange")) (string-match "\\`\\[\\([0-9.eE+-]*\\):\\([0-9.eE+-]*\\)\\]\\'" - xval)) + calc-graph-xval)) (let ((b2 (match-beginning 2)) (e2 (match-end 2))) - (setq xlow (math-read-number (substring xval + (setq calc-graph-xlow (math-read-number (substring calc-graph-xval (match-beginning 1) (match-end 1))) - xhigh (math-read-number (substring xval b2 e2)))) - (if xlow - (while (and (cdr ycacheptr) - (Math-lessp (car (nth 1 ycacheptr)) xlow)) - (setq ycacheptr (cdr ycacheptr))))) - (setq math-working-step-2 (1- (length ycacheptr))) - (while (and (cdr ycacheptr) - (or (not xhigh) - (Math-lessp (car (car ycacheptr)) xhigh))) - (setq var-DUMMY (math-div (math-add (car (car ycacheptr)) - (car (nth 1 ycacheptr))) + calc-graph-xhigh (math-read-number (substring calc-graph-xval b2 e2)))) + (if calc-graph-xlow + (while (and (cdr calc-graph-ycacheptr) + (Math-lessp (car (nth 1 calc-graph-ycacheptr)) calc-graph-xlow)) + (setq calc-graph-ycacheptr (cdr calc-graph-ycacheptr))))) + (setq math-working-step-2 (1- (length calc-graph-ycacheptr))) + (while (and (cdr calc-graph-ycacheptr) + (or (not calc-graph-xhigh) + (Math-lessp (car (car calc-graph-ycacheptr)) calc-graph-xhigh))) + (setq var-DUMMY (math-div (math-add (car (car calc-graph-ycacheptr)) + (car (nth 1 calc-graph-ycacheptr))) 2) math-working-step (1+ math-working-step) - yval (math-evaluate-expr yvalue)) - (setcdr ycacheptr (cons (cons var-DUMMY yval) - (cdr ycacheptr))) - (setq ycacheptr (cdr (cdr ycacheptr)))) - (setq yp ycache - numsteps 1000000)) + calc-graph-yval (math-evaluate-expr calc-graph-yvalue)) + (setcdr calc-graph-ycacheptr (cons (cons var-DUMMY calc-graph-yval) + (cdr calc-graph-ycacheptr))) + (setq calc-graph-ycacheptr (cdr (cdr calc-graph-ycacheptr)))) + (setq calc-graph-yp calc-graph-ycache + calc-graph-numsteps 1000000)) (defun calc-graph-recompute-2d () - (setq ycacheptr ycache) - (if xvec - (setq numsteps (1- (length xvalue)) - yvector nil) - (if (and (eq (car-safe xvalue) 'intv) - (math-constp xvalue)) - (setq numsteps resolution - yp nil - xlow (nth 2 xvalue) - xhigh (nth 3 xvalue) - xstep (math-div (math-sub xhigh xlow) - (1- numsteps)) - xvalue (nth 2 xvalue)) + (setq calc-graph-ycacheptr calc-graph-ycache) + (if calc-graph-xvec + (setq calc-graph-numsteps (1- (length calc-graph-xvalue)) + calc-graph-yvector nil) + (if (and (eq (car-safe calc-graph-xvalue) 'intv) + (math-constp calc-graph-xvalue)) + (setq calc-graph-numsteps calc-graph-resolution + calc-graph-yp nil + calc-graph-xlow (nth 2 calc-graph-xvalue) + calc-graph-xhigh (nth 3 calc-graph-xvalue) + calc-graph-xstep (math-div (math-sub calc-graph-xhigh calc-graph-xlow) + (1- calc-graph-numsteps)) + calc-graph-xvalue (nth 2 calc-graph-xvalue)) (error "%s is not a suitable basis for %s" - xname yname))) - (setq math-working-step-2 numsteps) - (while (>= (setq numsteps (1- numsteps)) 0) + calc-graph-xname calc-graph-yname))) + (setq math-working-step-2 calc-graph-numsteps) + (while (>= (setq calc-graph-numsteps (1- calc-graph-numsteps)) 0) (setq math-working-step (1+ math-working-step)) - (if xvec + (if calc-graph-xvec (progn - (setq xp (cdr xp) - xval (car xp)) - (and (not (eq ycacheptr ycache)) - (consp (car ycacheptr)) - (not (Math-lessp (car (car ycacheptr)) xval)) - (setq ycacheptr ycache))) - (if (= numsteps 0) - (setq xval xhigh) ; avoid cumulative roundoff - (setq xval xvalue - xvalue (math-add xvalue xstep)))) - (while (and (cdr ycacheptr) - (Math-lessp (car (nth 1 ycacheptr)) xval)) - (setq ycacheptr (cdr ycacheptr))) - (or (and (cdr ycacheptr) - (Math-equal (car (nth 1 ycacheptr)) xval)) + (setq calc-graph-xp (cdr calc-graph-xp) + calc-graph-xval (car calc-graph-xp)) + (and (not (eq calc-graph-ycacheptr calc-graph-ycache)) + (consp (car calc-graph-ycacheptr)) + (not (Math-lessp (car (car calc-graph-ycacheptr)) calc-graph-xval)) + (setq calc-graph-ycacheptr calc-graph-ycache))) + (if (= calc-graph-numsteps 0) + (setq calc-graph-xval calc-graph-xhigh) ; avoid cumulative roundoff + (setq calc-graph-xval calc-graph-xvalue + calc-graph-xvalue (math-add calc-graph-xvalue calc-graph-xstep)))) + (while (and (cdr calc-graph-ycacheptr) + (Math-lessp (car (nth 1 calc-graph-ycacheptr)) calc-graph-xval)) + (setq calc-graph-ycacheptr (cdr calc-graph-ycacheptr))) + (or (and (cdr calc-graph-ycacheptr) + (Math-equal (car (nth 1 calc-graph-ycacheptr)) calc-graph-xval)) (progn - (setq keep-file nil - var-DUMMY xval) - (setcdr ycacheptr (cons (cons xval (math-evaluate-expr yvalue)) - (cdr ycacheptr))))) - (setq ycacheptr (cdr ycacheptr)) - (if xvec - (setq yvector (cons (cdr (car ycacheptr)) yvector)) - (or yp (setq yp ycacheptr)))) - (if xvec - (setq xp xvalue - yvec t - yp (cons 'vec (nreverse yvector)) - numsteps (1- (length xp))) - (setq numsteps 1000000))) + (setq calc-graph-keep-file nil + var-DUMMY calc-graph-xval) + (setcdr calc-graph-ycacheptr (cons (cons calc-graph-xval (math-evaluate-expr calc-graph-yvalue)) + (cdr calc-graph-ycacheptr))))) + (setq calc-graph-ycacheptr (cdr calc-graph-ycacheptr)) + (if calc-graph-xvec + (setq calc-graph-yvector (cons (cdr (car calc-graph-ycacheptr)) calc-graph-yvector)) + (or calc-graph-yp (setq calc-graph-yp calc-graph-ycacheptr)))) + (if calc-graph-xvec + (setq calc-graph-xp calc-graph-xvalue + calc-graph-yvec t + calc-graph-yp (cons 'vec (nreverse calc-graph-yvector)) + calc-graph-numsteps (1- (length calc-graph-xp))) + (setq calc-graph-numsteps 1000000))) (defun calc-graph-compute-3d () - (if (setq yvec (eq (car-safe yvalue) 'vec)) - (if (math-matrixp yvalue) + (if (setq calc-graph-yvec (eq (car-safe calc-graph-yvalue) 'vec)) + (if (math-matrixp calc-graph-yvalue) (progn - (setq numsteps (1- (length yvalue)) - numsteps3 (1- (length (nth 1 yvalue)))) - (if (eq (car-safe xvalue) 'vec) - (or (= (1- (length xvalue)) numsteps) - (error "%s has wrong length" xname)) - (if (and (eq (car-safe xvalue) 'intv) - (math-constp xvalue)) - (setq xvalue (calcFunc-index numsteps - (nth 2 xvalue) + (setq calc-graph-numsteps (1- (length calc-graph-yvalue)) + calc-graph-numsteps3 (1- (length (nth 1 calc-graph-yvalue)))) + (if (eq (car-safe calc-graph-xvalue) 'vec) + (or (= (1- (length calc-graph-xvalue)) calc-graph-numsteps) + (error "%s has wrong length" calc-graph-xname)) + (if (and (eq (car-safe calc-graph-xvalue) 'intv) + (math-constp calc-graph-xvalue)) + (setq calc-graph-xvalue (calcFunc-index calc-graph-numsteps + (nth 2 calc-graph-xvalue) (math-div - (math-sub (nth 3 xvalue) - (nth 2 xvalue)) - (1- numsteps)))) - (if (math-realp xvalue) - (setq xvalue (calcFunc-index numsteps xvalue 1)) - (error "%s is not a suitable basis for %s" xname yname)))) - (if (eq (car-safe y3value) 'vec) - (or (= (1- (length y3value)) numsteps3) - (error "%s has wrong length" y3name)) - (if (and (eq (car-safe y3value) 'intv) - (math-constp y3value)) - (setq y3value (calcFunc-index numsteps3 - (nth 2 y3value) + (math-sub (nth 3 calc-graph-xvalue) + (nth 2 calc-graph-xvalue)) + (1- calc-graph-numsteps)))) + (if (math-realp calc-graph-xvalue) + (setq calc-graph-xvalue (calcFunc-index calc-graph-numsteps calc-graph-xvalue 1)) + (error "%s is not a suitable basis for %s" calc-graph-xname calc-graph-yname)))) + (if (eq (car-safe calc-graph-y3value) 'vec) + (or (= (1- (length calc-graph-y3value)) calc-graph-numsteps3) + (error "%s has wrong length" calc-graph-y3name)) + (if (and (eq (car-safe calc-graph-y3value) 'intv) + (math-constp calc-graph-y3value)) + (setq calc-graph-y3value (calcFunc-index calc-graph-numsteps3 + (nth 2 calc-graph-y3value) (math-div - (math-sub (nth 3 y3value) - (nth 2 y3value)) - (1- numsteps3)))) - (if (math-realp y3value) - (setq y3value (calcFunc-index numsteps3 y3value 1)) - (error "%s is not a suitable basis for %s" y3name yname)))) - (setq xp nil - yp nil - zp nil - xvec t) - (while (setq xvalue (cdr xvalue) yvalue (cdr yvalue)) - (setq xp (nconc xp (make-list (1+ numsteps3) (car xvalue))) - yp (nconc yp (cons 0 (copy-sequence (cdr y3value)))) - zp (nconc zp (cons '(skip) - (copy-sequence (cdr (car yvalue))))))) - (setq numsteps (1- (* numsteps (1+ numsteps3))))) - (if (= (setq numsteps (1- (length yvalue))) 0) + (math-sub (nth 3 calc-graph-y3value) + (nth 2 calc-graph-y3value)) + (1- calc-graph-numsteps3)))) + (if (math-realp calc-graph-y3value) + (setq calc-graph-y3value (calcFunc-index calc-graph-numsteps3 calc-graph-y3value 1)) + (error "%s is not a suitable basis for %s" calc-graph-y3name calc-graph-yname)))) + (setq calc-graph-xp nil + calc-graph-yp nil + calc-graph-zp nil + calc-graph-xvec t) + (while (setq calc-graph-xvalue (cdr calc-graph-xvalue) calc-graph-yvalue (cdr calc-graph-yvalue)) + (setq calc-graph-xp (nconc calc-graph-xp (make-list (1+ calc-graph-numsteps3) (car calc-graph-xvalue))) + calc-graph-yp (nconc calc-graph-yp (cons 0 (copy-sequence (cdr calc-graph-y3value)))) + calc-graph-zp (nconc calc-graph-zp (cons '(skip) + (copy-sequence (cdr (car calc-graph-yvalue))))))) + (setq calc-graph-numsteps (1- (* calc-graph-numsteps + (1+ calc-graph-numsteps3))))) + (if (= (setq calc-graph-numsteps (1- (length calc-graph-yvalue))) 0) (error "Can't plot an empty vector")) - (or (and (eq (car-safe xvalue) 'vec) - (= (1- (length xvalue)) numsteps)) - (error "%s is not a suitable basis for %s" xname yname)) - (or (and (eq (car-safe y3value) 'vec) - (= (1- (length y3value)) numsteps)) - (error "%s is not a suitable basis for %s" y3name yname)) - (setq xp xvalue - yp y3value - zp yvalue - xvec t)) - (or (math-realp yvalue) + (or (and (eq (car-safe calc-graph-xvalue) 'vec) + (= (1- (length calc-graph-xvalue)) calc-graph-numsteps)) + (error "%s is not a suitable basis for %s" calc-graph-xname calc-graph-yname)) + (or (and (eq (car-safe calc-graph-y3value) 'vec) + (= (1- (length calc-graph-y3value)) calc-graph-numsteps)) + (error "%s is not a suitable basis for %s" calc-graph-y3name calc-graph-yname)) + (setq calc-graph-xp calc-graph-xvalue + calc-graph-yp calc-graph-y3value + calc-graph-zp calc-graph-yvalue + calc-graph-xvec t)) + (or (math-realp calc-graph-yvalue) (let ((arglist nil)) - (setq yvalue (math-evaluate-expr yvalue)) - (calc-default-formula-arglist yvalue) + (setq calc-graph-yvalue (math-evaluate-expr calc-graph-yvalue)) + (calc-default-formula-arglist calc-graph-yvalue) (setq arglist (sort arglist 'string-lessp)) (or (cdr arglist) - (error "%s does not contain enough unassigned variables" yname)) + (error "%s does not contain enough unassigned variables" calc-graph-yname)) (and (cdr (cdr arglist)) - (error "%s contains too many variables: %s" yname arglist)) - (setq yvalue (math-multi-subst yvalue + (error "%s contains too many variables: %s" calc-graph-yname arglist)) + (setq calc-graph-yvalue (math-multi-subst calc-graph-yvalue (mapcar 'math-build-var-name arglist) '((var DUMMY var-DUMMY) (var DUMMY2 var-DUMMY2)))))) - (if (setq xvec (eq (car-safe xvalue) 'vec)) - (setq numsteps (1- (length xvalue))) - (if (and (eq (car-safe xvalue) 'intv) - (math-constp xvalue)) - (setq numsteps resolution - xvalue (calcFunc-index numsteps - (nth 2 xvalue) - (math-div (math-sub (nth 3 xvalue) - (nth 2 xvalue)) - (1- numsteps)))) + (if (setq calc-graph-xvec (eq (car-safe calc-graph-xvalue) 'vec)) + (setq calc-graph-numsteps (1- (length calc-graph-xvalue))) + (if (and (eq (car-safe calc-graph-xvalue) 'intv) + (math-constp calc-graph-xvalue)) + (setq calc-graph-numsteps calc-graph-resolution + calc-graph-xvalue (calcFunc-index calc-graph-numsteps + (nth 2 calc-graph-xvalue) + (math-div (math-sub (nth 3 calc-graph-xvalue) + (nth 2 calc-graph-xvalue)) + (1- calc-graph-numsteps)))) (error "%s is not a suitable basis for %s" - xname yname))) - (if (setq y3vec (eq (car-safe y3value) 'vec)) - (setq numsteps3 (1- (length y3value))) - (if (and (eq (car-safe y3value) 'intv) - (math-constp y3value)) - (setq numsteps3 resolution - y3value (calcFunc-index numsteps3 - (nth 2 y3value) - (math-div (math-sub (nth 3 y3value) - (nth 2 y3value)) - (1- numsteps3)))) + calc-graph-xname calc-graph-yname))) + (if (eq (car-safe calc-graph-y3value) 'vec) + (setq calc-graph-numsteps3 (1- (length calc-graph-y3value))) + (if (and (eq (car-safe calc-graph-y3value) 'intv) + (math-constp calc-graph-y3value)) + (setq calc-graph-numsteps3 calc-graph-resolution + calc-graph-y3value (calcFunc-index calc-graph-numsteps3 + (nth 2 calc-graph-y3value) + (math-div (math-sub (nth 3 calc-graph-y3value) + (nth 2 calc-graph-y3value)) + (1- calc-graph-numsteps3)))) (error "%s is not a suitable basis for %s" - y3name yname))) - (setq xp nil - yp nil - zp nil - xvec t) + calc-graph-y3name calc-graph-yname))) + (setq calc-graph-xp nil + calc-graph-yp nil + calc-graph-zp nil + calc-graph-xvec t) (setq math-working-step 0) - (while (setq xvalue (cdr xvalue)) - (setq xp (nconc xp (make-list (1+ numsteps3) (car xvalue))) - yp (nconc yp (cons 0 (copy-sequence (cdr y3value)))) - zp (cons '(skip) zp) - y3step y3value - var-DUMMY (car xvalue) + (while (setq calc-graph-xvalue (cdr calc-graph-xvalue)) + (setq calc-graph-xp (nconc calc-graph-xp (make-list (1+ calc-graph-numsteps3) (car calc-graph-xvalue))) + calc-graph-yp (nconc calc-graph-yp (cons 0 (copy-sequence (cdr calc-graph-y3value)))) + calc-graph-zp (cons '(skip) calc-graph-zp) + calc-graph-y3step calc-graph-y3value + var-DUMMY (car calc-graph-xvalue) math-working-step-2 0 math-working-step (1+ math-working-step)) - (while (setq y3step (cdr y3step)) + (while (setq calc-graph-y3step (cdr calc-graph-y3step)) (setq math-working-step-2 (1+ math-working-step-2) - var-DUMMY2 (car y3step) - zp (cons (math-evaluate-expr yvalue) zp)))) - (setq zp (nreverse zp) - numsteps (1- (* numsteps (1+ numsteps3)))))) + var-DUMMY2 (car calc-graph-y3step) + calc-graph-zp (cons (math-evaluate-expr calc-graph-yvalue) calc-graph-zp)))) + (setq calc-graph-zp (nreverse calc-graph-zp) + calc-graph-numsteps (1- (* calc-graph-numsteps (1+ calc-graph-numsteps3)))))) (defun calc-graph-format-data () - (while (<= (setq stepcount (1+ stepcount)) numsteps) - (if xvec - (setq xp (cdr xp) - xval (car xp) - yp (cdr yp) - yval (car yp) - zp (cdr zp) - zval (car zp)) - (if yvec - (setq xval xvalue - xvalue (math-add xvalue xstep) - yp (cdr yp) - yval (car yp)) - (setq xval (car (car yp)) - yval (cdr (car yp)) - yp (cdr yp)) - (if (or (not yp) - (and xhigh (equal xval xhigh))) - (setq numsteps 0)))) - (if is-splot - (if (and (eq (car-safe zval) 'calcFunc-xyz) - (= (length zval) 4)) - (setq xval (nth 1 zval) - yval (nth 2 zval) - zval (nth 3 zval))) - (if (and (eq (car-safe yval) 'calcFunc-xyz) - (= (length yval) 4)) + (while (<= (setq calc-graph-stepcount (1+ calc-graph-stepcount)) calc-graph-numsteps) + (if calc-graph-xvec + (setq calc-graph-xp (cdr calc-graph-xp) + calc-graph-xval (car calc-graph-xp) + calc-graph-yp (cdr calc-graph-yp) + calc-graph-yval (car calc-graph-yp) + calc-graph-zp (cdr calc-graph-zp) + calc-graph-zval (car calc-graph-zp)) + (if calc-graph-yvec + (setq calc-graph-xval calc-graph-xvalue + calc-graph-xvalue (math-add calc-graph-xvalue calc-graph-xstep) + calc-graph-yp (cdr calc-graph-yp) + calc-graph-yval (car calc-graph-yp)) + (setq calc-graph-xval (car (car calc-graph-yp)) + calc-graph-yval (cdr (car calc-graph-yp)) + calc-graph-yp (cdr calc-graph-yp)) + (if (or (not calc-graph-yp) + (and calc-graph-xhigh (equal calc-graph-xval calc-graph-xhigh))) + (setq calc-graph-numsteps 0)))) + (if calc-graph-is-splot + (if (and (eq (car-safe calc-graph-zval) 'calcFunc-xyz) + (= (length calc-graph-zval) 4)) + (setq calc-graph-xval (nth 1 calc-graph-zval) + calc-graph-yval (nth 2 calc-graph-zval) + calc-graph-zval (nth 3 calc-graph-zval))) + (if (and (eq (car-safe calc-graph-yval) 'calcFunc-xyz) + (= (length calc-graph-yval) 4)) (progn - (or surprise-splot + (or calc-graph-surprise-splot (save-excursion (set-buffer (get-buffer-create "*Gnuplot Temp*")) (save-excursion (goto-char (point-max)) (re-search-backward "^plot[ \t]") (insert "set parametric\ns") - (setq surprise-splot t)))) - (setq xval (nth 1 yval) - zval (nth 3 yval) - yval (nth 2 yval))) - (if (and (eq (car-safe yval) 'calcFunc-xy) - (= (length yval) 3)) - (setq xval (nth 1 yval) - yval (nth 2 yval))))) - (if (and (Math-realp xval) - (Math-realp yval) - (or (not zval) (Math-realp zval))) + (setq calc-graph-surprise-splot t)))) + (setq calc-graph-xval (nth 1 calc-graph-yval) + calc-graph-zval (nth 3 calc-graph-yval) + calc-graph-yval (nth 2 calc-graph-yval))) + (if (and (eq (car-safe calc-graph-yval) 'calcFunc-xy) + (= (length calc-graph-yval) 3)) + (setq calc-graph-xval (nth 1 calc-graph-yval) + calc-graph-yval (nth 2 calc-graph-yval))))) + (if (and (Math-realp calc-graph-xval) + (Math-realp calc-graph-yval) + (or (not calc-graph-zval) (Math-realp calc-graph-zval))) (progn - (setq blank nil - non-blank t) - (if (Math-integerp xval) - (insert (math-format-number xval)) - (if (eq (car xval) 'frac) - (setq xval (math-float xval))) - (insert (math-format-number (nth 1 xval)) - "e" (int-to-string (nth 2 xval)))) + (setq calc-graph-blank nil + calc-graph-non-blank t) + (if (Math-integerp calc-graph-xval) + (insert (math-format-number calc-graph-xval)) + (if (eq (car calc-graph-xval) 'frac) + (setq calc-graph-xval (math-float calc-graph-xval))) + (insert (math-format-number (nth 1 calc-graph-xval)) + "e" (int-to-string (nth 2 calc-graph-xval)))) (insert " ") - (if (Math-integerp yval) - (insert (math-format-number yval)) - (if (eq (car yval) 'frac) - (setq yval (math-float yval))) - (insert (math-format-number (nth 1 yval)) - "e" (int-to-string (nth 2 yval)))) - (if zval + (if (Math-integerp calc-graph-yval) + (insert (math-format-number calc-graph-yval)) + (if (eq (car calc-graph-yval) 'frac) + (setq calc-graph-yval (math-float calc-graph-yval))) + (insert (math-format-number (nth 1 calc-graph-yval)) + "e" (int-to-string (nth 2 calc-graph-yval)))) + (if calc-graph-zval (progn (insert " ") - (if (Math-integerp zval) - (insert (math-format-number zval)) - (if (eq (car zval) 'frac) - (setq zval (math-float zval))) - (insert (math-format-number (nth 1 zval)) - "e" (int-to-string (nth 2 zval)))))) + (if (Math-integerp calc-graph-zval) + (insert (math-format-number calc-graph-zval)) + (if (eq (car calc-graph-zval) 'frac) + (setq calc-graph-zval (math-float calc-graph-zval))) + (insert (math-format-number (nth 1 calc-graph-zval)) + "e" (int-to-string (nth 2 calc-graph-zval)))))) (insert "\n")) - (and (not (equal zval '(skip))) - (boundp 'var-PlotRejects) + (and (not (equal calc-graph-zval '(skip))) (eq (car-safe var-PlotRejects) 'vec) (nconc var-PlotRejects (list (list 'vec - curve-num - stepcount - xval yval))) + calc-graph-curve-num + calc-graph-stepcount + calc-graph-xval calc-graph-yval))) (calc-refresh-evaltos 'var-PlotRejects)) - (or blank + (or calc-graph-blank (progn (insert "\n") - (setq blank t)))))) + (setq calc-graph-blank t)))))) (defun calc-temp-file-name (num) (while (<= (length calc-graph-file-cache) (1+ num)) @@ -859,9 +898,7 @@ (setq calc-graph-file-cache (cdr calc-graph-file-cache)))) (defun calc-graph-kill-hook () - (calc-graph-delete-temps) - (if calc-graph-prev-kill-hook - (funcall calc-graph-prev-kill-hook))) + (calc-graph-delete-temps)) (defun calc-graph-show-tty (output) "Default calc-gnuplot-plot-command for \"tty\" output mode. @@ -870,6 +907,9 @@ This is useful for tek40xx and other graphics-terminal types." nil calc-gnuplot-buffer nil "-c" (format "cat %s >/dev/tty; rm %s" output output))) +(defvar calc-dumb-map nil + "The keymap for the \"dumb\" terminal plot.") + (defun calc-graph-show-dumb (&optional output) "Default calc-gnuplot-plot-command for Pinard's \"dumb\" terminal type. This \"dumb\" driver will be present in Gnuplot 3.0." @@ -882,7 +922,6 @@ This \"dumb\" driver will be present in Gnuplot 3.0." (sleep-for 1)) (goto-char (point-max)) (re-search-backward "\f\\|^[ \t]+\\^$\\|G N U P L O T") - (setq found-pt (point)) (if (looking-at "\f") (progn (forward-char 1) @@ -898,7 +937,7 @@ This \"dumb\" driver will be present in Gnuplot 3.0." (end-of-line) (backward-char 1) (recenter '(4))) - (or (boundp 'calc-dumb-map) + (or calc-dumb-map (progn (setq calc-dumb-map (make-sparse-keymap)) (define-key calc-dumb-map "\n" 'scroll-up) @@ -1097,7 +1136,8 @@ This \"dumb\" driver will be present in Gnuplot 3.0." (or (calc-graph-find-plot nil nil) (error "No data points have been set!")) (let ((base (point)) - start) + start + end) (re-search-forward "[,\n]\\|[ \t]+with") (setq end (match-beginning 0)) (goto-char base) -- cgit v1.2.1