aboutsummaryrefslogtreecommitdiffstats
path: root/lisp/calc
diff options
context:
space:
mode:
authorKaroly Lorentey2004-11-13 18:34:40 +0000
committerKaroly Lorentey2004-11-13 18:34:40 +0000
commite417405015c93c81641f5c4a33ec898b5c353772 (patch)
tree017a980c35c8a71c372304418d151e3826f88636 /lisp/calc
parentf590a2a442d19f3a74d7bbd02bbcb4e3239f2327 (diff)
parent68d1b30d251b4771f739d20f507cd9523ae3919b (diff)
downloademacs-e417405015c93c81641f5c4a33ec898b5c353772.tar.gz
emacs-e417405015c93c81641f5c4a33ec898b5c353772.zip
Merged in changes from CVS trunk.
Patches applied: * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-673 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-674 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-675 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-676 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-677 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-678 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-679 Merge from gnus--rel--5.10 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-680 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-681 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-682 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-683 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-684 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-685 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-686 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-687 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-688 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-689 Merge from gnus--rel--5.10 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-690 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-691 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-692 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-693 Update from CVS * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-69 Merge from emacs--cvs-trunk--0 * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-70 Update from CVS * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-71 Update from CVS git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-267
Diffstat (limited to 'lisp/calc')
-rw-r--r--lisp/calc/calc-aent.el475
-rw-r--r--lisp/calc/calc-comb.el68
-rw-r--r--lisp/calc/calc-ext.el114
-rw-r--r--lisp/calc/calc-forms.el6
-rw-r--r--lisp/calc/calc-graph.el688
-rw-r--r--lisp/calc/calc-lang.el40
-rw-r--r--lisp/calc/calc-poly.el2
-rw-r--r--lisp/calc/calc-rewr.el40
-rw-r--r--lisp/calc/calc-vec.el104
-rw-r--r--lisp/calc/calc.el201
-rw-r--r--lisp/calc/calcalg2.el12
11 files changed, 914 insertions, 836 deletions
diff --git a/lisp/calc/calc-aent.el b/lisp/calc/calc-aent.el
index 2db722ccb2d..182b3b0635c 100644
--- a/lisp/calc/calc-aent.el
+++ b/lisp/calc/calc-aent.el
@@ -101,10 +101,7 @@
101 (message "Result: %s" buf))) 101 (message "Result: %s" buf)))
102 (if (eq last-command-char 10) 102 (if (eq last-command-char 10)
103 (insert shortbuf) 103 (insert shortbuf)
104 (setq kill-ring (cons shortbuf kill-ring)) 104 (kill-new shortbuf)))))
105 (when (> (length kill-ring) kill-ring-max)
106 (setcdr (nthcdr (1- kill-ring-max) kill-ring) nil))
107 (setq kill-ring-yank-pointer kill-ring)))))
108 105
109(defun calc-do-calc-eval (str separator args) 106(defun calc-do-calc-eval (str separator args)
110 (calc-check-defines) 107 (calc-check-defines)
@@ -301,10 +298,12 @@
301(defvar calc-alg-ent-esc-map nil 298(defvar calc-alg-ent-esc-map nil
302 "The keymap used for escapes in algebraic entry.") 299 "The keymap used for escapes in algebraic entry.")
303 300
301(defvar calc-alg-exp)
302
304(defun calc-do-alg-entry (&optional initial prompt no-normalize) 303(defun calc-do-alg-entry (&optional initial prompt no-normalize)
305 (let* ((calc-buffer (current-buffer)) 304 (let* ((calc-buffer (current-buffer))
306 (blink-paren-function 'calcAlg-blink-matching-open) 305 (blink-paren-function 'calcAlg-blink-matching-open)
307 (alg-exp 'error)) 306 (calc-alg-exp 'error))
308 (unless calc-alg-ent-map 307 (unless calc-alg-ent-map
309 (setq calc-alg-ent-map (copy-keymap minibuffer-local-map)) 308 (setq calc-alg-ent-map (copy-keymap minibuffer-local-map))
310 (define-key calc-alg-ent-map "'" 'calcAlg-previous) 309 (define-key calc-alg-ent-map "'" 'calcAlg-previous)
@@ -328,13 +327,13 @@
328 (let ((buf (read-from-minibuffer (or prompt "Algebraic: ") 327 (let ((buf (read-from-minibuffer (or prompt "Algebraic: ")
329 (or initial "") 328 (or initial "")
330 calc-alg-ent-map nil))) 329 calc-alg-ent-map nil)))
331 (when (eq alg-exp 'error) 330 (when (eq calc-alg-exp 'error)
332 (when (eq (car-safe (setq alg-exp (math-read-exprs buf))) 'error) 331 (when (eq (car-safe (setq calc-alg-exp (math-read-exprs buf))) 'error)
333 (setq alg-exp nil))) 332 (setq calc-alg-exp nil)))
334 (setq calc-aborted-prefix "alg'") 333 (setq calc-aborted-prefix "alg'")
335 (or no-normalize 334 (or no-normalize
336 (and alg-exp (setq alg-exp (mapcar 'calc-normalize alg-exp)))) 335 (and calc-alg-exp (setq calc-alg-exp (mapcar 'calc-normalize calc-alg-exp))))
337 alg-exp))) 336 calc-alg-exp)))
338 337
339(defun calcAlg-plus-minus () 338(defun calcAlg-plus-minus ()
340 (interactive) 339 (interactive)
@@ -364,8 +363,8 @@
364 (interactive) 363 (interactive)
365 (unwind-protect 364 (unwind-protect
366 (calcAlg-enter) 365 (calcAlg-enter)
367 (if (consp alg-exp) 366 (if (consp calc-alg-exp)
368 (progn (setq prefix-arg (length alg-exp)) 367 (progn (setq prefix-arg (length calc-alg-exp))
369 (calc-unread-command ?=))))) 368 (calc-unread-command ?=)))))
370 369
371(defun calcAlg-escape () 370(defun calcAlg-escape ()
@@ -383,8 +382,8 @@
383 (calc-minibuffer-contains 382 (calc-minibuffer-contains
384 "\\`\\([^\"]*\"[^\"]*\"\\)*[^\"]*\"[^\"]*\\'")) 383 "\\`\\([^\"]*\"[^\"]*\"\\)*[^\"]*\"[^\"]*\\'"))
385 (insert "`") 384 (insert "`")
386 (setq alg-exp (minibuffer-contents)) 385 (setq calc-alg-exp (minibuffer-contents))
387 (and (> (length alg-exp) 0) (setq calc-previous-alg-entry alg-exp)) 386 (and (> (length calc-alg-exp) 0) (setq calc-previous-alg-entry calc-alg-exp))
388 (exit-minibuffer))) 387 (exit-minibuffer)))
389 388
390(defun calcAlg-enter () 389(defun calcAlg-enter ()
@@ -402,7 +401,7 @@
402 (calc-temp-minibuffer-message 401 (calc-temp-minibuffer-message
403 (concat " [" (or (nth 2 exp) "Error") "]")) 402 (concat " [" (or (nth 2 exp) "Error") "]"))
404 (calc-clear-unread-commands)) 403 (calc-clear-unread-commands))
405 (setq alg-exp (if (calc-minibuffer-contains "\\` *\\[ *\\'") 404 (setq calc-alg-exp (if (calc-minibuffer-contains "\\` *\\[ *\\'")
406 '((incomplete vec)) 405 '((incomplete vec))
407 exp)) 406 exp))
408 (and (> (length str) 0) (setq calc-previous-alg-entry str)) 407 (and (> (length str) 0) (setq calc-previous-alg-entry str))
@@ -460,30 +459,39 @@
460 459
461;;; Algebraic expression parsing. [Public] 460;;; Algebraic expression parsing. [Public]
462 461
463(defun math-read-exprs (exp-str) 462;;; The next few variables are local to math-read-exprs (and math-read-expr)
464 (let ((exp-pos 0) 463;;; but are set in functions they call.
465 (exp-old-pos 0) 464
466 (exp-keep-spaces nil) 465(defvar math-exp-pos)
467 exp-token exp-data) 466(defvar math-exp-str)
467(defvar math-exp-old-pos)
468(defvar math-exp-token)
469(defvar math-exp-keep-spaces)
470
471(defun math-read-exprs (math-exp-str)
472 (let ((math-exp-pos 0)
473 (math-exp-old-pos 0)
474 (math-exp-keep-spaces nil)
475 math-exp-token math-expr-data)
468 (if calc-language-input-filter 476 (if calc-language-input-filter
469 (setq exp-str (funcall calc-language-input-filter exp-str))) 477 (setq math-exp-str (funcall calc-language-input-filter math-exp-str)))
470 (while (setq exp-token (string-match "\\.\\.\\([^.]\\|.[^.]\\)" exp-str)) 478 (while (setq math-exp-token (string-match "\\.\\.\\([^.]\\|.[^.]\\)" math-exp-str))
471 (setq exp-str (concat (substring exp-str 0 exp-token) "\\dots" 479 (setq math-exp-str (concat (substring math-exp-str 0 math-exp-token) "\\dots"
472 (substring exp-str (+ exp-token 2))))) 480 (substring math-exp-str (+ math-exp-token 2)))))
473 (math-build-parse-table) 481 (math-build-parse-table)
474 (math-read-token) 482 (math-read-token)
475 (let ((val (catch 'syntax (math-read-expr-list)))) 483 (let ((val (catch 'syntax (math-read-expr-list))))
476 (if (stringp val) 484 (if (stringp val)
477 (list 'error exp-old-pos val) 485 (list 'error math-exp-old-pos val)
478 (if (equal exp-token 'end) 486 (if (equal math-exp-token 'end)
479 val 487 val
480 (list 'error exp-old-pos "Syntax error")))))) 488 (list 'error math-exp-old-pos "Syntax error"))))))
481 489
482(defun math-read-expr-list () 490(defun math-read-expr-list ()
483 (let* ((exp-keep-spaces nil) 491 (let* ((math-exp-keep-spaces nil)
484 (val (list (math-read-expr-level 0))) 492 (val (list (math-read-expr-level 0)))
485 (last val)) 493 (last val))
486 (while (equal exp-data ",") 494 (while (equal math-expr-data ",")
487 (math-read-token) 495 (math-read-token)
488 (let ((rest (list (math-read-expr-level 0)))) 496 (let ((rest (list (math-read-expr-level 0))))
489 (setcdr last rest) 497 (setcdr last rest)
@@ -496,20 +504,23 @@
496(defvar calc-user-tokens nil) 504(defvar calc-user-tokens nil)
497(defvar calc-user-token-chars nil) 505(defvar calc-user-token-chars nil)
498 506
507(defvar math-toks nil
508 "Tokens to pass between math-build-parse-table and math-find-user-tokens.")
509
499(defun math-build-parse-table () 510(defun math-build-parse-table ()
500 (let ((mtab (cdr (assq nil calc-user-parse-tables))) 511 (let ((mtab (cdr (assq nil calc-user-parse-tables)))
501 (ltab (cdr (assq calc-language calc-user-parse-tables)))) 512 (ltab (cdr (assq calc-language calc-user-parse-tables))))
502 (or (and (eq mtab calc-last-main-parse-table) 513 (or (and (eq mtab calc-last-main-parse-table)
503 (eq ltab calc-last-lang-parse-table)) 514 (eq ltab calc-last-lang-parse-table))
504 (let ((p (append mtab ltab)) 515 (let ((p (append mtab ltab))
505 (toks nil)) 516 (math-toks nil))
506 (setq calc-user-parse-table p) 517 (setq calc-user-parse-table p)
507 (setq calc-user-token-chars nil) 518 (setq calc-user-token-chars nil)
508 (while p 519 (while p
509 (math-find-user-tokens (car (car p))) 520 (math-find-user-tokens (car (car p)))
510 (setq p (cdr p))) 521 (setq p (cdr p)))
511 (setq calc-user-tokens (mapconcat 'identity 522 (setq calc-user-tokens (mapconcat 'identity
512 (sort (mapcar 'car toks) 523 (sort (mapcar 'car math-toks)
513 (function (lambda (x y) 524 (function (lambda (x y)
514 (> (length x) 525 (> (length x)
515 (length y))))) 526 (length y)))))
@@ -517,7 +528,7 @@
517 calc-last-main-parse-table mtab 528 calc-last-main-parse-table mtab
518 calc-last-lang-parse-table ltab))))) 529 calc-last-lang-parse-table ltab)))))
519 530
520(defun math-find-user-tokens (p) ; uses "toks" 531(defun math-find-user-tokens (p)
521 (while p 532 (while p
522 (cond ((and (stringp (car p)) 533 (cond ((and (stringp (car p))
523 (or (> (length (car p)) 1) (equal (car p) "$") 534 (or (> (length (car p)) 1) (equal (car p) "$")
@@ -528,9 +539,9 @@
528 (setq s (concat "\\<" s))) 539 (setq s (concat "\\<" s)))
529 (if (string-match "[a-zA-Z0-9]\\'" s) 540 (if (string-match "[a-zA-Z0-9]\\'" s)
530 (setq s (concat s "\\>"))) 541 (setq s (concat s "\\>")))
531 (or (assoc s toks) 542 (or (assoc s math-toks)
532 (progn 543 (progn
533 (setq toks (cons (list s) toks)) 544 (setq math-toks (cons (list s) math-toks))
534 (or (memq (aref (car p) 0) calc-user-token-chars) 545 (or (memq (aref (car p) 0) calc-user-token-chars)
535 (setq calc-user-token-chars 546 (setq calc-user-token-chars
536 (cons (aref (car p) 0) 547 (cons (aref (car p) 0)
@@ -542,161 +553,168 @@
542 (setq p (cdr p)))) 553 (setq p (cdr p))))
543 554
544(defun math-read-token () 555(defun math-read-token ()
545 (if (>= exp-pos (length exp-str)) 556 (if (>= math-exp-pos (length math-exp-str))
546 (setq exp-old-pos exp-pos 557 (setq math-exp-old-pos math-exp-pos
547 exp-token 'end 558 math-exp-token 'end
548 exp-data "\000") 559 math-expr-data "\000")
549 (let ((ch (aref exp-str exp-pos))) 560 (let ((ch (aref math-exp-str math-exp-pos)))
550 (setq exp-old-pos exp-pos) 561 (setq math-exp-old-pos math-exp-pos)
551 (cond ((memq ch '(32 10 9)) 562 (cond ((memq ch '(32 10 9))
552 (setq exp-pos (1+ exp-pos)) 563 (setq math-exp-pos (1+ math-exp-pos))
553 (if exp-keep-spaces 564 (if math-exp-keep-spaces
554 (setq exp-token 'space 565 (setq math-exp-token 'space
555 exp-data " ") 566 math-expr-data " ")
556 (math-read-token))) 567 (math-read-token)))
557 ((and (memq ch calc-user-token-chars) 568 ((and (memq ch calc-user-token-chars)
558 (let ((case-fold-search nil)) 569 (let ((case-fold-search nil))
559 (eq (string-match calc-user-tokens exp-str exp-pos) 570 (eq (string-match calc-user-tokens math-exp-str math-exp-pos)
560 exp-pos))) 571 math-exp-pos)))
561 (setq exp-token 'punc 572 (setq math-exp-token 'punc
562 exp-data (math-match-substring exp-str 0) 573 math-expr-data (math-match-substring math-exp-str 0)
563 exp-pos (match-end 0))) 574 math-exp-pos (match-end 0)))
564 ((or (and (>= ch ?a) (<= ch ?z)) 575 ((or (and (>= ch ?a) (<= ch ?z))
565 (and (>= ch ?A) (<= ch ?Z))) 576 (and (>= ch ?A) (<= ch ?Z)))
566 (string-match (if (memq calc-language '(c fortran pascal maple)) 577 (string-match (if (memq calc-language '(c fortran pascal maple))
567 "[a-zA-Z0-9_#]*" 578 "[a-zA-Z0-9_#]*"
568 "[a-zA-Z0-9'#]*") 579 "[a-zA-Z0-9'#]*")
569 exp-str exp-pos) 580 math-exp-str math-exp-pos)
570 (setq exp-token 'symbol 581 (setq math-exp-token 'symbol
571 exp-pos (match-end 0) 582 math-exp-pos (match-end 0)
572 exp-data (math-restore-dashes 583 math-expr-data (math-restore-dashes
573 (math-match-substring exp-str 0))) 584 (math-match-substring math-exp-str 0)))
574 (if (eq calc-language 'eqn) 585 (if (eq calc-language 'eqn)
575 (let ((code (assoc exp-data math-eqn-ignore-words))) 586 (let ((code (assoc math-expr-data math-eqn-ignore-words)))
576 (cond ((null code)) 587 (cond ((null code))
577 ((null (cdr code)) 588 ((null (cdr code))
578 (math-read-token)) 589 (math-read-token))
579 ((consp (nth 1 code)) 590 ((consp (nth 1 code))
580 (math-read-token) 591 (math-read-token)
581 (if (assoc exp-data (cdr code)) 592 (if (assoc math-expr-data (cdr code))
582 (setq exp-data (format "%s %s" 593 (setq math-expr-data (format "%s %s"
583 (car code) exp-data)))) 594 (car code) math-expr-data))))
584 ((eq (nth 1 code) 'punc) 595 ((eq (nth 1 code) 'punc)
585 (setq exp-token 'punc 596 (setq math-exp-token 'punc
586 exp-data (nth 2 code))) 597 math-expr-data (nth 2 code)))
587 (t 598 (t
588 (math-read-token) 599 (math-read-token)
589 (math-read-token)))))) 600 (math-read-token))))))
590 ((or (and (>= ch ?0) (<= ch ?9)) 601 ((or (and (>= ch ?0) (<= ch ?9))
591 (and (eq ch '?\.) 602 (and (eq ch '?\.)
592 (eq (string-match "\\.[0-9]" exp-str exp-pos) exp-pos)) 603 (eq (string-match "\\.[0-9]" math-exp-str math-exp-pos)
604 math-exp-pos))
593 (and (eq ch '?_) 605 (and (eq ch '?_)
594 (eq (string-match "_\\.?[0-9]" exp-str exp-pos) exp-pos) 606 (eq (string-match "_\\.?[0-9]" math-exp-str math-exp-pos)
595 (or (eq exp-pos 0) 607 math-exp-pos)
608 (or (eq math-exp-pos 0)
596 (and (memq calc-language '(nil flat big unform 609 (and (memq calc-language '(nil flat big unform
597 tex eqn)) 610 tex eqn))
598 (eq (string-match "[^])}\"a-zA-Z0-9'$]_" 611 (eq (string-match "[^])}\"a-zA-Z0-9'$]_"
599 exp-str (1- exp-pos)) 612 math-exp-str (1- math-exp-pos))
600 (1- exp-pos)))))) 613 (1- math-exp-pos))))))
601 (or (and (eq calc-language 'c) 614 (or (and (eq calc-language 'c)
602 (string-match "0[xX][0-9a-fA-F]+" exp-str exp-pos)) 615 (string-match "0[xX][0-9a-fA-F]+" math-exp-str math-exp-pos))
603 (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)) 616 (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]+\\)?\"?\\)?"
604 (setq exp-token 'number 617 math-exp-str math-exp-pos))
605 exp-data (math-match-substring exp-str 0) 618 (setq math-exp-token 'number
606 exp-pos (match-end 0))) 619 math-expr-data (math-match-substring math-exp-str 0)
620 math-exp-pos (match-end 0)))
607 ((eq ch ?\$) 621 ((eq ch ?\$)
608 (if (and (eq calc-language 'pascal) 622 (if (and (eq calc-language 'pascal)
609 (eq (string-match 623 (eq (string-match
610 "\\(\\$[0-9a-fA-F]+\\)\\($\\|[^0-9a-zA-Z]\\)" 624 "\\(\\$[0-9a-fA-F]+\\)\\($\\|[^0-9a-zA-Z]\\)"
611 exp-str exp-pos) 625 math-exp-str math-exp-pos)
612 exp-pos)) 626 math-exp-pos))
613 (setq exp-token 'number 627 (setq math-exp-token 'number
614 exp-data (math-match-substring exp-str 1) 628 math-expr-data (math-match-substring math-exp-str 1)
615 exp-pos (match-end 1)) 629 math-exp-pos (match-end 1))
616 (if (eq (string-match "\\$\\([1-9][0-9]*\\)" exp-str exp-pos) 630 (if (eq (string-match "\\$\\([1-9][0-9]*\\)" math-exp-str math-exp-pos)
617 exp-pos) 631 math-exp-pos)
618 (setq exp-data (- (string-to-int (math-match-substring 632 (setq math-expr-data (- (string-to-int (math-match-substring
619 exp-str 1)))) 633 math-exp-str 1))))
620 (string-match "\\$+" exp-str exp-pos) 634 (string-match "\\$+" math-exp-str math-exp-pos)
621 (setq exp-data (- (match-end 0) (match-beginning 0)))) 635 (setq math-expr-data (- (match-end 0) (match-beginning 0))))
622 (setq exp-token 'dollar 636 (setq math-exp-token 'dollar
623 exp-pos (match-end 0)))) 637 math-exp-pos (match-end 0))))
624 ((eq ch ?\#) 638 ((eq ch ?\#)
625 (if (eq (string-match "#\\([1-9][0-9]*\\)" exp-str exp-pos) 639 (if (eq (string-match "#\\([1-9][0-9]*\\)" math-exp-str math-exp-pos)
626 exp-pos) 640 math-exp-pos)
627 (setq exp-data (string-to-int 641 (setq math-expr-data (string-to-int
628 (math-match-substring exp-str 1)) 642 (math-match-substring math-exp-str 1))
629 exp-pos (match-end 0)) 643 math-exp-pos (match-end 0))
630 (setq exp-data 1 644 (setq math-expr-data 1
631 exp-pos (1+ exp-pos))) 645 math-exp-pos (1+ math-exp-pos)))
632 (setq exp-token 'hash)) 646 (setq math-exp-token 'hash))
633 ((eq (string-match "~=\\|<=\\|>=\\|<>\\|/=\\|\\+/-\\|\\\\dots\\|\\\\ldots\\|\\*\\*\\|<<\\|>>\\|==\\|!=\\|&&&\\||||\\|!!!\\|&&\\|||\\|!!\\|:=\\|::\\|=>" 647 ((eq (string-match "~=\\|<=\\|>=\\|<>\\|/=\\|\\+/-\\|\\\\dots\\|\\\\ldots\\|\\*\\*\\|<<\\|>>\\|==\\|!=\\|&&&\\||||\\|!!!\\|&&\\|||\\|!!\\|:=\\|::\\|=>"
634 exp-str exp-pos) 648 math-exp-str math-exp-pos)
635 exp-pos) 649 math-exp-pos)
636 (setq exp-token 'punc 650 (setq math-exp-token 'punc
637 exp-data (math-match-substring exp-str 0) 651 math-expr-data (math-match-substring math-exp-str 0)
638 exp-pos (match-end 0))) 652 math-exp-pos (match-end 0)))
639 ((and (eq ch ?\") 653 ((and (eq ch ?\")
640 (string-match "\\(\"\\([^\"\\]\\|\\\\.\\)*\\)\\(\"\\|\\'\\)" exp-str exp-pos)) 654 (string-match "\\(\"\\([^\"\\]\\|\\\\.\\)*\\)\\(\"\\|\\'\\)"
655 math-exp-str math-exp-pos))
641 (if (eq calc-language 'eqn) 656 (if (eq calc-language 'eqn)
642 (progn 657 (progn
643 (setq exp-str (copy-sequence exp-str)) 658 (setq math-exp-str (copy-sequence math-exp-str))
644 (aset exp-str (match-beginning 1) ?\{) 659 (aset math-exp-str (match-beginning 1) ?\{)
645 (if (< (match-end 1) (length exp-str)) 660 (if (< (match-end 1) (length math-exp-str))
646 (aset exp-str (match-end 1) ?\})) 661 (aset math-exp-str (match-end 1) ?\}))
647 (math-read-token)) 662 (math-read-token))
648 (setq exp-token 'string 663 (setq math-exp-token 'string
649 exp-data (math-match-substring exp-str 1) 664 math-expr-data (math-match-substring math-exp-str 1)
650 exp-pos (match-end 0)))) 665 math-exp-pos (match-end 0))))
651 ((and (= ch ?\\) (eq calc-language 'tex) 666 ((and (= ch ?\\) (eq calc-language 'tex)
652 (< exp-pos (1- (length exp-str)))) 667 (< math-exp-pos (1- (length math-exp-str))))
653 (or (string-match "\\\\hbox *{\\([a-zA-Z0-9]+\\)}" exp-str exp-pos) 668 (or (string-match "\\\\hbox *{\\([a-zA-Z0-9]+\\)}"
654 (string-match "\\(\\\\\\([a-zA-Z]+\\|[^a-zA-Z]\\)\\)" exp-str exp-pos)) 669 math-exp-str math-exp-pos)
655 (setq exp-token 'symbol 670 (string-match "\\(\\\\\\([a-zA-Z]+\\|[^a-zA-Z]\\)\\)"
656 exp-pos (match-end 0) 671 math-exp-str math-exp-pos))
657 exp-data (math-restore-dashes 672 (setq math-exp-token 'symbol
658 (math-match-substring exp-str 1))) 673 math-exp-pos (match-end 0)
659 (let ((code (assoc exp-data math-tex-ignore-words))) 674 math-expr-data (math-restore-dashes
675 (math-match-substring math-exp-str 1)))
676 (let ((code (assoc math-expr-data math-tex-ignore-words)))
660 (cond ((null code)) 677 (cond ((null code))
661 ((null (cdr code)) 678 ((null (cdr code))
662 (math-read-token)) 679 (math-read-token))
663 ((eq (nth 1 code) 'punc) 680 ((eq (nth 1 code) 'punc)
664 (setq exp-token 'punc 681 (setq math-exp-token 'punc
665 exp-data (nth 2 code))) 682 math-expr-data (nth 2 code)))
666 ((and (eq (nth 1 code) 'mat) 683 ((and (eq (nth 1 code) 'mat)
667 (string-match " *{" exp-str exp-pos)) 684 (string-match " *{" math-exp-str math-exp-pos))
668 (setq exp-pos (match-end 0) 685 (setq math-exp-pos (match-end 0)
669 exp-token 'punc 686 math-exp-token 'punc
670 exp-data "[") 687 math-expr-data "[")
671 (let ((right (string-match "}" exp-str exp-pos))) 688 (let ((right (string-match "}" math-exp-str math-exp-pos)))
672 (and right 689 (and right
673 (setq exp-str (copy-sequence exp-str)) 690 (setq math-exp-str (copy-sequence math-exp-str))
674 (aset exp-str right ?\]))))))) 691 (aset math-exp-str right ?\])))))))
675 ((and (= ch ?\.) (eq calc-language 'fortran) 692 ((and (= ch ?\.) (eq calc-language 'fortran)
676 (eq (string-match "\\.[a-zA-Z][a-zA-Z][a-zA-Z]?\\." 693 (eq (string-match "\\.[a-zA-Z][a-zA-Z][a-zA-Z]?\\."
677 exp-str exp-pos) exp-pos)) 694 math-exp-str math-exp-pos) math-exp-pos))
678 (setq exp-token 'punc 695 (setq math-exp-token 'punc
679 exp-data (upcase (math-match-substring exp-str 0)) 696 math-expr-data (upcase (math-match-substring math-exp-str 0))
680 exp-pos (match-end 0))) 697 math-exp-pos (match-end 0)))
681 ((and (eq calc-language 'math) 698 ((and (eq calc-language 'math)
682 (eq (string-match "\\[\\[\\|->\\|:>" exp-str exp-pos) 699 (eq (string-match "\\[\\[\\|->\\|:>" math-exp-str math-exp-pos)
683 exp-pos)) 700 math-exp-pos))
684 (setq exp-token 'punc 701 (setq math-exp-token 'punc
685 exp-data (math-match-substring exp-str 0) 702 math-expr-data (math-match-substring math-exp-str 0)
686 exp-pos (match-end 0))) 703 math-exp-pos (match-end 0)))
687 ((and (eq calc-language 'eqn) 704 ((and (eq calc-language 'eqn)
688 (eq (string-match "->\\|<-\\|+-\\|\\\\dots\\|~\\|\\^" 705 (eq (string-match "->\\|<-\\|+-\\|\\\\dots\\|~\\|\\^"
689 exp-str exp-pos) 706 math-exp-str math-exp-pos)
690 exp-pos)) 707 math-exp-pos))
691 (setq exp-token 'punc 708 (setq math-exp-token 'punc
692 exp-data (math-match-substring exp-str 0) 709 math-expr-data (math-match-substring math-exp-str 0)
693 exp-pos (match-end 0)) 710 math-exp-pos (match-end 0))
694 (and (eq (string-match "\\\\dots\\." exp-str exp-pos) exp-pos) 711 (and (eq (string-match "\\\\dots\\." math-exp-str math-exp-pos)
695 (setq exp-pos (match-end 0))) 712 math-exp-pos)
696 (if (memq (aref exp-data 0) '(?~ ?^)) 713 (setq math-exp-pos (match-end 0)))
714 (if (memq (aref math-expr-data 0) '(?~ ?^))
697 (math-read-token))) 715 (math-read-token)))
698 ((eq (string-match "%%.*$" exp-str exp-pos) exp-pos) 716 ((eq (string-match "%%.*$" math-exp-str math-exp-pos) math-exp-pos)
699 (setq exp-pos (match-end 0)) 717 (setq math-exp-pos (match-end 0))
700 (math-read-token)) 718 (math-read-token))
701 (t 719 (t
702 (if (and (eq ch ?\{) (memq calc-language '(tex eqn))) 720 (if (and (eq ch ?\{) (memq calc-language '(tex eqn)))
@@ -705,9 +723,9 @@
705 (setq ch ?\))) 723 (setq ch ?\)))
706 (if (and (eq ch ?\&) (eq calc-language 'tex)) 724 (if (and (eq ch ?\&) (eq calc-language 'tex))
707 (setq ch ?\,)) 725 (setq ch ?\,))
708 (setq exp-token 'punc 726 (setq math-exp-token 'punc
709 exp-data (char-to-string ch) 727 math-expr-data (char-to-string ch)
710 exp-pos (1+ exp-pos))))))) 728 math-exp-pos (1+ math-exp-pos)))))))
711 729
712 730
713(defun math-read-expr-level (exp-prec &optional exp-term) 731(defun math-read-expr-level (exp-prec &optional exp-term)
@@ -716,10 +734,10 @@
716 (setq op (calc-check-user-syntax x exp-prec)) 734 (setq op (calc-check-user-syntax x exp-prec))
717 (setq x op 735 (setq x op
718 op '("2x" ident 999999 -1))) 736 op '("2x" ident 999999 -1)))
719 (and (setq op (assoc exp-data math-expr-opers)) 737 (and (setq op (assoc math-expr-data math-expr-opers))
720 (/= (nth 2 op) -1) 738 (/= (nth 2 op) -1)
721 (or (and (setq op2 (assoc 739 (or (and (setq op2 (assoc
722 exp-data 740 math-expr-data
723 (cdr (memq op math-expr-opers)))) 741 (cdr (memq op math-expr-opers))))
724 (eq (= (nth 3 op) -1) 742 (eq (= (nth 3 op) -1)
725 (/= (nth 3 op2) -1)) 743 (/= (nth 3 op2) -1))
@@ -728,27 +746,27 @@
728 (setq op op2)) 746 (setq op op2))
729 t)) 747 t))
730 (and (or (eq (nth 2 op) -1) 748 (and (or (eq (nth 2 op) -1)
731 (memq exp-token '(symbol number dollar hash)) 749 (memq math-exp-token '(symbol number dollar hash))
732 (equal exp-data "(") 750 (equal math-expr-data "(")
733 (and (equal exp-data "[") 751 (and (equal math-expr-data "[")
734 (not (eq calc-language 'math)) 752 (not (eq calc-language 'math))
735 (not (and exp-keep-spaces 753 (not (and math-exp-keep-spaces
736 (eq (car-safe x) 'vec))))) 754 (eq (car-safe x) 'vec)))))
737 (or (not (setq op (assoc exp-data math-expr-opers))) 755 (or (not (setq op (assoc math-expr-data math-expr-opers)))
738 (/= (nth 2 op) -1)) 756 (/= (nth 2 op) -1))
739 (or (not calc-user-parse-table) 757 (or (not calc-user-parse-table)
740 (not (eq exp-token 'symbol)) 758 (not (eq math-exp-token 'symbol))
741 (let ((p calc-user-parse-table)) 759 (let ((p calc-user-parse-table))
742 (while (and p 760 (while (and p
743 (or (not (integerp 761 (or (not (integerp
744 (car (car (car p))))) 762 (car (car (car p)))))
745 (not (equal 763 (not (equal
746 (nth 1 (car (car p))) 764 (nth 1 (car (car p)))
747 exp-data)))) 765 math-expr-data))))
748 (setq p (cdr p))) 766 (setq p (cdr p)))
749 (not p))) 767 (not p)))
750 (setq op (assoc "2x" math-expr-opers)))) 768 (setq op (assoc "2x" math-expr-opers))))
751 (not (and exp-term (equal exp-data exp-term))) 769 (not (and exp-term (equal math-expr-data exp-term)))
752 (>= (nth 2 op) exp-prec)) 770 (>= (nth 2 op) exp-prec))
753 (if (not (equal (car op) "2x")) 771 (if (not (equal (car op) "2x"))
754 (math-read-token)) 772 (math-read-token))
@@ -787,13 +805,13 @@
787 (if x 805 (if x
788 (and (integerp (car rule)) 806 (and (integerp (car rule))
789 (>= (car rule) prec) 807 (>= (car rule) prec)
790 (equal exp-data 808 (equal math-expr-data
791 (car (setq rule (cdr rule))))) 809 (car (setq rule (cdr rule)))))
792 (equal exp-data (car rule))))) 810 (equal math-expr-data (car rule)))))
793 (let ((save-exp-pos exp-pos) 811 (let ((save-exp-pos math-exp-pos)
794 (save-exp-old-pos exp-old-pos) 812 (save-exp-old-pos math-exp-old-pos)
795 (save-exp-token exp-token) 813 (save-exp-token math-exp-token)
796 (save-exp-data exp-data)) 814 (save-exp-data math-expr-data))
797 (or (not (listp 815 (or (not (listp
798 (setq matches (calc-match-user-syntax rule)))) 816 (setq matches (calc-match-user-syntax rule))))
799 (let ((args (progn 817 (let ((args (progn
@@ -856,22 +874,23 @@
856 (if match 874 (if match
857 (not (setq match (math-multi-subst 875 (not (setq match (math-multi-subst
858 match args matches))) 876 match args matches)))
859 (setq exp-old-pos save-exp-old-pos 877 (setq math-exp-old-pos save-exp-old-pos
860 exp-token save-exp-token 878 math-exp-token save-exp-token
861 exp-data save-exp-data 879 math-expr-data save-exp-data
862 exp-pos save-exp-pos))))))) 880 math-exp-pos save-exp-pos)))))))
863 (setq p (cdr p))) 881 (setq p (cdr p)))
864 (and p match))) 882 (and p match)))
865 883
866(defun calc-match-user-syntax (p &optional term) 884(defun calc-match-user-syntax (p &optional term)
867 (let ((matches nil) 885 (let ((matches nil)
868 (save-exp-pos exp-pos) 886 (save-exp-pos math-exp-pos)
869 (save-exp-old-pos exp-old-pos) 887 (save-exp-old-pos math-exp-old-pos)
870 (save-exp-token exp-token) 888 (save-exp-token math-exp-token)
871 (save-exp-data exp-data)) 889 (save-exp-data math-expr-data)
890 m)
872 (while (and p 891 (while (and p
873 (cond ((stringp (car p)) 892 (cond ((stringp (car p))
874 (and (equal exp-data (car p)) 893 (and (equal math-expr-data (car p))
875 (progn 894 (progn
876 (math-read-token) 895 (math-read-token)
877 t))) 896 t)))
@@ -895,7 +914,7 @@
895 (cons 'vec (and (listp m) m)))))) 914 (cons 'vec (and (listp m) m))))))
896 (or (listp m) (not (nth 2 (car p))) 915 (or (listp m) (not (nth 2 (car p)))
897 (not (eq (aref (car (nth 2 (car p))) 0) ?\$)) 916 (not (eq (aref (car (nth 2 (car p))) 0) ?\$))
898 (eq exp-token 'end))) 917 (eq math-exp-token 'end)))
899 (t 918 (t
900 (setq m (calc-match-user-syntax (nth 1 (car p)) 919 (setq m (calc-match-user-syntax (nth 1 (car p))
901 (car (nth 2 (car p))))) 920 (car (nth 2 (car p)))))
@@ -903,22 +922,22 @@
903 (let ((vec (cons 'vec m)) 922 (let ((vec (cons 'vec m))
904 opos mm) 923 opos mm)
905 (while (and (listp 924 (while (and (listp
906 (setq opos exp-pos 925 (setq opos math-exp-pos
907 mm (calc-match-user-syntax 926 mm (calc-match-user-syntax
908 (or (nth 2 (car p)) 927 (or (nth 2 (car p))
909 (nth 1 (car p))) 928 (nth 1 (car p)))
910 (car (nth 2 (car p)))))) 929 (car (nth 2 (car p))))))
911 (> exp-pos opos)) 930 (> math-exp-pos opos))
912 (setq vec (nconc vec mm))) 931 (setq vec (nconc vec mm)))
913 (setq matches (nconc matches (list vec)))) 932 (setq matches (nconc matches (list vec))))
914 (and (eq (car (car p)) '*) 933 (and (eq (car (car p)) '*)
915 (setq matches (nconc matches (list '(vec))))))))) 934 (setq matches (nconc matches (list '(vec)))))))))
916 (setq p (cdr p))) 935 (setq p (cdr p)))
917 (if p 936 (if p
918 (setq exp-pos save-exp-pos 937 (setq math-exp-pos save-exp-pos
919 exp-old-pos save-exp-old-pos 938 math-exp-old-pos save-exp-old-pos
920 exp-token save-exp-token 939 math-exp-token save-exp-token
921 exp-data save-exp-data 940 math-expr-data save-exp-data
922 matches "Failed")) 941 matches "Failed"))
923 matches)) 942 matches))
924 943
@@ -940,28 +959,28 @@
940 959
941(defun math-read-if (cond op) 960(defun math-read-if (cond op)
942 (let ((then (math-read-expr-level 0))) 961 (let ((then (math-read-expr-level 0)))
943 (or (equal exp-data ":") 962 (or (equal math-expr-data ":")
944 (throw 'syntax "Expected ':'")) 963 (throw 'syntax "Expected ':'"))
945 (math-read-token) 964 (math-read-token)
946 (list 'calcFunc-if cond then (math-read-expr-level (nth 3 op))))) 965 (list 'calcFunc-if cond then (math-read-expr-level (nth 3 op)))))
947 966
948(defun math-factor-after () 967(defun math-factor-after ()
949 (let ((exp-pos exp-pos) 968 (let ((math-exp-pos math-exp-pos)
950 exp-old-pos exp-token exp-data) 969 math-exp-old-pos math-exp-token math-expr-data)
951 (math-read-token) 970 (math-read-token)
952 (or (memq exp-token '(number symbol dollar hash string)) 971 (or (memq math-exp-token '(number symbol dollar hash string))
953 (and (assoc exp-data '(("-") ("+") ("!") ("|") ("/"))) 972 (and (assoc math-expr-data '(("-") ("+") ("!") ("|") ("/")))
954 (assoc (concat "u" exp-data) math-expr-opers)) 973 (assoc (concat "u" math-expr-data) math-expr-opers))
955 (eq (nth 2 (assoc exp-data math-expr-opers)) -1) 974 (eq (nth 2 (assoc math-expr-data math-expr-opers)) -1)
956 (assoc exp-data '(("(") ("[") ("{")))))) 975 (assoc math-expr-data '(("(") ("[") ("{"))))))
957 976
958(defun math-read-factor () 977(defun math-read-factor ()
959 (let (op) 978 (let (op)
960 (cond ((eq exp-token 'number) 979 (cond ((eq math-exp-token 'number)
961 (let ((num (math-read-number exp-data))) 980 (let ((num (math-read-number math-expr-data)))
962 (if (not num) 981 (if (not num)
963 (progn 982 (progn
964 (setq exp-old-pos exp-pos) 983 (setq math-exp-old-pos math-exp-pos)
965 (throw 'syntax "Bad format"))) 984 (throw 'syntax "Bad format")))
966 (math-read-token) 985 (math-read-token)
967 (if (and math-read-expr-quotes 986 (if (and math-read-expr-quotes
@@ -971,14 +990,14 @@
971 ((and calc-user-parse-table 990 ((and calc-user-parse-table
972 (setq op (calc-check-user-syntax))) 991 (setq op (calc-check-user-syntax)))
973 op) 992 op)
974 ((or (equal exp-data "-") 993 ((or (equal math-expr-data "-")
975 (equal exp-data "+") 994 (equal math-expr-data "+")
976 (equal exp-data "!") 995 (equal math-expr-data "!")
977 (equal exp-data "|") 996 (equal math-expr-data "|")
978 (equal exp-data "/")) 997 (equal math-expr-data "/"))
979 (setq exp-data (concat "u" exp-data)) 998 (setq math-expr-data (concat "u" math-expr-data))
980 (math-read-factor)) 999 (math-read-factor))
981 ((and (setq op (assoc exp-data math-expr-opers)) 1000 ((and (setq op (assoc math-expr-data math-expr-opers))
982 (eq (nth 2 op) -1)) 1001 (eq (nth 2 op) -1))
983 (if (consp (nth 1 op)) 1002 (if (consp (nth 1 op))
984 (funcall (car (nth 1 op)) op) 1003 (funcall (car (nth 1 op)) op)
@@ -990,20 +1009,20 @@
990 (equal (car op) "u-")) 1009 (equal (car op) "u-"))
991 (math-neg val)) 1010 (math-neg val))
992 (t (list (nth 1 op) val)))))) 1011 (t (list (nth 1 op) val))))))
993 ((eq exp-token 'symbol) 1012 ((eq math-exp-token 'symbol)
994 (let ((sym (intern exp-data))) 1013 (let ((sym (intern math-expr-data)))
995 (math-read-token) 1014 (math-read-token)
996 (if (equal exp-data calc-function-open) 1015 (if (equal math-expr-data calc-function-open)
997 (let ((f (assq sym math-expr-function-mapping))) 1016 (let ((f (assq sym math-expr-function-mapping)))
998 (math-read-token) 1017 (math-read-token)
999 (if (consp (cdr f)) 1018 (if (consp (cdr f))
1000 (funcall (car (cdr f)) f sym) 1019 (funcall (car (cdr f)) f sym)
1001 (let ((args (if (or (equal exp-data calc-function-close) 1020 (let ((args (if (or (equal math-expr-data calc-function-close)
1002 (eq exp-token 'end)) 1021 (eq math-exp-token 'end))
1003 nil 1022 nil
1004 (math-read-expr-list)))) 1023 (math-read-expr-list))))
1005 (if (not (or (equal exp-data calc-function-close) 1024 (if (not (or (equal math-expr-data calc-function-close)
1006 (eq exp-token 'end))) 1025 (eq math-exp-token 'end)))
1007 (throw 'syntax "Expected `)'")) 1026 (throw 'syntax "Expected `)'"))
1008 (math-read-token) 1027 (math-read-token)
1009 (if (and (eq calc-language 'fortran) args 1028 (if (and (eq calc-language 'fortran) args
@@ -1045,44 +1064,44 @@
1045 4)) 1064 4))
1046 (cdr v)))))) 1065 (cdr v))))))
1047 (while (and (memq calc-language '(c pascal maple)) 1066 (while (and (memq calc-language '(c pascal maple))
1048 (equal exp-data "[")) 1067 (equal math-expr-data "["))
1049 (math-read-token) 1068 (math-read-token)
1050 (setq val (append (list 'calcFunc-subscr val) 1069 (setq val (append (list 'calcFunc-subscr val)
1051 (math-read-expr-list))) 1070 (math-read-expr-list)))
1052 (if (equal exp-data "]") 1071 (if (equal math-expr-data "]")
1053 (math-read-token) 1072 (math-read-token)
1054 (throw 'syntax "Expected ']'"))) 1073 (throw 'syntax "Expected ']'")))
1055 val))))) 1074 val)))))
1056 ((eq exp-token 'dollar) 1075 ((eq math-exp-token 'dollar)
1057 (let ((abs (if (> exp-data 0) exp-data (- exp-data)))) 1076 (let ((abs (if (> math-expr-data 0) math-expr-data (- math-expr-data))))
1058 (if (>= (length calc-dollar-values) abs) 1077 (if (>= (length calc-dollar-values) abs)
1059 (let ((num exp-data)) 1078 (let ((num math-expr-data))
1060 (math-read-token) 1079 (math-read-token)
1061 (setq calc-dollar-used (max calc-dollar-used num)) 1080 (setq calc-dollar-used (max calc-dollar-used num))
1062 (math-check-complete (nth (1- abs) calc-dollar-values))) 1081 (math-check-complete (nth (1- abs) calc-dollar-values)))
1063 (throw 'syntax (if calc-dollar-values 1082 (throw 'syntax (if calc-dollar-values
1064 "Too many $'s" 1083 "Too many $'s"
1065 "$'s not allowed in this context"))))) 1084 "$'s not allowed in this context")))))
1066 ((eq exp-token 'hash) 1085 ((eq math-exp-token 'hash)
1067 (or calc-hashes-used 1086 (or calc-hashes-used
1068 (throw 'syntax "#'s not allowed in this context")) 1087 (throw 'syntax "#'s not allowed in this context"))
1069 (calc-extensions) 1088 (calc-extensions)
1070 (if (<= exp-data (length calc-arg-values)) 1089 (if (<= math-expr-data (length calc-arg-values))
1071 (let ((num exp-data)) 1090 (let ((num math-expr-data))
1072 (math-read-token) 1091 (math-read-token)
1073 (setq calc-hashes-used (max calc-hashes-used num)) 1092 (setq calc-hashes-used (max calc-hashes-used num))
1074 (nth (1- num) calc-arg-values)) 1093 (nth (1- num) calc-arg-values))
1075 (throw 'syntax "Too many # arguments"))) 1094 (throw 'syntax "Too many # arguments")))
1076 ((equal exp-data "(") 1095 ((equal math-expr-data "(")
1077 (let* ((exp (let ((exp-keep-spaces nil)) 1096 (let* ((exp (let ((math-exp-keep-spaces nil))
1078 (math-read-token) 1097 (math-read-token)
1079 (if (or (equal exp-data "\\dots") 1098 (if (or (equal math-expr-data "\\dots")
1080 (equal exp-data "\\ldots")) 1099 (equal math-expr-data "\\ldots"))
1081 '(neg (var inf var-inf)) 1100 '(neg (var inf var-inf))
1082 (math-read-expr-level 0))))) 1101 (math-read-expr-level 0)))))
1083 (let ((exp-keep-spaces nil)) 1102 (let ((math-exp-keep-spaces nil))
1084 (cond 1103 (cond
1085 ((equal exp-data ",") 1104 ((equal math-expr-data ",")
1086 (progn 1105 (progn
1087 (math-read-token) 1106 (math-read-token)
1088 (let ((exp2 (math-read-expr-level 0))) 1107 (let ((exp2 (math-read-expr-level 0)))
@@ -1090,7 +1109,7 @@
1090 (if (and exp2 (Math-realp exp) (Math-realp exp2)) 1109 (if (and exp2 (Math-realp exp) (Math-realp exp2))
1091 (math-normalize (list 'cplx exp exp2)) 1110 (math-normalize (list 'cplx exp exp2))
1092 (list '+ exp (list '* exp2 '(var i var-i)))))))) 1111 (list '+ exp (list '* exp2 '(var i var-i))))))))
1093 ((equal exp-data ";") 1112 ((equal math-expr-data ";")
1094 (progn 1113 (progn
1095 (math-read-token) 1114 (math-read-token)
1096 (let ((exp2 (math-read-expr-level 0))) 1115 (let ((exp2 (math-read-expr-level 0)))
@@ -1103,36 +1122,36 @@
1103 (list '* 1122 (list '*
1104 (math-to-radians-2 exp2) 1123 (math-to-radians-2 exp2)
1105 '(var i var-i))))))))) 1124 '(var i var-i)))))))))
1106 ((or (equal exp-data "\\dots") 1125 ((or (equal math-expr-data "\\dots")
1107 (equal exp-data "\\ldots")) 1126 (equal math-expr-data "\\ldots"))
1108 (progn 1127 (progn
1109 (math-read-token) 1128 (math-read-token)
1110 (let ((exp2 (if (or (equal exp-data ")") 1129 (let ((exp2 (if (or (equal math-expr-data ")")
1111 (equal exp-data "]") 1130 (equal math-expr-data "]")
1112 (eq exp-token 'end)) 1131 (eq math-exp-token 'end))
1113 '(var inf var-inf) 1132 '(var inf var-inf)
1114 (math-read-expr-level 0)))) 1133 (math-read-expr-level 0))))
1115 (setq exp 1134 (setq exp
1116 (list 'intv 1135 (list 'intv
1117 (if (equal exp-data ")") 0 1) 1136 (if (equal math-expr-data ")") 0 1)
1118 exp 1137 exp
1119 exp2))))))) 1138 exp2)))))))
1120 (if (not (or (equal exp-data ")") 1139 (if (not (or (equal math-expr-data ")")
1121 (and (equal exp-data "]") (eq (car-safe exp) 'intv)) 1140 (and (equal math-expr-data "]") (eq (car-safe exp) 'intv))
1122 (eq exp-token 'end))) 1141 (eq math-exp-token 'end)))
1123 (throw 'syntax "Expected `)'")) 1142 (throw 'syntax "Expected `)'"))
1124 (math-read-token) 1143 (math-read-token)
1125 exp)) 1144 exp))
1126 ((eq exp-token 'string) 1145 ((eq math-exp-token 'string)
1127 (calc-extensions) 1146 (calc-extensions)
1128 (math-read-string)) 1147 (math-read-string))
1129 ((equal exp-data "[") 1148 ((equal math-expr-data "[")
1130 (calc-extensions) 1149 (calc-extensions)
1131 (math-read-brackets t "]")) 1150 (math-read-brackets t "]"))
1132 ((equal exp-data "{") 1151 ((equal math-expr-data "{")
1133 (calc-extensions) 1152 (calc-extensions)
1134 (math-read-brackets nil "}")) 1153 (math-read-brackets nil "}"))
1135 ((equal exp-data "<") 1154 ((equal math-expr-data "<")
1136 (calc-extensions) 1155 (calc-extensions)
1137 (math-read-angle-brackets)) 1156 (math-read-angle-brackets))
1138 (t (throw 'syntax "Expected a number"))))) 1157 (t (throw 'syntax "Expected a number")))))
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 @@
82 4877 4889 4903 4909 4919 4931 4933 4937 4943 4951 4957 4967 4969 4973 82 4877 4889 4903 4909 4919 4931 4933 4937 4943 4951 4957 4967 4969 4973
83 4987 4993 4999 5003]) 83 4987 4993 4999 5003])
84 84
85;; The variable math-prime-factors-finished is set by calcFunc-prfac to
86;; indicate whether factoring is complete, and used by calcFunc-factors,
87;; calcFunc-totient and calcFunc-moebius.
88(defvar math-prime-factors-finished)
89
85;;; Combinatorics 90;;; Combinatorics
86 91
87(defun calc-gcd (arg) 92(defun calc-gcd (arg)
@@ -195,6 +200,8 @@
195 (res (math-prime-test n iters))) 200 (res (math-prime-test n iters)))
196 (calc-report-prime-test res)))) 201 (calc-report-prime-test res))))
197 202
203(defvar calc-verbose-nextprime nil)
204
198(defun calc-next-prime (iters) 205(defun calc-next-prime (iters)
199 (interactive "p") 206 (interactive "p")
200 (calc-slow-wrapper 207 (calc-slow-wrapper
@@ -386,7 +393,7 @@
386 (if (math-evenp temp) 393 (if (math-evenp temp)
387 even 394 even
388 (math-div (calcFunc-fact n) even)))) 395 (math-div (calcFunc-fact n) even))))
389 (list 'calcFunc-dfact max)))) 396 (list 'calcFunc-dfact n))))
390 ((equal n '(var inf var-inf)) n) 397 ((equal n '(var inf var-inf)) n)
391 (t (calc-record-why 'natnump n) 398 (t (calc-record-why 'natnump n)
392 (list 'calcFunc-dfact n)))) 399 (list 'calcFunc-dfact n))))
@@ -484,6 +491,12 @@
484 (math-stirling-number n m 0)) 491 (math-stirling-number n m 0))
485 492
486(defvar math-stirling-cache (vector [[1]] [[1]])) 493(defvar math-stirling-cache (vector [[1]] [[1]]))
494
495;; The variable math-stirling-local-cache is local to
496;; math-stirling-number, but is used by math-stirling-1
497;; and math-stirling-2, which are called by math-stirling-number.
498(defvar math-stirling-local-cache)
499
487(defun math-stirling-number (n m k) 500(defun math-stirling-number (n m k)
488 (or (math-num-natnump n) (math-reject-arg n 'natnump)) 501 (or (math-num-natnump n) (math-reject-arg n 'natnump))
489 (or (math-num-natnump m) (math-reject-arg m 'natnump)) 502 (or (math-num-natnump m) (math-reject-arg m 'natnump))
@@ -493,14 +506,16 @@
493 (or (integerp m) (math-reject-arg m 'fixnump)) 506 (or (integerp m) (math-reject-arg m 'fixnump))
494 (if (< n m) 507 (if (< n m)
495 0 508 0
496 (let ((cache (aref math-stirling-cache k))) 509 (let ((math-stirling-local-cache (aref math-stirling-cache k)))
497 (while (<= (length cache) n) 510 (while (<= (length math-stirling-local-cache) n)
498 (let ((i (1- (length cache))) 511 (let ((i (1- (length math-stirling-local-cache)))
499 row) 512 row)
500 (setq cache (vconcat cache (make-vector (length cache) nil))) 513 (setq math-stirling-local-cache
501 (aset math-stirling-cache k cache) 514 (vconcat math-stirling-local-cache
502 (while (< (setq i (1+ i)) (length cache)) 515 (make-vector (length math-stirling-local-cache) nil)))
503 (aset cache i (setq row (make-vector (1+ i) nil))) 516 (aset math-stirling-cache k math-stirling-local-cache)
517 (while (< (setq i (1+ i)) (length math-stirling-local-cache))
518 (aset math-stirling-local-cache i (setq row (make-vector (1+ i) nil)))
504 (aset row 0 0) 519 (aset row 0 0)
505 (aset row i 1)))) 520 (aset row i 1))))
506 (if (= k 1) 521 (if (= k 1)
@@ -508,14 +523,14 @@
508 (math-stirling-2 n m))))) 523 (math-stirling-2 n m)))))
509 524
510(defun math-stirling-1 (n m) 525(defun math-stirling-1 (n m)
511 (or (aref (aref cache n) m) 526 (or (aref (aref math-stirling-local-cache n) m)
512 (aset (aref cache n) m 527 (aset (aref math-stirling-local-cache n) m
513 (math-add (math-stirling-1 (1- n) (1- m)) 528 (math-add (math-stirling-1 (1- n) (1- m))
514 (math-mul (- 1 n) (math-stirling-1 (1- n) m)))))) 529 (math-mul (- 1 n) (math-stirling-1 (1- n) m))))))
515 530
516(defun math-stirling-2 (n m) 531(defun math-stirling-2 (n m)
517 (or (aref (aref cache n) m) 532 (or (aref (aref math-stirling-local-cache n) m)
518 (aset (aref cache n) m 533 (aset (aref math-stirling-local-cache n) m
519 (math-add (math-stirling-2 (1- n) (1- m)) 534 (math-add (math-stirling-2 (1- n) (1- m))
520 (math-mul m (math-stirling-2 (1- n) m)))))) 535 (math-mul m (math-stirling-2 (1- n) m))))))
521 536
@@ -527,8 +542,13 @@
527 542
528;;; Produce a random 10-bit integer, with (random) if no seed provided, 543;;; Produce a random 10-bit integer, with (random) if no seed provided,
529;;; or else with Numerical Recipes algorithm ran3 / Knuth 3.2.2-A. 544;;; or else with Numerical Recipes algorithm ran3 / Knuth 3.2.2-A.
545
546(defvar var-RandSeed nil)
547(defvar math-random-cache nil)
548(defvar math-gaussian-cache nil)
549
530(defun math-init-random-base () 550(defun math-init-random-base ()
531 (if (and (boundp 'var-RandSeed) var-RandSeed) 551 (if var-RandSeed
532 (if (eq (car-safe var-RandSeed) 'vec) 552 (if (eq (car-safe var-RandSeed) 'vec)
533 nil 553 nil
534 (if (Math-integerp var-RandSeed) 554 (if (Math-integerp var-RandSeed)
@@ -555,13 +575,13 @@
555 (random t) 575 (random t)
556 (setq var-RandSeed nil 576 (setq var-RandSeed nil
557 math-random-cache nil 577 math-random-cache nil
558 i 0
559 math-random-shift -4) ; assume RAND_MAX >= 16383 578 math-random-shift -4) ; assume RAND_MAX >= 16383
560 ;; This exercises the random number generator and also helps 579 ;; This exercises the random number generator and also helps
561 ;; deduce a better value for RAND_MAX. 580 ;; deduce a better value for RAND_MAX.
562 (while (< (setq i (1+ i)) 30) 581 (let ((i 0))
563 (if (> (lsh (math-abs (random)) math-random-shift) 4095) 582 (while (< (setq i (1+ i)) 30)
564 (setq math-random-shift (1- math-random-shift))))) 583 (if (> (lsh (math-abs (random)) math-random-shift) 4095)
584 (setq math-random-shift (1- math-random-shift))))))
565 (setq math-last-RandSeed var-RandSeed 585 (setq math-last-RandSeed var-RandSeed
566 math-gaussian-cache nil)) 586 math-gaussian-cache nil))
567 587
@@ -583,8 +603,8 @@
583;;; Avoid various pitfalls that may lurk in the built-in (random) function! 603;;; Avoid various pitfalls that may lurk in the built-in (random) function!
584;;; Shuffling algorithm from Numerical Recipes, section 7.1. 604;;; Shuffling algorithm from Numerical Recipes, section 7.1.
585(defun math-random-digit () 605(defun math-random-digit ()
586 (let (i) 606 (let (i math-random-last)
587 (or (and (boundp 'var-RandSeed) (eq var-RandSeed math-last-RandSeed)) 607 (or (eq var-RandSeed math-last-RandSeed)
588 (math-init-random-base)) 608 (math-init-random-base))
589 (or math-random-cache 609 (or math-random-cache
590 (progn 610 (progn
@@ -599,7 +619,6 @@
599 (aset math-random-cache i (math-random-base)) 619 (aset math-random-cache i (math-random-base))
600 (>= math-random-last 1000))) 620 (>= math-random-last 1000)))
601 math-random-last)) 621 math-random-last))
602(setq math-random-cache nil)
603 622
604;;; Produce an N-digit random integer. 623;;; Produce an N-digit random integer.
605(defun math-random-digits (n) 624(defun math-random-digits (n)
@@ -639,7 +658,6 @@
639 (setq math-gaussian-cache (cons calc-internal-prec 658 (setq math-gaussian-cache (cons calc-internal-prec
640 (math-mul v1 fac))) 659 (math-mul v1 fac)))
641 (math-mul v2 fac)))))) 660 (math-mul v2 fac))))))
642(setq math-gaussian-cache nil)
643 661
644;;; Produce a random integer or real 0 <= N < MAX. 662;;; Produce a random integer or real 0 <= N < MAX.
645(defun calcFunc-random (max) 663(defun calcFunc-random (max)
@@ -765,6 +783,12 @@
765;;; (nil unknown) if non-prime with no known factors, 783;;; (nil unknown) if non-prime with no known factors,
766;;; (t) if prime, 784;;; (t) if prime,
767;;; (maybe N P) if probably prime (after N iters with probability P%) 785;;; (maybe N P) if probably prime (after N iters with probability P%)
786(defvar math-prime-test-cache '(-1))
787
788(defvar math-prime-test-cache-k)
789(defvar math-prime-test-cache-q)
790(defvar math-prime-test-cache-nm1)
791
768(defun math-prime-test (n iters) 792(defun math-prime-test (n iters)
769 (if (and (Math-vectorp n) (cdr n)) 793 (if (and (Math-vectorp n) (cdr n))
770 (setq n (nth (1- (length n)) n))) 794 (setq n (nth (1- (length n)) n)))
@@ -849,7 +873,6 @@
849 (1- iters) 873 (1- iters)
850 0))) 874 0)))
851 res)) 875 res))
852(defvar math-prime-test-cache '(-1))
853 876
854(defun calcFunc-prime (n &optional iters) 877(defun calcFunc-prime (n &optional iters)
855 (or (math-num-integerp n) (math-reject-arg n 'integerp)) 878 (or (math-num-integerp n) (math-reject-arg n 'integerp))
@@ -965,7 +988,6 @@
965 (if (Math-realp n) 988 (if (Math-realp n)
966 (calcFunc-nextprime (math-trunc n) iters) 989 (calcFunc-nextprime (math-trunc n) iters)
967 (math-reject-arg n 'integerp)))) 990 (math-reject-arg n 'integerp))))
968(setq calc-verbose-nextprime nil)
969 991
970(defun calcFunc-prevprime (n &optional iters) 992(defun calcFunc-prevprime (n &optional iters)
971 (if (Math-integerp n) 993 (if (Math-integerp n)
diff --git a/lisp/calc/calc-ext.el b/lisp/calc/calc-ext.el
index 4679cf8abaa..77057fd4a7a 100644
--- a/lisp/calc/calc-ext.el
+++ b/lisp/calc/calc-ext.el
@@ -108,6 +108,7 @@
108 (define-key calc-mode-map "\C-w" 'calc-kill-region) 108 (define-key calc-mode-map "\C-w" 'calc-kill-region)
109 (define-key calc-mode-map "\M-w" 'calc-copy-region-as-kill) 109 (define-key calc-mode-map "\M-w" 'calc-copy-region-as-kill)
110 (define-key calc-mode-map "\C-y" 'calc-yank) 110 (define-key calc-mode-map "\C-y" 'calc-yank)
111 (define-key calc-mode-map [mouse-2] 'calc-yank)
111 (define-key calc-mode-map "\C-_" 'calc-undo) 112 (define-key calc-mode-map "\C-_" 'calc-undo)
112 (define-key calc-mode-map "\C-xu" 'calc-undo) 113 (define-key calc-mode-map "\C-xu" 'calc-undo)
113 (define-key calc-mode-map "\M-\C-m" 'calc-last-args) 114 (define-key calc-mode-map "\M-\C-m" 'calc-last-args)
@@ -662,16 +663,6 @@
662 (define-key calc-alg-map "\e\C-m" 'calc-last-args-stub) 663 (define-key calc-alg-map "\e\C-m" 'calc-last-args-stub)
663 (define-key calc-alg-map "\e\177" 'calc-pop-above) 664 (define-key calc-alg-map "\e\177" 'calc-pop-above)
664 665
665 ;; The following is a relic for backward compatability only.
666 ;; The calc-define property list is now the recommended method.
667 (if (and (boundp 'calc-ext-defs)
668 calc-ext-defs)
669 (progn
670 (calc-need-macros)
671 (message "Evaluating calc-ext-defs...")
672 (eval (cons 'progn calc-ext-defs))
673 (setq calc-ext-defs nil)))
674
675;;;; (Autoloads here) 666;;;; (Autoloads here)
676 (mapcar (function (lambda (x) 667 (mapcar (function (lambda (x)
677 (mapcar (function (lambda (func) 668 (mapcar (function (lambda (func)
@@ -1769,10 +1760,13 @@ calc-kill calc-kill-region calc-yank))))
1769 (cdr res) 1760 (cdr res)
1770 res))) 1761 res)))
1771 1762
1763(defvar calc-z-prefix-buf nil)
1764(defvar calc-z-prefix-msgs nil)
1765
1772(defun calc-z-prefix-help () 1766(defun calc-z-prefix-help ()
1773 (interactive) 1767 (interactive)
1774 (let* ((msgs nil) 1768 (let* ((calc-z-prefix-msgs nil)
1775 (buf "") 1769 (calc-z-prefix-buf "")
1776 (kmap (sort (copy-sequence (calc-user-key-map)) 1770 (kmap (sort (copy-sequence (calc-user-key-map))
1777 (function (lambda (x y) (< (car x) (car y)))))) 1771 (function (lambda (x y) (< (car x) (car y))))))
1778 (flags (apply 'logior 1772 (flags (apply 'logior
@@ -1783,12 +1777,12 @@ calc-kill calc-kill-region calc-yank))))
1783 (if (= (logand flags 8) 0) 1777 (if (= (logand flags 8) 0)
1784 (calc-user-function-list kmap 7) 1778 (calc-user-function-list kmap 7)
1785 (calc-user-function-list kmap 1) 1779 (calc-user-function-list kmap 1)
1786 (setq msgs (cons buf msgs) 1780 (setq calc-z-prefix-msgs (cons calc-z-prefix-buf calc-z-prefix-msgs)
1787 buf "") 1781 calc-z-prefix-buf "")
1788 (calc-user-function-list kmap 6)) 1782 (calc-user-function-list kmap 6))
1789 (if (/= flags 0) 1783 (if (/= flags 0)
1790 (setq msgs (cons buf msgs))) 1784 (setq calc-z-prefix-msgs (cons calc-z-prefix-buf calc-z-prefix-msgs)))
1791 (calc-do-prefix-help (nreverse msgs) "user" ?z))) 1785 (calc-do-prefix-help (nreverse calc-z-prefix-msgs) "user" ?z)))
1792 1786
1793(defun calc-user-function-classify (key) 1787(defun calc-user-function-classify (key)
1794 (cond ((/= key (downcase key)) ; upper-case 1788 (cond ((/= key (downcase key)) ; upper-case
@@ -1822,14 +1816,15 @@ calc-kill calc-kill-region calc-yank))))
1822 (upcase key) 1816 (upcase key)
1823 (downcase name)))) 1817 (downcase name))))
1824 (char-to-string (upcase key))))) 1818 (char-to-string (upcase key)))))
1825 (if (= (length buf) 0) 1819 (if (= (length calc-z-prefix-buf) 0)
1826 (setq buf (concat (if (= flags 1) "SHIFT + " "") 1820 (setq calc-z-prefix-buf (concat (if (= flags 1) "SHIFT + " "")
1827 desc)) 1821 desc))
1828 (if (> (+ (length buf) (length desc)) 58) 1822 (if (> (+ (length calc-z-prefix-buf) (length desc)) 58)
1829 (setq msgs (cons buf msgs) 1823 (setq calc-z-prefix-msgs
1830 buf (concat (if (= flags 1) "SHIFT + " "") 1824 (cons calc-z-prefix-buf calc-z-prefix-msgs)
1825 calc-z-prefix-buf (concat (if (= flags 1) "SHIFT + " "")
1831 desc)) 1826 desc))
1832 (setq buf (concat buf ", " desc)))))) 1827 (setq calc-z-prefix-buf (concat calc-z-prefix-buf ", " desc))))))
1833 (calc-user-function-list (cdr map) flags)))) 1828 (calc-user-function-list (cdr map) flags))))
1834 1829
1835 1830
@@ -1854,10 +1849,10 @@ calc-kill calc-kill-region calc-yank))))
1854 (last-prec (intern (concat (symbol-name name) "-last-prec"))) 1849 (last-prec (intern (concat (symbol-name name) "-last-prec")))
1855 (last-val (intern (concat (symbol-name name) "-last")))) 1850 (last-val (intern (concat (symbol-name name) "-last"))))
1856 (list 'progn 1851 (list 'progn
1857 (list 'setq cache-prec (if init (math-numdigs (nth 1 init)) -100)) 1852 (list 'defvar cache-prec (if init (math-numdigs (nth 1 init)) -100))
1858 (list 'setq cache-val (list 'quote init)) 1853 (list 'defvar cache-val (list 'quote init))
1859 (list 'setq last-prec -100) 1854 (list 'defvar last-prec -100)
1860 (list 'setq last-val nil) 1855 (list 'defvar last-val nil)
1861 (list 'setq 'math-cache-list 1856 (list 'setq 'math-cache-list
1862 (list 'cons 1857 (list 'cons
1863 (list 'quote cache-prec) 1858 (list 'quote cache-prec)
@@ -2223,25 +2218,25 @@ calc-kill calc-kill-region calc-yank))))
2223 (math-normalize (car a)) 2218 (math-normalize (car a))
2224 (error "Can't use multi-valued function in an expression"))))) 2219 (error "Can't use multi-valued function in an expression")))))
2225 2220
2226(defun math-normalize-nonstandard () ; uses "a" 2221(defun math-normalize-nonstandard ()
2227 (if (consp calc-simplify-mode) 2222 (if (consp calc-simplify-mode)
2228 (progn 2223 (progn
2229 (setq calc-simplify-mode 'none 2224 (setq calc-simplify-mode 'none
2230 math-simplify-only (car-safe (cdr-safe a))) 2225 math-simplify-only (car-safe (cdr-safe math-normalize-a)))
2231 nil) 2226 nil)
2232 (and (symbolp (car a)) 2227 (and (symbolp (car math-normalize-a))
2233 (or (eq calc-simplify-mode 'none) 2228 (or (eq calc-simplify-mode 'none)
2234 (and (eq calc-simplify-mode 'num) 2229 (and (eq calc-simplify-mode 'num)
2235 (let ((aptr (setq a (cons 2230 (let ((aptr (setq math-normalize-a
2236 (car a) 2231 (cons
2237 (mapcar 'math-normalize (cdr a)))))) 2232 (car math-normalize-a)
2233 (mapcar 'math-normalize
2234 (cdr math-normalize-a))))))
2238 (while (and aptr (math-constp (car aptr))) 2235 (while (and aptr (math-constp (car aptr)))
2239 (setq aptr (cdr aptr))) 2236 (setq aptr (cdr aptr)))
2240 aptr))) 2237 aptr)))
2241 (cons (car a) (mapcar 'math-normalize (cdr a)))))) 2238 (cons (car math-normalize-a)
2242 2239 (mapcar 'math-normalize (cdr math-normalize-a))))))
2243
2244
2245 2240
2246 2241
2247;;; Normalize a bignum digit list by trimming high-end zeros. [L l] 2242;;; Normalize a bignum digit list by trimming high-end zeros. [L l]
@@ -2619,22 +2614,27 @@ calc-kill calc-kill-region calc-yank))))
2619 2614
2620(defvar var-FactorRules 'calc-FactorRules) 2615(defvar var-FactorRules 'calc-FactorRules)
2621 2616
2622(defun math-map-tree (mmt-func mmt-expr &optional mmt-many) 2617(defvar math-mt-many nil)
2623 (or mmt-many (setq mmt-many 1000000)) 2618(defvar math-mt-func nil)
2619
2620(defun math-map-tree (math-mt-func mmt-expr &optional math-mt-many)
2621 (or math-mt-many (setq math-mt-many 1000000))
2624 (math-map-tree-rec mmt-expr)) 2622 (math-map-tree-rec mmt-expr))
2625 2623
2626(defun math-map-tree-rec (mmt-expr) 2624(defun math-map-tree-rec (mmt-expr)
2627 (or (= mmt-many 0) 2625 (or (= math-mt-many 0)
2628 (let ((mmt-done nil) 2626 (let ((mmt-done nil)
2629 mmt-nextval) 2627 mmt-nextval)
2630 (while (not mmt-done) 2628 (while (not mmt-done)
2631 (while (and (/= mmt-many 0) 2629 (while (and (/= math-mt-many 0)
2632 (setq mmt-nextval (funcall mmt-func mmt-expr)) 2630 (setq mmt-nextval (funcall math-mt-func mmt-expr))
2633 (not (equal mmt-expr mmt-nextval))) 2631 (not (equal mmt-expr mmt-nextval)))
2634 (setq mmt-expr mmt-nextval 2632 (setq mmt-expr mmt-nextval
2635 mmt-many (if (> mmt-many 0) (1- mmt-many) (1+ mmt-many)))) 2633 math-mt-many (if (> math-mt-many 0)
2634 (1- math-mt-many)
2635 (1+ math-mt-many))))
2636 (if (or (Math-primp mmt-expr) 2636 (if (or (Math-primp mmt-expr)
2637 (<= mmt-many 0)) 2637 (<= math-mt-many 0))
2638 (setq mmt-done t) 2638 (setq mmt-done t)
2639 (setq mmt-nextval (cons (car mmt-expr) 2639 (setq mmt-nextval (cons (car mmt-expr)
2640 (mapcar 'math-map-tree-rec 2640 (mapcar 'math-map-tree-rec
@@ -2885,22 +2885,24 @@ calc-kill calc-kill-region calc-yank))))
2885 2885
2886;;; Expression parsing. 2886;;; Expression parsing.
2887 2887
2888(defun math-read-expr (exp-str) 2888(defvar math-expr-data)
2889 (let ((exp-pos 0) 2889
2890 (exp-old-pos 0) 2890(defun math-read-expr (math-exp-str)
2891 (exp-keep-spaces nil) 2891 (let ((math-exp-pos 0)
2892 exp-token exp-data) 2892 (math-exp-old-pos 0)
2893 (while (setq exp-token (string-match "\\.\\.\\([^.]\\|.[^.]\\)" exp-str)) 2893 (math-exp-keep-spaces nil)
2894 (setq exp-str (concat (substring exp-str 0 exp-token) "\\dots" 2894 math-exp-token math-expr-data)
2895 (substring exp-str (+ exp-token 2))))) 2895 (while (setq math-exp-token (string-match "\\.\\.\\([^.]\\|.[^.]\\)" math-exp-str))
2896 (setq math-exp-str (concat (substring math-exp-str 0 math-exp-token) "\\dots"
2897 (substring math-exp-str (+ math-exp-token 2)))))
2896 (math-build-parse-table) 2898 (math-build-parse-table)
2897 (math-read-token) 2899 (math-read-token)
2898 (let ((val (catch 'syntax (math-read-expr-level 0)))) 2900 (let ((val (catch 'syntax (math-read-expr-level 0))))
2899 (if (stringp val) 2901 (if (stringp val)
2900 (list 'error exp-old-pos val) 2902 (list 'error math-exp-old-pos val)
2901 (if (equal exp-token 'end) 2903 (if (equal math-exp-token 'end)
2902 val 2904 val
2903 (list 'error exp-old-pos "Syntax error")))))) 2905 (list 'error math-exp-old-pos "Syntax error"))))))
2904 2906
2905(defun math-read-plain-expr (exp-str &optional error-check) 2907(defun math-read-plain-expr (exp-str &optional error-check)
2906 (let* ((calc-language nil) 2908 (let* ((calc-language nil)
@@ -2913,8 +2915,8 @@ calc-kill calc-kill-region calc-yank))))
2913 2915
2914 2916
2915(defun math-read-string () 2917(defun math-read-string ()
2916 (let ((str (read-from-string (concat exp-data "\"")))) 2918 (let ((str (read-from-string (concat math-expr-data "\""))))
2917 (or (and (= (cdr str) (1+ (length exp-data))) 2919 (or (and (= (cdr str) (1+ (length math-expr-data)))
2918 (stringp (car str))) 2920 (stringp (car str)))
2919 (throw 'syntax "Error in string constant")) 2921 (throw 'syntax "Error in string constant"))
2920 (math-read-token) 2922 (math-read-token)
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."
1791 1791
1792 1792
1793(defun math-read-angle-brackets () 1793(defun math-read-angle-brackets ()
1794 (let* ((last (or (math-check-for-commas t) (length exp-str))) 1794 (let* ((last (or (math-check-for-commas t) (length math-exp-str)))
1795 (str (substring exp-str exp-pos last)) 1795 (str (substring math-exp-str math-exp-pos last))
1796 (res 1796 (res
1797 (if (string-match "\\` *\\([a-zA-Z#][a-zA-Z0-9#]* *,? *\\)*:" str) 1797 (if (string-match "\\` *\\([a-zA-Z#][a-zA-Z0-9#]* *,? *\\)*:" str)
1798 (let ((str1 (substring str 0 (1- (match-end 0)))) 1798 (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."
1818 (throw 'syntax res)) 1818 (throw 'syntax res))
1819 (if (eq (car-safe res) 'error) 1819 (if (eq (car-safe res) 'error)
1820 (throw 'syntax (nth 2 res))) 1820 (throw 'syntax (nth 2 res)))
1821 (setq exp-pos (1+ last)) 1821 (setq math-exp-pos (1+ last))
1822 (math-read-token) 1822 (math-read-token)
1823 res)) 1823 res))
1824 1824
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 @@
66(defvar calc-graph-data-cache-limit 10) 66(defvar calc-graph-data-cache-limit 10)
67(defvar calc-graph-no-auto-view nil) 67(defvar calc-graph-no-auto-view nil)
68(defvar calc-graph-no-wait nil) 68(defvar calc-graph-no-wait nil)
69(defvar calc-gnuplot-trail-mark)
69 70
70(defun calc-graph-fast (many) 71(defun calc-graph-fast (many)
71 (interactive "P") 72 (interactive "P")
@@ -224,11 +225,10 @@
224 thing 225 thing
225 (let ((found (assoc thing calc-graph-var-cache))) 226 (let ((found (assoc thing calc-graph-var-cache)))
226 (or found 227 (or found
227 (progn 228 (let ((varname (concat "PlotData"
228 (setq varname (concat "PlotData" 229 (int-to-string
229 (int-to-string 230 (1+ (length calc-graph-var-cache))))))
230 (1+ (length calc-graph-var-cache)))) 231 (setq var (list 'var (intern varname)
231 var (list 'var (intern varname)
232 (intern (concat "var-" varname))) 232 (intern (concat "var-" varname)))
233 found (cons thing var) 233 found (cons thing var)
234 calc-graph-var-cache (cons found calc-graph-var-cache)) 234 calc-graph-var-cache (cons found calc-graph-var-cache))
@@ -275,6 +275,47 @@
275 (interactive "P") 275 (interactive "P")
276 (calc-graph-plot flag t)) 276 (calc-graph-plot flag t))
277 277
278(defvar var-DUMMY)
279(defvar var-DUMMY2)
280(defvar var-PlotRejects)
281
282;; The following variables are local to calc-graph-plot, but are
283;; used in the functions calc-graph-compute-2d, calc-graph-refine-2d,
284;; calc-graph-recompute-2d, calc-graph-compute-3d and
285;; calc-graph-format-data, which are called by calc-graph-plot.
286(defvar calc-graph-yvalue)
287(defvar calc-graph-yvec)
288(defvar calc-graph-numsteps)
289(defvar calc-graph-numsteps3)
290(defvar calc-graph-xvalue)
291(defvar calc-graph-xvec)
292(defvar calc-graph-xname)
293(defvar calc-graph-yname)
294(defvar calc-graph-xstep)
295(defvar calc-graph-ycache)
296(defvar calc-graph-ycacheptr)
297(defvar calc-graph-refine)
298(defvar calc-graph-keep-file)
299(defvar calc-graph-xval)
300(defvar calc-graph-xlow)
301(defvar calc-graph-xhigh)
302(defvar calc-graph-yval)
303(defvar calc-graph-yp)
304(defvar calc-graph-xp)
305(defvar calc-graph-zp)
306(defvar calc-graph-yvector)
307(defvar calc-graph-resolution)
308(defvar calc-graph-y3value)
309(defvar calc-graph-y3name)
310(defvar calc-graph-y3step)
311(defvar calc-graph-zval)
312(defvar calc-graph-stepcount)
313(defvar calc-graph-is-splot)
314(defvar calc-graph-surprise-splot)
315(defvar calc-graph-blank)
316(defvar calc-graph-non-blank)
317(defvar calc-graph-curve-num)
318
278(defun calc-graph-plot (flag &optional printing) 319(defun calc-graph-plot (flag &optional printing)
279 (interactive "P") 320 (interactive "P")
280 (calc-slow-wrapper 321 (calc-slow-wrapper
@@ -282,22 +323,20 @@
282 (tempbuf (get-buffer-create "*Gnuplot Temp-2*")) 323 (tempbuf (get-buffer-create "*Gnuplot Temp-2*"))
283 (tempbuftop 1) 324 (tempbuftop 1)
284 (tempoutfile nil) 325 (tempoutfile nil)
285 (curve-num 0) 326 (calc-graph-curve-num 0)
286 (refine (and flag (> (prefix-numeric-value flag) 0))) 327 (calc-graph-refine (and flag (> (prefix-numeric-value flag) 0)))
287 (recompute (and flag (< (prefix-numeric-value flag) 0))) 328 (recompute (and flag (< (prefix-numeric-value flag) 0)))
288 (surprise-splot nil) 329 (calc-graph-surprise-splot nil)
289 (tty-output nil) 330 (tty-output nil)
290 cache-env is-splot device output resolution precision samples-pos) 331 cache-env calc-graph-is-splot device output calc-graph-resolution precision samples-pos)
291 (or (boundp 'calc-graph-prev-kill-hook) 332 (add-hook 'kill-emacs-hook 'calc-graph-kill-hook)
292 (setq calc-graph-prev-kill-hook nil)
293 (add-hook 'kill-emacs-hook 'calc-graph-kill-hook))
294 (save-excursion 333 (save-excursion
295 (calc-graph-init) 334 (calc-graph-init)
296 (set-buffer tempbuf) 335 (set-buffer tempbuf)
297 (erase-buffer) 336 (erase-buffer)
298 (set-buffer calc-gnuplot-input) 337 (set-buffer calc-gnuplot-input)
299 (goto-char (point-min)) 338 (goto-char (point-min))
300 (setq is-splot (re-search-forward "^splot[ \t]" nil t)) 339 (setq calc-graph-is-splot (re-search-forward "^splot[ \t]" nil t))
301 (let ((str (buffer-string)) 340 (let ((str (buffer-string))
302 (ver calc-gnuplot-version)) 341 (ver calc-gnuplot-version))
303 (set-buffer (get-buffer-create "*Gnuplot Temp*")) 342 (set-buffer (get-buffer-create "*Gnuplot Temp*"))
@@ -313,14 +352,14 @@
313 "set nogrid\nset nokey\nset nopolar\n")) 352 "set nogrid\nset nokey\nset nopolar\n"))
314 (if (>= ver 3) 353 (if (>= ver 3)
315 (insert "set surface\nset nocontour\n" 354 (insert "set surface\nset nocontour\n"
316 "set " (if is-splot "" "no") "parametric\n" 355 "set " (if calc-graph-is-splot "" "no") "parametric\n"
317 "set notime\nset border\nset ztics\nset zeroaxis\n" 356 "set notime\nset border\nset ztics\nset zeroaxis\n"
318 "set view 60,30,1,1\nset offsets 0,0,0,0\n")) 357 "set view 60,30,1,1\nset offsets 0,0,0,0\n"))
319 (setq samples-pos (point)) 358 (setq samples-pos (point))
320 (insert "\n\n" str)) 359 (insert "\n\n" str))
321 (goto-char (point-min)) 360 (goto-char (point-min))
322 (if is-splot 361 (if calc-graph-is-splot
323 (if refine 362 (if calc-graph-refine
324 (error "This option works only for 2d plots") 363 (error "This option works only for 2d plots")
325 (setq recompute t))) 364 (setq recompute t)))
326 (let ((calc-gnuplot-input (current-buffer)) 365 (let ((calc-gnuplot-input (current-buffer))
@@ -366,10 +405,10 @@
366 (if (equal output "STDOUT") 405 (if (equal output "STDOUT")
367 "" 406 ""
368 (prin1-to-string output))))) 407 (prin1-to-string output)))))
369 (setq resolution (calc-graph-find-command "samples")) 408 (setq calc-graph-resolution (calc-graph-find-command "samples"))
370 (if resolution 409 (if calc-graph-resolution
371 (setq resolution (string-to-int resolution)) 410 (setq calc-graph-resolution (string-to-int calc-graph-resolution))
372 (setq resolution (if is-splot 411 (setq calc-graph-resolution (if calc-graph-is-splot
373 calc-graph-default-resolution-3d 412 calc-graph-default-resolution-3d
374 calc-graph-default-resolution))) 413 calc-graph-default-resolution)))
375 (setq precision (calc-graph-find-command "precision")) 414 (setq precision (calc-graph-find-command "precision"))
@@ -381,8 +420,8 @@
381 (calc-graph-set-command "samples") 420 (calc-graph-set-command "samples")
382 (calc-graph-set-command "precision")) 421 (calc-graph-set-command "precision"))
383 (goto-char samples-pos) 422 (goto-char samples-pos)
384 (insert "set samples " (int-to-string (max (if is-splot 20 200) 423 (insert "set samples " (int-to-string (max (if calc-graph-is-splot 20 200)
385 (+ 5 resolution))) "\n") 424 (+ 5 calc-graph-resolution))) "\n")
386 (while (re-search-forward "{\\*[^}]+}[^,\n]*" nil t) 425 (while (re-search-forward "{\\*[^}]+}[^,\n]*" nil t)
387 (delete-region (match-beginning 0) (match-end 0)) 426 (delete-region (match-beginning 0) (match-end 0))
388 (if (looking-at ",") 427 (if (looking-at ",")
@@ -398,7 +437,7 @@
398 calc-simplify-mode 437 calc-simplify-mode
399 calc-infinite-mode 438 calc-infinite-mode
400 calc-word-size 439 calc-word-size
401 precision is-splot)) 440 precision calc-graph-is-splot))
402 (if (and (not recompute) 441 (if (and (not recompute)
403 (equal (cdr (car calc-graph-data-cache)) cache-env)) 442 (equal (cdr (car calc-graph-data-cache)) cache-env))
404 (while (> (length calc-graph-data-cache) 443 (while (> (length calc-graph-data-cache)
@@ -408,88 +447,88 @@
408 (setq calc-graph-data-cache (list (cons nil cache-env))))) 447 (setq calc-graph-data-cache (list (cons nil cache-env)))))
409 (calc-graph-find-plot t t) 448 (calc-graph-find-plot t t)
410 (while (re-search-forward 449 (while (re-search-forward
411 (if is-splot 450 (if calc-graph-is-splot
412 "{\\([^{}:\n]+\\):\\([^{}:\n]+\\):\\([^{}:\n]+\\)}" 451 "{\\([^{}:\n]+\\):\\([^{}:\n]+\\):\\([^{}:\n]+\\)}"
413 "{\\([^{}:\n]+\\)\\(:\\)\\([^{}:\n]+\\)}") 452 "{\\([^{}:\n]+\\)\\(:\\)\\([^{}:\n]+\\)}")
414 nil t) 453 nil t)
415 (setq curve-num (1+ curve-num)) 454 (setq calc-graph-curve-num (1+ calc-graph-curve-num))
416 (let* ((xname (buffer-substring (match-beginning 1) (match-end 1))) 455 (let* ((calc-graph-xname (buffer-substring (match-beginning 1) (match-end 1)))
417 (xvar (intern (concat "var-" xname))) 456 (xvar (intern (concat "var-" calc-graph-xname)))
418 (xvalue (math-evaluate-expr (calc-var-value xvar))) 457 (calc-graph-xvalue (math-evaluate-expr (calc-var-value xvar)))
419 (y3name (and is-splot 458 (calc-graph-y3name (and calc-graph-is-splot
420 (buffer-substring (match-beginning 2) 459 (buffer-substring (match-beginning 2)
421 (match-end 2)))) 460 (match-end 2))))
422 (y3var (and is-splot (intern (concat "var-" y3name)))) 461 (y3var (and calc-graph-is-splot (intern (concat "var-" calc-graph-y3name))))
423 (y3value (and is-splot (calc-var-value y3var))) 462 (calc-graph-y3value (and calc-graph-is-splot (calc-var-value y3var)))
424 (yname (buffer-substring (match-beginning 3) (match-end 3))) 463 (calc-graph-yname (buffer-substring (match-beginning 3) (match-end 3)))
425 (yvar (intern (concat "var-" yname))) 464 (yvar (intern (concat "var-" calc-graph-yname)))
426 (yvalue (calc-var-value yvar)) 465 (calc-graph-yvalue (calc-var-value yvar))
427 filename) 466 filename)
428 (delete-region (match-beginning 0) (match-end 0)) 467 (delete-region (match-beginning 0) (match-end 0))
429 (setq filename (calc-temp-file-name curve-num)) 468 (setq filename (calc-temp-file-name calc-graph-curve-num))
430 (save-excursion 469 (save-excursion
431 (set-buffer calcbuf) 470 (set-buffer calcbuf)
432 (let (tempbuftop 471 (let (tempbuftop
433 (xp xvalue) 472 (calc-graph-xp calc-graph-xvalue)
434 (yp yvalue) 473 (calc-graph-yp calc-graph-yvalue)
435 (zp nil) 474 (calc-graph-zp nil)
436 (xlow nil) (xhigh nil) (y3low nil) (y3high nil) 475 (calc-graph-xlow nil) (calc-graph-xhigh nil) (y3low nil) (y3high nil)
437 xvec xval xstep var-DUMMY 476 calc-graph-xvec calc-graph-xval calc-graph-xstep var-DUMMY
438 y3vec y3val y3step var-DUMMY2 (zval nil) 477 y3val calc-graph-y3step var-DUMMY2 (calc-graph-zval nil)
439 yvec yval ycache ycacheptr yvector 478 calc-graph-yvec calc-graph-yval calc-graph-ycache calc-graph-ycacheptr calc-graph-yvector
440 numsteps numsteps3 479 calc-graph-numsteps calc-graph-numsteps3
441 (keep-file (and (not is-splot) (file-exists-p filename))) 480 (calc-graph-keep-file (and (not calc-graph-is-splot) (file-exists-p filename)))
442 (stepcount 0) 481 (calc-graph-stepcount 0)
443 (calc-symbolic-mode nil) 482 (calc-symbolic-mode nil)
444 (calc-prefer-frac nil) 483 (calc-prefer-frac nil)
445 (calc-internal-prec (max 3 precision)) 484 (calc-internal-prec (max 3 precision))
446 (calc-simplify-mode (and (not (memq calc-simplify-mode 485 (calc-simplify-mode (and (not (memq calc-simplify-mode
447 '(none num))) 486 '(none num)))
448 calc-simplify-mode)) 487 calc-simplify-mode))
449 (blank t) 488 (calc-graph-blank t)
450 (non-blank nil) 489 (calc-graph-non-blank nil)
451 (math-working-step 0) 490 (math-working-step 0)
452 (math-working-step-2 nil)) 491 (math-working-step-2 nil))
453 (save-excursion 492 (save-excursion
454 (if is-splot 493 (if calc-graph-is-splot
455 (calc-graph-compute-3d) 494 (calc-graph-compute-3d)
456 (calc-graph-compute-2d)) 495 (calc-graph-compute-2d))
457 (set-buffer tempbuf) 496 (set-buffer tempbuf)
458 (goto-char (point-max)) 497 (goto-char (point-max))
459 (insert "\n" xname) 498 (insert "\n" calc-graph-xname)
460 (if is-splot 499 (if calc-graph-is-splot
461 (insert ":" y3name)) 500 (insert ":" calc-graph-y3name))
462 (insert ":" yname "\n\n") 501 (insert ":" calc-graph-yname "\n\n")
463 (setq tempbuftop (point)) 502 (setq tempbuftop (point))
464 (let ((calc-group-digits nil) 503 (let ((calc-group-digits nil)
465 (calc-leading-zeros nil) 504 (calc-leading-zeros nil)
466 (calc-number-radix 10) 505 (calc-number-radix 10)
467 (entry (and (not is-splot) 506 (entry (and (not calc-graph-is-splot)
468 (list xp yp xhigh numsteps)))) 507 (list calc-graph-xp calc-graph-yp calc-graph-xhigh calc-graph-numsteps))))
469 (or (equal entry 508 (or (equal entry
470 (nth 1 (nth (1+ curve-num) 509 (nth 1 (nth (1+ calc-graph-curve-num)
471 calc-graph-file-cache))) 510 calc-graph-file-cache)))
472 (setq keep-file nil)) 511 (setq calc-graph-keep-file nil))
473 (setcar (cdr (nth (1+ curve-num) calc-graph-file-cache)) 512 (setcar (cdr (nth (1+ calc-graph-curve-num) calc-graph-file-cache))
474 entry) 513 entry)
475 (or keep-file 514 (or calc-graph-keep-file
476 (calc-graph-format-data))) 515 (calc-graph-format-data)))
477 (or keep-file 516 (or calc-graph-keep-file
478 (progn 517 (progn
479 (or non-blank 518 (or calc-graph-non-blank
480 (error "No valid data points for %s:%s" 519 (error "No valid data points for %s:%s"
481 xname yname)) 520 calc-graph-xname calc-graph-yname))
482 (write-region tempbuftop (point-max) filename 521 (write-region tempbuftop (point-max) filename
483 nil 'quiet)))))) 522 nil 'quiet))))))
484 (insert (prin1-to-string filename)))) 523 (insert (prin1-to-string filename))))
485 (if surprise-splot 524 (if calc-graph-surprise-splot
486 (setcdr cache-env nil)) 525 (setcdr cache-env nil))
487 (if (= curve-num 0) 526 (if (= calc-graph-curve-num 0)
488 (progn 527 (progn
489 (calc-gnuplot-command "clear") 528 (calc-gnuplot-command "clear")
490 (calc-clear-command-flag 'clear-message) 529 (calc-clear-command-flag 'clear-message)
491 (message "No data to plot!")) 530 (message "No data to plot!"))
492 (setq calc-graph-data-cache-limit (max curve-num 531 (setq calc-graph-data-cache-limit (max calc-graph-curve-num
493 calc-graph-data-cache-limit) 532 calc-graph-data-cache-limit)
494 filename (calc-temp-file-name 0)) 533 filename (calc-temp-file-name 0))
495 (write-region (point-min) (point-max) filename nil 'quiet) 534 (write-region (point-min) (point-max) filename nil 'quiet)
@@ -517,325 +556,325 @@
517 (eval command)))))))))) 556 (eval command))))))))))
518 557
519(defun calc-graph-compute-2d () 558(defun calc-graph-compute-2d ()
520 (if (setq yvec (eq (car-safe yvalue) 'vec)) 559 (if (setq calc-graph-yvec (eq (car-safe calc-graph-yvalue) 'vec))
521 (if (= (setq numsteps (1- (length yvalue))) 0) 560 (if (= (setq calc-graph-numsteps (1- (length calc-graph-yvalue))) 0)
522 (error "Can't plot an empty vector") 561 (error "Can't plot an empty vector")
523 (if (setq xvec (eq (car-safe xvalue) 'vec)) 562 (if (setq calc-graph-xvec (eq (car-safe calc-graph-xvalue) 'vec))
524 (or (= (1- (length xvalue)) numsteps) 563 (or (= (1- (length calc-graph-xvalue)) calc-graph-numsteps)
525 (error "%s and %s have different lengths" xname yname)) 564 (error "%s and %s have different lengths" calc-graph-xname calc-graph-yname))
526 (if (and (eq (car-safe xvalue) 'intv) 565 (if (and (eq (car-safe calc-graph-xvalue) 'intv)
527 (math-constp xvalue)) 566 (math-constp calc-graph-xvalue))
528 (setq xstep (math-div (math-sub (nth 3 xvalue) 567 (setq calc-graph-xstep (math-div (math-sub (nth 3 calc-graph-xvalue)
529 (nth 2 xvalue)) 568 (nth 2 calc-graph-xvalue))
530 (1- numsteps)) 569 (1- calc-graph-numsteps))
531 xvalue (nth 2 xvalue)) 570 calc-graph-xvalue (nth 2 calc-graph-xvalue))
532 (if (math-realp xvalue) 571 (if (math-realp calc-graph-xvalue)
533 (setq xstep 1) 572 (setq calc-graph-xstep 1)
534 (error "%s is not a suitable basis for %s" xname yname))))) 573 (error "%s is not a suitable basis for %s" calc-graph-xname calc-graph-yname)))))
535 (or (math-realp yvalue) 574 (or (math-realp calc-graph-yvalue)
536 (let ((arglist nil)) 575 (let ((arglist nil))
537 (setq yvalue (math-evaluate-expr yvalue)) 576 (setq calc-graph-yvalue (math-evaluate-expr calc-graph-yvalue))
538 (calc-default-formula-arglist yvalue) 577 (calc-default-formula-arglist calc-graph-yvalue)
539 (or arglist 578 (or arglist
540 (error "%s does not contain any unassigned variables" yname)) 579 (error "%s does not contain any unassigned variables" calc-graph-yname))
541 (and (cdr arglist) 580 (and (cdr arglist)
542 (error "%s contains more than one variable: %s" 581 (error "%s contains more than one variable: %s"
543 yname arglist)) 582 calc-graph-yname arglist))
544 (setq yvalue (math-expr-subst yvalue 583 (setq calc-graph-yvalue (math-expr-subst calc-graph-yvalue
545 (math-build-var-name (car arglist)) 584 (math-build-var-name (car arglist))
546 '(var DUMMY var-DUMMY))))) 585 '(var DUMMY var-DUMMY)))))
547 (setq ycache (assoc yvalue calc-graph-data-cache)) 586 (setq calc-graph-ycache (assoc calc-graph-yvalue calc-graph-data-cache))
548 (delq ycache calc-graph-data-cache) 587 (delq calc-graph-ycache calc-graph-data-cache)
549 (nconc calc-graph-data-cache 588 (nconc calc-graph-data-cache
550 (list (or ycache (setq ycache (list yvalue))))) 589 (list (or calc-graph-ycache (setq calc-graph-ycache (list calc-graph-yvalue)))))
551 (if (and (not (setq xvec (eq (car-safe xvalue) 'vec))) 590 (if (and (not (setq calc-graph-xvec (eq (car-safe calc-graph-xvalue) 'vec)))
552 refine (cdr (cdr ycache))) 591 calc-graph-refine (cdr (cdr calc-graph-ycache)))
553 (calc-graph-refine-2d) 592 (calc-graph-refine-2d)
554 (calc-graph-recompute-2d)))) 593 (calc-graph-recompute-2d))))
555 594
556(defun calc-graph-refine-2d () 595(defun calc-graph-refine-2d ()
557 (setq keep-file nil 596 (setq calc-graph-keep-file nil
558 ycacheptr (cdr ycache)) 597 calc-graph-ycacheptr (cdr calc-graph-ycache))
559 (if (and (setq xval (calc-graph-find-command "xrange")) 598 (if (and (setq calc-graph-xval (calc-graph-find-command "xrange"))
560 (string-match "\\`\\[\\([0-9.eE+-]*\\):\\([0-9.eE+-]*\\)\\]\\'" 599 (string-match "\\`\\[\\([0-9.eE+-]*\\):\\([0-9.eE+-]*\\)\\]\\'"
561 xval)) 600 calc-graph-xval))
562 (let ((b2 (match-beginning 2)) 601 (let ((b2 (match-beginning 2))
563 (e2 (match-end 2))) 602 (e2 (match-end 2)))
564 (setq xlow (math-read-number (substring xval 603 (setq calc-graph-xlow (math-read-number (substring calc-graph-xval
565 (match-beginning 1) 604 (match-beginning 1)
566 (match-end 1))) 605 (match-end 1)))
567 xhigh (math-read-number (substring xval b2 e2)))) 606 calc-graph-xhigh (math-read-number (substring calc-graph-xval b2 e2))))
568 (if xlow 607 (if calc-graph-xlow
569 (while (and (cdr ycacheptr) 608 (while (and (cdr calc-graph-ycacheptr)
570 (Math-lessp (car (nth 1 ycacheptr)) xlow)) 609 (Math-lessp (car (nth 1 calc-graph-ycacheptr)) calc-graph-xlow))
571 (setq ycacheptr (cdr ycacheptr))))) 610 (setq calc-graph-ycacheptr (cdr calc-graph-ycacheptr)))))
572 (setq math-working-step-2 (1- (length ycacheptr))) 611 (setq math-working-step-2 (1- (length calc-graph-ycacheptr)))
573 (while (and (cdr ycacheptr) 612 (while (and (cdr calc-graph-ycacheptr)
574 (or (not xhigh) 613 (or (not calc-graph-xhigh)
575 (Math-lessp (car (car ycacheptr)) xhigh))) 614 (Math-lessp (car (car calc-graph-ycacheptr)) calc-graph-xhigh)))
576 (setq var-DUMMY (math-div (math-add (car (car ycacheptr)) 615 (setq var-DUMMY (math-div (math-add (car (car calc-graph-ycacheptr))
577 (car (nth 1 ycacheptr))) 616 (car (nth 1 calc-graph-ycacheptr)))
578 2) 617 2)
579 math-working-step (1+ math-working-step) 618 math-working-step (1+ math-working-step)
580 yval (math-evaluate-expr yvalue)) 619 calc-graph-yval (math-evaluate-expr calc-graph-yvalue))
581 (setcdr ycacheptr (cons (cons var-DUMMY yval) 620 (setcdr calc-graph-ycacheptr (cons (cons var-DUMMY calc-graph-yval)
582 (cdr ycacheptr))) 621 (cdr calc-graph-ycacheptr)))
583 (setq ycacheptr (cdr (cdr ycacheptr)))) 622 (setq calc-graph-ycacheptr (cdr (cdr calc-graph-ycacheptr))))
584 (setq yp ycache 623 (setq calc-graph-yp calc-graph-ycache
585 numsteps 1000000)) 624 calc-graph-numsteps 1000000))
586 625
587(defun calc-graph-recompute-2d () 626(defun calc-graph-recompute-2d ()
588 (setq ycacheptr ycache) 627 (setq calc-graph-ycacheptr calc-graph-ycache)
589 (if xvec 628 (if calc-graph-xvec
590 (setq numsteps (1- (length xvalue)) 629 (setq calc-graph-numsteps (1- (length calc-graph-xvalue))
591 yvector nil) 630 calc-graph-yvector nil)
592 (if (and (eq (car-safe xvalue) 'intv) 631 (if (and (eq (car-safe calc-graph-xvalue) 'intv)
593 (math-constp xvalue)) 632 (math-constp calc-graph-xvalue))
594 (setq numsteps resolution 633 (setq calc-graph-numsteps calc-graph-resolution
595 yp nil 634 calc-graph-yp nil
596 xlow (nth 2 xvalue) 635 calc-graph-xlow (nth 2 calc-graph-xvalue)
597 xhigh (nth 3 xvalue) 636 calc-graph-xhigh (nth 3 calc-graph-xvalue)
598 xstep (math-div (math-sub xhigh xlow) 637 calc-graph-xstep (math-div (math-sub calc-graph-xhigh calc-graph-xlow)
599 (1- numsteps)) 638 (1- calc-graph-numsteps))
600 xvalue (nth 2 xvalue)) 639 calc-graph-xvalue (nth 2 calc-graph-xvalue))
601 (error "%s is not a suitable basis for %s" 640 (error "%s is not a suitable basis for %s"
602 xname yname))) 641 calc-graph-xname calc-graph-yname)))
603 (setq math-working-step-2 numsteps) 642 (setq math-working-step-2 calc-graph-numsteps)
604 (while (>= (setq numsteps (1- numsteps)) 0) 643 (while (>= (setq calc-graph-numsteps (1- calc-graph-numsteps)) 0)
605 (setq math-working-step (1+ math-working-step)) 644 (setq math-working-step (1+ math-working-step))
606 (if xvec 645 (if calc-graph-xvec
607 (progn 646 (progn
608 (setq xp (cdr xp) 647 (setq calc-graph-xp (cdr calc-graph-xp)
609 xval (car xp)) 648 calc-graph-xval (car calc-graph-xp))
610 (and (not (eq ycacheptr ycache)) 649 (and (not (eq calc-graph-ycacheptr calc-graph-ycache))
611 (consp (car ycacheptr)) 650 (consp (car calc-graph-ycacheptr))
612 (not (Math-lessp (car (car ycacheptr)) xval)) 651 (not (Math-lessp (car (car calc-graph-ycacheptr)) calc-graph-xval))
613 (setq ycacheptr ycache))) 652 (setq calc-graph-ycacheptr calc-graph-ycache)))
614 (if (= numsteps 0) 653 (if (= calc-graph-numsteps 0)
615 (setq xval xhigh) ; avoid cumulative roundoff 654 (setq calc-graph-xval calc-graph-xhigh) ; avoid cumulative roundoff
616 (setq xval xvalue 655 (setq calc-graph-xval calc-graph-xvalue
617 xvalue (math-add xvalue xstep)))) 656 calc-graph-xvalue (math-add calc-graph-xvalue calc-graph-xstep))))
618 (while (and (cdr ycacheptr) 657 (while (and (cdr calc-graph-ycacheptr)
619 (Math-lessp (car (nth 1 ycacheptr)) xval)) 658 (Math-lessp (car (nth 1 calc-graph-ycacheptr)) calc-graph-xval))
620 (setq ycacheptr (cdr ycacheptr))) 659 (setq calc-graph-ycacheptr (cdr calc-graph-ycacheptr)))
621 (or (and (cdr ycacheptr) 660 (or (and (cdr calc-graph-ycacheptr)
622 (Math-equal (car (nth 1 ycacheptr)) xval)) 661 (Math-equal (car (nth 1 calc-graph-ycacheptr)) calc-graph-xval))
623 (progn 662 (progn
624 (setq keep-file nil 663 (setq calc-graph-keep-file nil
625 var-DUMMY xval) 664 var-DUMMY calc-graph-xval)
626 (setcdr ycacheptr (cons (cons xval (math-evaluate-expr yvalue)) 665 (setcdr calc-graph-ycacheptr (cons (cons calc-graph-xval (math-evaluate-expr calc-graph-yvalue))
627 (cdr ycacheptr))))) 666 (cdr calc-graph-ycacheptr)))))
628 (setq ycacheptr (cdr ycacheptr)) 667 (setq calc-graph-ycacheptr (cdr calc-graph-ycacheptr))
629 (if xvec 668 (if calc-graph-xvec
630 (setq yvector (cons (cdr (car ycacheptr)) yvector)) 669 (setq calc-graph-yvector (cons (cdr (car calc-graph-ycacheptr)) calc-graph-yvector))
631 (or yp (setq yp ycacheptr)))) 670 (or calc-graph-yp (setq calc-graph-yp calc-graph-ycacheptr))))
632 (if xvec 671 (if calc-graph-xvec
633 (setq xp xvalue 672 (setq calc-graph-xp calc-graph-xvalue
634 yvec t 673 calc-graph-yvec t
635 yp (cons 'vec (nreverse yvector)) 674 calc-graph-yp (cons 'vec (nreverse calc-graph-yvector))
636 numsteps (1- (length xp))) 675 calc-graph-numsteps (1- (length calc-graph-xp)))
637 (setq numsteps 1000000))) 676 (setq calc-graph-numsteps 1000000)))
638 677
639(defun calc-graph-compute-3d () 678(defun calc-graph-compute-3d ()
640 (if (setq yvec (eq (car-safe yvalue) 'vec)) 679 (if (setq calc-graph-yvec (eq (car-safe calc-graph-yvalue) 'vec))
641 (if (math-matrixp yvalue) 680 (if (math-matrixp calc-graph-yvalue)
642 (progn 681 (progn
643 (setq numsteps (1- (length yvalue)) 682 (setq calc-graph-numsteps (1- (length calc-graph-yvalue))
644 numsteps3 (1- (length (nth 1 yvalue)))) 683 calc-graph-numsteps3 (1- (length (nth 1 calc-graph-yvalue))))
645 (if (eq (car-safe xvalue) 'vec) 684 (if (eq (car-safe calc-graph-xvalue) 'vec)
646 (or (= (1- (length xvalue)) numsteps) 685 (or (= (1- (length calc-graph-xvalue)) calc-graph-numsteps)
647 (error "%s has wrong length" xname)) 686 (error "%s has wrong length" calc-graph-xname))
648 (if (and (eq (car-safe xvalue) 'intv) 687 (if (and (eq (car-safe calc-graph-xvalue) 'intv)
649 (math-constp xvalue)) 688 (math-constp calc-graph-xvalue))
650 (setq xvalue (calcFunc-index numsteps 689 (setq calc-graph-xvalue (calcFunc-index calc-graph-numsteps
651 (nth 2 xvalue) 690 (nth 2 calc-graph-xvalue)
652 (math-div 691 (math-div
653 (math-sub (nth 3 xvalue) 692 (math-sub (nth 3 calc-graph-xvalue)
654 (nth 2 xvalue)) 693 (nth 2 calc-graph-xvalue))
655 (1- numsteps)))) 694 (1- calc-graph-numsteps))))
656 (if (math-realp xvalue) 695 (if (math-realp calc-graph-xvalue)
657 (setq xvalue (calcFunc-index numsteps xvalue 1)) 696 (setq calc-graph-xvalue (calcFunc-index calc-graph-numsteps calc-graph-xvalue 1))
658 (error "%s is not a suitable basis for %s" xname yname)))) 697 (error "%s is not a suitable basis for %s" calc-graph-xname calc-graph-yname))))
659 (if (eq (car-safe y3value) 'vec) 698 (if (eq (car-safe calc-graph-y3value) 'vec)
660 (or (= (1- (length y3value)) numsteps3) 699 (or (= (1- (length calc-graph-y3value)) calc-graph-numsteps3)
661 (error "%s has wrong length" y3name)) 700 (error "%s has wrong length" calc-graph-y3name))
662 (if (and (eq (car-safe y3value) 'intv) 701 (if (and (eq (car-safe calc-graph-y3value) 'intv)
663 (math-constp y3value)) 702 (math-constp calc-graph-y3value))
664 (setq y3value (calcFunc-index numsteps3 703 (setq calc-graph-y3value (calcFunc-index calc-graph-numsteps3
665 (nth 2 y3value) 704 (nth 2 calc-graph-y3value)
666 (math-div 705 (math-div
667 (math-sub (nth 3 y3value) 706 (math-sub (nth 3 calc-graph-y3value)
668 (nth 2 y3value)) 707 (nth 2 calc-graph-y3value))
669 (1- numsteps3)))) 708 (1- calc-graph-numsteps3))))
670 (if (math-realp y3value) 709 (if (math-realp calc-graph-y3value)
671 (setq y3value (calcFunc-index numsteps3 y3value 1)) 710 (setq calc-graph-y3value (calcFunc-index calc-graph-numsteps3 calc-graph-y3value 1))
672 (error "%s is not a suitable basis for %s" y3name yname)))) 711 (error "%s is not a suitable basis for %s" calc-graph-y3name calc-graph-yname))))
673 (setq xp nil 712 (setq calc-graph-xp nil
674 yp nil 713 calc-graph-yp nil
675 zp nil 714 calc-graph-zp nil
676 xvec t) 715 calc-graph-xvec t)
677 (while (setq xvalue (cdr xvalue) yvalue (cdr yvalue)) 716 (while (setq calc-graph-xvalue (cdr calc-graph-xvalue) calc-graph-yvalue (cdr calc-graph-yvalue))
678 (setq xp (nconc xp (make-list (1+ numsteps3) (car xvalue))) 717 (setq calc-graph-xp (nconc calc-graph-xp (make-list (1+ calc-graph-numsteps3) (car calc-graph-xvalue)))
679 yp (nconc yp (cons 0 (copy-sequence (cdr y3value)))) 718 calc-graph-yp (nconc calc-graph-yp (cons 0 (copy-sequence (cdr calc-graph-y3value))))
680 zp (nconc zp (cons '(skip) 719 calc-graph-zp (nconc calc-graph-zp (cons '(skip)
681 (copy-sequence (cdr (car yvalue))))))) 720 (copy-sequence (cdr (car calc-graph-yvalue)))))))
682 (setq numsteps (1- (* numsteps (1+ numsteps3))))) 721 (setq calc-graph-numsteps (1- (* calc-graph-numsteps
683 (if (= (setq numsteps (1- (length yvalue))) 0) 722 (1+ calc-graph-numsteps3)))))
723 (if (= (setq calc-graph-numsteps (1- (length calc-graph-yvalue))) 0)
684 (error "Can't plot an empty vector")) 724 (error "Can't plot an empty vector"))
685 (or (and (eq (car-safe xvalue) 'vec) 725 (or (and (eq (car-safe calc-graph-xvalue) 'vec)
686 (= (1- (length xvalue)) numsteps)) 726 (= (1- (length calc-graph-xvalue)) calc-graph-numsteps))
687 (error "%s is not a suitable basis for %s" xname yname)) 727 (error "%s is not a suitable basis for %s" calc-graph-xname calc-graph-yname))
688 (or (and (eq (car-safe y3value) 'vec) 728 (or (and (eq (car-safe calc-graph-y3value) 'vec)
689 (= (1- (length y3value)) numsteps)) 729 (= (1- (length calc-graph-y3value)) calc-graph-numsteps))
690 (error "%s is not a suitable basis for %s" y3name yname)) 730 (error "%s is not a suitable basis for %s" calc-graph-y3name calc-graph-yname))
691 (setq xp xvalue 731 (setq calc-graph-xp calc-graph-xvalue
692 yp y3value 732 calc-graph-yp calc-graph-y3value
693 zp yvalue 733 calc-graph-zp calc-graph-yvalue
694 xvec t)) 734 calc-graph-xvec t))
695 (or (math-realp yvalue) 735 (or (math-realp calc-graph-yvalue)
696 (let ((arglist nil)) 736 (let ((arglist nil))
697 (setq yvalue (math-evaluate-expr yvalue)) 737 (setq calc-graph-yvalue (math-evaluate-expr calc-graph-yvalue))
698 (calc-default-formula-arglist yvalue) 738 (calc-default-formula-arglist calc-graph-yvalue)
699 (setq arglist (sort arglist 'string-lessp)) 739 (setq arglist (sort arglist 'string-lessp))
700 (or (cdr arglist) 740 (or (cdr arglist)
701 (error "%s does not contain enough unassigned variables" yname)) 741 (error "%s does not contain enough unassigned variables" calc-graph-yname))
702 (and (cdr (cdr arglist)) 742 (and (cdr (cdr arglist))
703 (error "%s contains too many variables: %s" yname arglist)) 743 (error "%s contains too many variables: %s" calc-graph-yname arglist))
704 (setq yvalue (math-multi-subst yvalue 744 (setq calc-graph-yvalue (math-multi-subst calc-graph-yvalue
705 (mapcar 'math-build-var-name 745 (mapcar 'math-build-var-name
706 arglist) 746 arglist)
707 '((var DUMMY var-DUMMY) 747 '((var DUMMY var-DUMMY)
708 (var DUMMY2 var-DUMMY2)))))) 748 (var DUMMY2 var-DUMMY2))))))
709 (if (setq xvec (eq (car-safe xvalue) 'vec)) 749 (if (setq calc-graph-xvec (eq (car-safe calc-graph-xvalue) 'vec))
710 (setq numsteps (1- (length xvalue))) 750 (setq calc-graph-numsteps (1- (length calc-graph-xvalue)))
711 (if (and (eq (car-safe xvalue) 'intv) 751 (if (and (eq (car-safe calc-graph-xvalue) 'intv)
712 (math-constp xvalue)) 752 (math-constp calc-graph-xvalue))
713 (setq numsteps resolution 753 (setq calc-graph-numsteps calc-graph-resolution
714 xvalue (calcFunc-index numsteps 754 calc-graph-xvalue (calcFunc-index calc-graph-numsteps
715 (nth 2 xvalue) 755 (nth 2 calc-graph-xvalue)
716 (math-div (math-sub (nth 3 xvalue) 756 (math-div (math-sub (nth 3 calc-graph-xvalue)
717 (nth 2 xvalue)) 757 (nth 2 calc-graph-xvalue))
718 (1- numsteps)))) 758 (1- calc-graph-numsteps))))
719 (error "%s is not a suitable basis for %s" 759 (error "%s is not a suitable basis for %s"
720 xname yname))) 760 calc-graph-xname calc-graph-yname)))
721 (if (setq y3vec (eq (car-safe y3value) 'vec)) 761 (if (eq (car-safe calc-graph-y3value) 'vec)
722 (setq numsteps3 (1- (length y3value))) 762 (setq calc-graph-numsteps3 (1- (length calc-graph-y3value)))
723 (if (and (eq (car-safe y3value) 'intv) 763 (if (and (eq (car-safe calc-graph-y3value) 'intv)
724 (math-constp y3value)) 764 (math-constp calc-graph-y3value))
725 (setq numsteps3 resolution 765 (setq calc-graph-numsteps3 calc-graph-resolution
726 y3value (calcFunc-index numsteps3 766 calc-graph-y3value (calcFunc-index calc-graph-numsteps3
727 (nth 2 y3value) 767 (nth 2 calc-graph-y3value)
728 (math-div (math-sub (nth 3 y3value) 768 (math-div (math-sub (nth 3 calc-graph-y3value)
729 (nth 2 y3value)) 769 (nth 2 calc-graph-y3value))
730 (1- numsteps3)))) 770 (1- calc-graph-numsteps3))))
731 (error "%s is not a suitable basis for %s" 771 (error "%s is not a suitable basis for %s"
732 y3name yname))) 772 calc-graph-y3name calc-graph-yname)))
733 (setq xp nil 773 (setq calc-graph-xp nil
734 yp nil 774 calc-graph-yp nil
735 zp nil 775 calc-graph-zp nil
736 xvec t) 776 calc-graph-xvec t)
737 (setq math-working-step 0) 777 (setq math-working-step 0)
738 (while (setq xvalue (cdr xvalue)) 778 (while (setq calc-graph-xvalue (cdr calc-graph-xvalue))
739 (setq xp (nconc xp (make-list (1+ numsteps3) (car xvalue))) 779 (setq calc-graph-xp (nconc calc-graph-xp (make-list (1+ calc-graph-numsteps3) (car calc-graph-xvalue)))
740 yp (nconc yp (cons 0 (copy-sequence (cdr y3value)))) 780 calc-graph-yp (nconc calc-graph-yp (cons 0 (copy-sequence (cdr calc-graph-y3value))))
741 zp (cons '(skip) zp) 781 calc-graph-zp (cons '(skip) calc-graph-zp)
742 y3step y3value 782 calc-graph-y3step calc-graph-y3value
743 var-DUMMY (car xvalue) 783 var-DUMMY (car calc-graph-xvalue)
744 math-working-step-2 0 784 math-working-step-2 0
745 math-working-step (1+ math-working-step)) 785 math-working-step (1+ math-working-step))
746 (while (setq y3step (cdr y3step)) 786 (while (setq calc-graph-y3step (cdr calc-graph-y3step))
747 (setq math-working-step-2 (1+ math-working-step-2) 787 (setq math-working-step-2 (1+ math-working-step-2)
748 var-DUMMY2 (car y3step) 788 var-DUMMY2 (car calc-graph-y3step)
749 zp (cons (math-evaluate-expr yvalue) zp)))) 789 calc-graph-zp (cons (math-evaluate-expr calc-graph-yvalue) calc-graph-zp))))
750 (setq zp (nreverse zp) 790 (setq calc-graph-zp (nreverse calc-graph-zp)
751 numsteps (1- (* numsteps (1+ numsteps3)))))) 791 calc-graph-numsteps (1- (* calc-graph-numsteps (1+ calc-graph-numsteps3))))))
752 792
753(defun calc-graph-format-data () 793(defun calc-graph-format-data ()
754 (while (<= (setq stepcount (1+ stepcount)) numsteps) 794 (while (<= (setq calc-graph-stepcount (1+ calc-graph-stepcount)) calc-graph-numsteps)
755 (if xvec 795 (if calc-graph-xvec
756 (setq xp (cdr xp) 796 (setq calc-graph-xp (cdr calc-graph-xp)
757 xval (car xp) 797 calc-graph-xval (car calc-graph-xp)
758 yp (cdr yp) 798 calc-graph-yp (cdr calc-graph-yp)
759 yval (car yp) 799 calc-graph-yval (car calc-graph-yp)
760 zp (cdr zp) 800 calc-graph-zp (cdr calc-graph-zp)
761 zval (car zp)) 801 calc-graph-zval (car calc-graph-zp))
762 (if yvec 802 (if calc-graph-yvec
763 (setq xval xvalue 803 (setq calc-graph-xval calc-graph-xvalue
764 xvalue (math-add xvalue xstep) 804 calc-graph-xvalue (math-add calc-graph-xvalue calc-graph-xstep)
765 yp (cdr yp) 805 calc-graph-yp (cdr calc-graph-yp)
766 yval (car yp)) 806 calc-graph-yval (car calc-graph-yp))
767 (setq xval (car (car yp)) 807 (setq calc-graph-xval (car (car calc-graph-yp))
768 yval (cdr (car yp)) 808 calc-graph-yval (cdr (car calc-graph-yp))
769 yp (cdr yp)) 809 calc-graph-yp (cdr calc-graph-yp))
770 (if (or (not yp) 810 (if (or (not calc-graph-yp)
771 (and xhigh (equal xval xhigh))) 811 (and calc-graph-xhigh (equal calc-graph-xval calc-graph-xhigh)))
772 (setq numsteps 0)))) 812 (setq calc-graph-numsteps 0))))
773 (if is-splot 813 (if calc-graph-is-splot
774 (if (and (eq (car-safe zval) 'calcFunc-xyz) 814 (if (and (eq (car-safe calc-graph-zval) 'calcFunc-xyz)
775 (= (length zval) 4)) 815 (= (length calc-graph-zval) 4))
776 (setq xval (nth 1 zval) 816 (setq calc-graph-xval (nth 1 calc-graph-zval)
777 yval (nth 2 zval) 817 calc-graph-yval (nth 2 calc-graph-zval)
778 zval (nth 3 zval))) 818 calc-graph-zval (nth 3 calc-graph-zval)))
779 (if (and (eq (car-safe yval) 'calcFunc-xyz) 819 (if (and (eq (car-safe calc-graph-yval) 'calcFunc-xyz)
780 (= (length yval) 4)) 820 (= (length calc-graph-yval) 4))
781 (progn 821 (progn
782 (or surprise-splot 822 (or calc-graph-surprise-splot
783 (save-excursion 823 (save-excursion
784 (set-buffer (get-buffer-create "*Gnuplot Temp*")) 824 (set-buffer (get-buffer-create "*Gnuplot Temp*"))
785 (save-excursion 825 (save-excursion
786 (goto-char (point-max)) 826 (goto-char (point-max))
787 (re-search-backward "^plot[ \t]") 827 (re-search-backward "^plot[ \t]")
788 (insert "set parametric\ns") 828 (insert "set parametric\ns")
789 (setq surprise-splot t)))) 829 (setq calc-graph-surprise-splot t))))
790 (setq xval (nth 1 yval) 830 (setq calc-graph-xval (nth 1 calc-graph-yval)
791 zval (nth 3 yval) 831 calc-graph-zval (nth 3 calc-graph-yval)
792 yval (nth 2 yval))) 832 calc-graph-yval (nth 2 calc-graph-yval)))
793 (if (and (eq (car-safe yval) 'calcFunc-xy) 833 (if (and (eq (car-safe calc-graph-yval) 'calcFunc-xy)
794 (= (length yval) 3)) 834 (= (length calc-graph-yval) 3))
795 (setq xval (nth 1 yval) 835 (setq calc-graph-xval (nth 1 calc-graph-yval)
796 yval (nth 2 yval))))) 836 calc-graph-yval (nth 2 calc-graph-yval)))))
797 (if (and (Math-realp xval) 837 (if (and (Math-realp calc-graph-xval)
798 (Math-realp yval) 838 (Math-realp calc-graph-yval)
799 (or (not zval) (Math-realp zval))) 839 (or (not calc-graph-zval) (Math-realp calc-graph-zval)))
800 (progn 840 (progn
801 (setq blank nil 841 (setq calc-graph-blank nil
802 non-blank t) 842 calc-graph-non-blank t)
803 (if (Math-integerp xval) 843 (if (Math-integerp calc-graph-xval)
804 (insert (math-format-number xval)) 844 (insert (math-format-number calc-graph-xval))
805 (if (eq (car xval) 'frac) 845 (if (eq (car calc-graph-xval) 'frac)
806 (setq xval (math-float xval))) 846 (setq calc-graph-xval (math-float calc-graph-xval)))
807 (insert (math-format-number (nth 1 xval)) 847 (insert (math-format-number (nth 1 calc-graph-xval))
808 "e" (int-to-string (nth 2 xval)))) 848 "e" (int-to-string (nth 2 calc-graph-xval))))
809 (insert " ") 849 (insert " ")
810 (if (Math-integerp yval) 850 (if (Math-integerp calc-graph-yval)
811 (insert (math-format-number yval)) 851 (insert (math-format-number calc-graph-yval))
812 (if (eq (car yval) 'frac) 852 (if (eq (car calc-graph-yval) 'frac)
813 (setq yval (math-float yval))) 853 (setq calc-graph-yval (math-float calc-graph-yval)))
814 (insert (math-format-number (nth 1 yval)) 854 (insert (math-format-number (nth 1 calc-graph-yval))
815 "e" (int-to-string (nth 2 yval)))) 855 "e" (int-to-string (nth 2 calc-graph-yval))))
816 (if zval 856 (if calc-graph-zval
817 (progn 857 (progn
818 (insert " ") 858 (insert " ")
819 (if (Math-integerp zval) 859 (if (Math-integerp calc-graph-zval)
820 (insert (math-format-number zval)) 860 (insert (math-format-number calc-graph-zval))
821 (if (eq (car zval) 'frac) 861 (if (eq (car calc-graph-zval) 'frac)
822 (setq zval (math-float zval))) 862 (setq calc-graph-zval (math-float calc-graph-zval)))
823 (insert (math-format-number (nth 1 zval)) 863 (insert (math-format-number (nth 1 calc-graph-zval))
824 "e" (int-to-string (nth 2 zval)))))) 864 "e" (int-to-string (nth 2 calc-graph-zval))))))
825 (insert "\n")) 865 (insert "\n"))
826 (and (not (equal zval '(skip))) 866 (and (not (equal calc-graph-zval '(skip)))
827 (boundp 'var-PlotRejects)
828 (eq (car-safe var-PlotRejects) 'vec) 867 (eq (car-safe var-PlotRejects) 'vec)
829 (nconc var-PlotRejects 868 (nconc var-PlotRejects
830 (list (list 'vec 869 (list (list 'vec
831 curve-num 870 calc-graph-curve-num
832 stepcount 871 calc-graph-stepcount
833 xval yval))) 872 calc-graph-xval calc-graph-yval)))
834 (calc-refresh-evaltos 'var-PlotRejects)) 873 (calc-refresh-evaltos 'var-PlotRejects))
835 (or blank 874 (or calc-graph-blank
836 (progn 875 (progn
837 (insert "\n") 876 (insert "\n")
838 (setq blank t)))))) 877 (setq calc-graph-blank t))))))
839 878
840(defun calc-temp-file-name (num) 879(defun calc-temp-file-name (num)
841 (while (<= (length calc-graph-file-cache) (1+ num)) 880 (while (<= (length calc-graph-file-cache) (1+ num))
@@ -859,9 +898,7 @@
859 (setq calc-graph-file-cache (cdr calc-graph-file-cache)))) 898 (setq calc-graph-file-cache (cdr calc-graph-file-cache))))
860 899
861(defun calc-graph-kill-hook () 900(defun calc-graph-kill-hook ()
862 (calc-graph-delete-temps) 901 (calc-graph-delete-temps))
863 (if calc-graph-prev-kill-hook
864 (funcall calc-graph-prev-kill-hook)))
865 902
866(defun calc-graph-show-tty (output) 903(defun calc-graph-show-tty (output)
867 "Default calc-gnuplot-plot-command for \"tty\" output mode. 904 "Default calc-gnuplot-plot-command for \"tty\" output mode.
@@ -870,6 +907,9 @@ This is useful for tek40xx and other graphics-terminal types."
870 nil calc-gnuplot-buffer nil 907 nil calc-gnuplot-buffer nil
871 "-c" (format "cat %s >/dev/tty; rm %s" output output))) 908 "-c" (format "cat %s >/dev/tty; rm %s" output output)))
872 909
910(defvar calc-dumb-map nil
911 "The keymap for the \"dumb\" terminal plot.")
912
873(defun calc-graph-show-dumb (&optional output) 913(defun calc-graph-show-dumb (&optional output)
874 "Default calc-gnuplot-plot-command for Pinard's \"dumb\" terminal type. 914 "Default calc-gnuplot-plot-command for Pinard's \"dumb\" terminal type.
875This \"dumb\" driver will be present in Gnuplot 3.0." 915This \"dumb\" driver will be present in Gnuplot 3.0."
@@ -882,7 +922,6 @@ This \"dumb\" driver will be present in Gnuplot 3.0."
882 (sleep-for 1)) 922 (sleep-for 1))
883 (goto-char (point-max)) 923 (goto-char (point-max))
884 (re-search-backward "\f\\|^[ \t]+\\^$\\|G N U P L O T") 924 (re-search-backward "\f\\|^[ \t]+\\^$\\|G N U P L O T")
885 (setq found-pt (point))
886 (if (looking-at "\f") 925 (if (looking-at "\f")
887 (progn 926 (progn
888 (forward-char 1) 927 (forward-char 1)
@@ -898,7 +937,7 @@ This \"dumb\" driver will be present in Gnuplot 3.0."
898 (end-of-line) 937 (end-of-line)
899 (backward-char 1) 938 (backward-char 1)
900 (recenter '(4))) 939 (recenter '(4)))
901 (or (boundp 'calc-dumb-map) 940 (or calc-dumb-map
902 (progn 941 (progn
903 (setq calc-dumb-map (make-sparse-keymap)) 942 (setq calc-dumb-map (make-sparse-keymap))
904 (define-key calc-dumb-map "\n" 'scroll-up) 943 (define-key calc-dumb-map "\n" 'scroll-up)
@@ -1097,7 +1136,8 @@ This \"dumb\" driver will be present in Gnuplot 3.0."
1097 (or (calc-graph-find-plot nil nil) 1136 (or (calc-graph-find-plot nil nil)
1098 (error "No data points have been set!")) 1137 (error "No data points have been set!"))
1099 (let ((base (point)) 1138 (let ((base (point))
1100 start) 1139 start
1140 end)
1101 (re-search-forward "[,\n]\\|[ \t]+with") 1141 (re-search-forward "[,\n]\\|[ \t]+with")
1102 (setq end (match-beginning 0)) 1142 (setq end (match-beginning 0))
1103 (goto-char base) 1143 (goto-char base)
diff --git a/lisp/calc/calc-lang.el b/lisp/calc/calc-lang.el
index bb6699a4ac9..ee00e022553 100644
--- a/lisp/calc/calc-lang.el
+++ b/lisp/calc/calc-lang.el
@@ -263,15 +263,15 @@
263 (let ((math-parsing-fortran-vector '(end . "\000"))) 263 (let ((math-parsing-fortran-vector '(end . "\000")))
264 (prog1 264 (prog1
265 (math-read-brackets t "]") 265 (math-read-brackets t "]")
266 (setq exp-token (car math-parsing-fortran-vector) 266 (setq math-exp-token (car math-parsing-fortran-vector)
267 exp-data (cdr math-parsing-fortran-vector))))) 267 math-expr-data (cdr math-parsing-fortran-vector)))))
268 268
269(defun math-parse-fortran-vector-end (x op) 269(defun math-parse-fortran-vector-end (x op)
270 (if math-parsing-fortran-vector 270 (if math-parsing-fortran-vector
271 (progn 271 (progn
272 (setq math-parsing-fortran-vector (cons exp-token exp-data) 272 (setq math-parsing-fortran-vector (cons math-exp-token math-expr-data)
273 exp-token 'end 273 math-exp-token 'end
274 exp-data "\000") 274 math-expr-data "\000")
275 x) 275 x)
276 (throw 'syntax "Unmatched closing `/'"))) 276 (throw 'syntax "Unmatched closing `/'")))
277 277
@@ -384,15 +384,15 @@
384 384
385(defun math-parse-tex-sum (f val) 385(defun math-parse-tex-sum (f val)
386 (let (low high save) 386 (let (low high save)
387 (or (equal exp-data "_") (throw 'syntax "Expected `_'")) 387 (or (equal math-expr-data "_") (throw 'syntax "Expected `_'"))
388 (math-read-token) 388 (math-read-token)
389 (setq save exp-old-pos) 389 (setq save math-exp-old-pos)
390 (setq low (math-read-factor)) 390 (setq low (math-read-factor))
391 (or (eq (car-safe low) 'calcFunc-eq) 391 (or (eq (car-safe low) 'calcFunc-eq)
392 (progn 392 (progn
393 (setq exp-old-pos (1+ save)) 393 (setq math-exp-old-pos (1+ save))
394 (throw 'syntax "Expected equation"))) 394 (throw 'syntax "Expected equation")))
395 (or (equal exp-data "^") (throw 'syntax "Expected `^'")) 395 (or (equal math-expr-data "^") (throw 'syntax "Expected `^'"))
396 (math-read-token) 396 (math-read-token)
397 (setq high (math-read-factor)) 397 (setq high (math-read-factor))
398 (list (nth 2 f) (math-read-factor) (nth 1 low) (nth 2 low) high))) 398 (list (nth 2 f) (math-read-factor) (nth 1 low) (nth 2 low) high)))
@@ -484,31 +484,31 @@
484 484
485(defun math-parse-eqn-matrix (f sym) 485(defun math-parse-eqn-matrix (f sym)
486 (let ((vec nil)) 486 (let ((vec nil))
487 (while (assoc exp-data '(("ccol") ("lcol") ("rcol"))) 487 (while (assoc math-expr-data '(("ccol") ("lcol") ("rcol")))
488 (math-read-token) 488 (math-read-token)
489 (or (equal exp-data calc-function-open) 489 (or (equal math-expr-data calc-function-open)
490 (throw 'syntax "Expected `{'")) 490 (throw 'syntax "Expected `{'"))
491 (math-read-token) 491 (math-read-token)
492 (setq vec (cons (cons 'vec (math-read-expr-list)) vec)) 492 (setq vec (cons (cons 'vec (math-read-expr-list)) vec))
493 (or (equal exp-data calc-function-close) 493 (or (equal math-expr-data calc-function-close)
494 (throw 'syntax "Expected `}'")) 494 (throw 'syntax "Expected `}'"))
495 (math-read-token)) 495 (math-read-token))
496 (or (equal exp-data calc-function-close) 496 (or (equal math-expr-data calc-function-close)
497 (throw 'syntax "Expected `}'")) 497 (throw 'syntax "Expected `}'"))
498 (math-read-token) 498 (math-read-token)
499 (math-transpose (cons 'vec (nreverse vec))))) 499 (math-transpose (cons 'vec (nreverse vec)))))
500 500
501(defun math-parse-eqn-prime (x sym) 501(defun math-parse-eqn-prime (x sym)
502 (if (eq (car-safe x) 'var) 502 (if (eq (car-safe x) 'var)
503 (if (equal exp-data calc-function-open) 503 (if (equal math-expr-data calc-function-open)
504 (progn 504 (progn
505 (math-read-token) 505 (math-read-token)
506 (let ((args (if (or (equal exp-data calc-function-close) 506 (let ((args (if (or (equal math-expr-data calc-function-close)
507 (eq exp-token 'end)) 507 (eq math-exp-token 'end))
508 nil 508 nil
509 (math-read-expr-list)))) 509 (math-read-expr-list))))
510 (if (not (or (equal exp-data calc-function-close) 510 (if (not (or (equal math-expr-data calc-function-close)
511 (eq exp-token 'end))) 511 (eq math-exp-token 'end)))
512 (throw 'syntax "Expected `)'")) 512 (throw 'syntax "Expected `)'"))
513 (math-read-token) 513 (math-read-token)
514 (cons (intern (format "calcFunc-%s'" (nth 1 x))) args))) 514 (cons (intern (format "calcFunc-%s'" (nth 1 x))) args)))
@@ -622,10 +622,10 @@
622 622
623(defun math-read-math-subscr (x op) 623(defun math-read-math-subscr (x op)
624 (let ((idx (math-read-expr-level 0))) 624 (let ((idx (math-read-expr-level 0)))
625 (or (and (equal exp-data "]") 625 (or (and (equal math-expr-data "]")
626 (progn 626 (progn
627 (math-read-token) 627 (math-read-token)
628 (equal exp-data "]"))) 628 (equal math-expr-data "]")))
629 (throw 'syntax "Expected ']]'")) 629 (throw 'syntax "Expected ']]'"))
630 (math-read-token) 630 (math-read-token)
631 (list 'calcFunc-subscr x idx))) 631 (list 'calcFunc-subscr x idx)))
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 @@
1040 (memq (car-safe (nth 1 expr)) '(+ -)) 1040 (memq (car-safe (nth 1 expr)) '(+ -))
1041 (integerp (nth 2 expr)) 1041 (integerp (nth 2 expr))
1042 (if (> (nth 2 expr) 0) 1042 (if (> (nth 2 expr) 0)
1043 (or (and (or (> mmt-many 500000) (< mmt-many -500000)) 1043 (or (and (or (> math-mt-many 500000) (< math-mt-many -500000))
1044 (math-expand-power (nth 1 expr) (nth 2 expr) 1044 (math-expand-power (nth 1 expr) (nth 2 expr)
1045 nil t)) 1045 nil t))
1046 (list '* 1046 (list '*
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 @@
166 166
167 167
168 168
169(defun math-rewrite (whole-expr rules &optional mmt-many) 169(defun math-rewrite (whole-expr rules &optional math-mt-many)
170 (let ((crules (math-compile-rewrites rules)) 170 (let ((crules (math-compile-rewrites rules))
171 (heads (math-rewrite-heads whole-expr)) 171 (heads (math-rewrite-heads whole-expr))
172 (trace-buffer (get-buffer "*Trace*")) 172 (trace-buffer (get-buffer "*Trace*"))
@@ -176,20 +176,20 @@
176 (calc-line-numbering nil) 176 (calc-line-numbering nil)
177 (calc-show-selections t) 177 (calc-show-selections t)
178 (calc-why nil) 178 (calc-why nil)
179 (mmt-func (function 179 (math-mt-func (function
180 (lambda (x) 180 (lambda (x)
181 (let ((result (math-apply-rewrites x (cdr crules) 181 (let ((result (math-apply-rewrites x (cdr crules)
182 heads crules))) 182 heads crules)))
183 (if result 183 (if result
184 (progn 184 (progn
185 (if trace-buffer 185 (if trace-buffer
186 (let ((fmt (math-format-stack-value 186 (let ((fmt (math-format-stack-value
187 (list result nil nil)))) 187 (list result nil nil))))
188 (save-excursion 188 (save-excursion
189 (set-buffer trace-buffer) 189 (set-buffer trace-buffer)
190 (insert "\nrewrite to\n" fmt "\n")))) 190 (insert "\nrewrite to\n" fmt "\n"))))
191 (setq heads (math-rewrite-heads result heads t)))) 191 (setq heads (math-rewrite-heads result heads t))))
192 result))))) 192 result)))))
193 (if trace-buffer 193 (if trace-buffer
194 (let ((fmt (math-format-stack-value (list whole-expr nil nil)))) 194 (let ((fmt (math-format-stack-value (list whole-expr nil nil))))
195 (save-excursion 195 (save-excursion
@@ -197,22 +197,22 @@
197 (setq truncate-lines t) 197 (setq truncate-lines t)
198 (goto-char (point-max)) 198 (goto-char (point-max))
199 (insert "\n\nBegin rewriting\n" fmt "\n")))) 199 (insert "\n\nBegin rewriting\n" fmt "\n"))))
200 (or mmt-many (setq mmt-many (or (nth 1 (car crules)) 200 (or math-mt-many (setq math-mt-many (or (nth 1 (car crules))
201 math-rewrite-default-iters))) 201 math-rewrite-default-iters)))
202 (if (equal mmt-many '(var inf var-inf)) (setq mmt-many 1000000)) 202 (if (equal math-mt-many '(var inf var-inf)) (setq math-mt-many 1000000))
203 (if (equal mmt-many '(neg (var inf var-inf))) (setq mmt-many -1000000)) 203 (if (equal math-mt-many '(neg (var inf var-inf))) (setq math-mt-many -1000000))
204 (math-rewrite-phase (nth 3 (car crules))) 204 (math-rewrite-phase (nth 3 (car crules)))
205 (if trace-buffer 205 (if trace-buffer
206 (let ((fmt (math-format-stack-value (list whole-expr nil nil)))) 206 (let ((fmt (math-format-stack-value (list whole-expr nil nil))))
207 (save-excursion 207 (save-excursion
208 (set-buffer trace-buffer) 208 (set-buffer trace-buffer)
209 (insert "\nDone rewriting" 209 (insert "\nDone rewriting"
210 (if (= mmt-many 0) " (reached iteration limit)" "") 210 (if (= math-mt-many 0) " (reached iteration limit)" "")
211 ":\n" fmt "\n")))) 211 ":\n" fmt "\n"))))
212 whole-expr)) 212 whole-expr))
213 213
214(defun math-rewrite-phase (sched) 214(defun math-rewrite-phase (sched)
215 (while (and sched (/= mmt-many 0)) 215 (while (and sched (/= math-mt-many 0))
216 (if (listp (car sched)) 216 (if (listp (car sched))
217 (while (let ((save-expr whole-expr)) 217 (while (let ((save-expr whole-expr))
218 (math-rewrite-phase (car sched)) 218 (math-rewrite-phase (car sched))
diff --git a/lisp/calc/calc-vec.el b/lisp/calc/calc-vec.el
index 51d7450278e..a78f98ec3cc 100644
--- a/lisp/calc/calc-vec.el
+++ b/lisp/calc/calc-vec.el
@@ -1466,103 +1466,103 @@
1466(defun math-read-brackets (space-sep close) 1466(defun math-read-brackets (space-sep close)
1467 (and space-sep (setq space-sep (not (math-check-for-commas)))) 1467 (and space-sep (setq space-sep (not (math-check-for-commas))))
1468 (math-read-token) 1468 (math-read-token)
1469 (while (eq exp-token 'space) 1469 (while (eq math-exp-token 'space)
1470 (math-read-token)) 1470 (math-read-token))
1471 (if (or (equal exp-data close) 1471 (if (or (equal math-expr-data close)
1472 (eq exp-token 'end)) 1472 (eq math-exp-token 'end))
1473 (progn 1473 (progn
1474 (math-read-token) 1474 (math-read-token)
1475 '(vec)) 1475 '(vec))
1476 (let ((save-exp-pos exp-pos) 1476 (let ((save-exp-pos math-exp-pos)
1477 (save-exp-old-pos exp-old-pos) 1477 (save-exp-old-pos math-exp-old-pos)
1478 (save-exp-token exp-token) 1478 (save-exp-token math-exp-token)
1479 (save-exp-data exp-data) 1479 (save-exp-data math-expr-data)
1480 (vals (let ((exp-keep-spaces space-sep)) 1480 (vals (let ((math-exp-keep-spaces space-sep))
1481 (if (or (equal exp-data "\\dots") 1481 (if (or (equal math-expr-data "\\dots")
1482 (equal exp-data "\\ldots")) 1482 (equal math-expr-data "\\ldots"))
1483 '(vec (neg (var inf var-inf))) 1483 '(vec (neg (var inf var-inf)))
1484 (catch 'syntax (math-read-vector)))))) 1484 (catch 'syntax (math-read-vector))))))
1485 (if (stringp vals) 1485 (if (stringp vals)
1486 (if space-sep 1486 (if space-sep
1487 (let ((error-exp-pos exp-pos) 1487 (let ((error-exp-pos math-exp-pos)
1488 (error-exp-old-pos exp-old-pos) 1488 (error-exp-old-pos math-exp-old-pos)
1489 vals2) 1489 vals2)
1490 (setq exp-pos save-exp-pos 1490 (setq math-exp-pos save-exp-pos
1491 exp-old-pos save-exp-old-pos 1491 math-exp-old-pos save-exp-old-pos
1492 exp-token save-exp-token 1492 math-exp-token save-exp-token
1493 exp-data save-exp-data) 1493 math-expr-data save-exp-data)
1494 (let ((exp-keep-spaces nil)) 1494 (let ((math-exp-keep-spaces nil))
1495 (setq vals2 (catch 'syntax (math-read-vector)))) 1495 (setq vals2 (catch 'syntax (math-read-vector))))
1496 (if (and (not (stringp vals2)) 1496 (if (and (not (stringp vals2))
1497 (or (assoc exp-data '(("\\ldots") ("\\dots") (";"))) 1497 (or (assoc math-expr-data '(("\\ldots") ("\\dots") (";")))
1498 (equal exp-data close) 1498 (equal math-expr-data close)
1499 (eq exp-token 'end))) 1499 (eq math-exp-token 'end)))
1500 (setq space-sep nil 1500 (setq space-sep nil
1501 vals vals2) 1501 vals vals2)
1502 (setq exp-pos error-exp-pos 1502 (setq math-exp-pos error-exp-pos
1503 exp-old-pos error-exp-old-pos) 1503 math-exp-old-pos error-exp-old-pos)
1504 (throw 'syntax vals))) 1504 (throw 'syntax vals)))
1505 (throw 'syntax vals))) 1505 (throw 'syntax vals)))
1506 (if (or (equal exp-data "\\dots") 1506 (if (or (equal math-expr-data "\\dots")
1507 (equal exp-data "\\ldots")) 1507 (equal math-expr-data "\\ldots"))
1508 (progn 1508 (progn
1509 (math-read-token) 1509 (math-read-token)
1510 (setq vals (if (> (length vals) 2) 1510 (setq vals (if (> (length vals) 2)
1511 (cons 'calcFunc-mul (cdr vals)) (nth 1 vals))) 1511 (cons 'calcFunc-mul (cdr vals)) (nth 1 vals)))
1512 (let ((exp2 (if (or (equal exp-data close) 1512 (let ((exp2 (if (or (equal math-expr-data close)
1513 (equal exp-data ")") 1513 (equal math-expr-data ")")
1514 (eq exp-token 'end)) 1514 (eq math-exp-token 'end))
1515 '(var inf var-inf) 1515 '(var inf var-inf)
1516 (math-read-expr-level 0)))) 1516 (math-read-expr-level 0))))
1517 (setq vals 1517 (setq vals
1518 (list 'intv 1518 (list 'intv
1519 (if (equal exp-data ")") 2 3) 1519 (if (equal math-expr-data ")") 2 3)
1520 vals 1520 vals
1521 exp2))) 1521 exp2)))
1522 (if (not (or (equal exp-data close) 1522 (if (not (or (equal math-expr-data close)
1523 (equal exp-data ")") 1523 (equal math-expr-data ")")
1524 (eq exp-token 'end))) 1524 (eq math-exp-token 'end)))
1525 (throw 'syntax "Expected `]'"))) 1525 (throw 'syntax "Expected `]'")))
1526 (if (equal exp-data ";") 1526 (if (equal math-expr-data ";")
1527 (let ((exp-keep-spaces space-sep)) 1527 (let ((math-exp-keep-spaces space-sep))
1528 (setq vals (cons 'vec (math-read-matrix (list vals)))))) 1528 (setq vals (cons 'vec (math-read-matrix (list vals))))))
1529 (if (not (or (equal exp-data close) 1529 (if (not (or (equal math-expr-data close)
1530 (eq exp-token 'end))) 1530 (eq math-exp-token 'end)))
1531 (throw 'syntax "Expected `]'"))) 1531 (throw 'syntax "Expected `]'")))
1532 (or (eq exp-token 'end) 1532 (or (eq math-exp-token 'end)
1533 (math-read-token)) 1533 (math-read-token))
1534 vals))) 1534 vals)))
1535 1535
1536(defun math-check-for-commas (&optional balancing) 1536(defun math-check-for-commas (&optional balancing)
1537 (let ((count 0) 1537 (let ((count 0)
1538 (pos (1- exp-pos))) 1538 (pos (1- math-exp-pos)))
1539 (while (and (>= count 0) 1539 (while (and (>= count 0)
1540 (setq pos (string-match 1540 (setq pos (string-match
1541 (if balancing "[],[{}()<>]" "[],[{}()]") 1541 (if balancing "[],[{}()<>]" "[],[{}()]")
1542 exp-str (1+ pos))) 1542 math-exp-str (1+ pos)))
1543 (or (/= (aref exp-str pos) ?,) (> count 0) balancing)) 1543 (or (/= (aref math-exp-str pos) ?,) (> count 0) balancing))
1544 (cond ((memq (aref exp-str pos) '(?\[ ?\{ ?\( ?\<)) 1544 (cond ((memq (aref math-exp-str pos) '(?\[ ?\{ ?\( ?\<))
1545 (setq count (1+ count))) 1545 (setq count (1+ count)))
1546 ((memq (aref exp-str pos) '(?\] ?\} ?\) ?\>)) 1546 ((memq (aref math-exp-str pos) '(?\] ?\} ?\) ?\>))
1547 (setq count (1- count))))) 1547 (setq count (1- count)))))
1548 (if balancing 1548 (if balancing
1549 pos 1549 pos
1550 (and pos (= (aref exp-str pos) ?,))))) 1550 (and pos (= (aref math-exp-str pos) ?,)))))
1551 1551
1552(defun math-read-vector () 1552(defun math-read-vector ()
1553 (let* ((val (list (math-read-expr-level 0))) 1553 (let* ((val (list (math-read-expr-level 0)))
1554 (last val)) 1554 (last val))
1555 (while (progn 1555 (while (progn
1556 (while (eq exp-token 'space) 1556 (while (eq math-exp-token 'space)
1557 (math-read-token)) 1557 (math-read-token))
1558 (and (not (eq exp-token 'end)) 1558 (and (not (eq math-exp-token 'end))
1559 (not (equal exp-data ";")) 1559 (not (equal math-expr-data ";"))
1560 (not (equal exp-data close)) 1560 (not (equal math-expr-data close))
1561 (not (equal exp-data "\\dots")) 1561 (not (equal math-expr-data "\\dots"))
1562 (not (equal exp-data "\\ldots")))) 1562 (not (equal math-expr-data "\\ldots"))))
1563 (if (equal exp-data ",") 1563 (if (equal math-expr-data ",")
1564 (math-read-token)) 1564 (math-read-token))
1565 (while (eq exp-token 'space) 1565 (while (eq math-exp-token 'space)
1566 (math-read-token)) 1566 (math-read-token))
1567 (let ((rest (list (math-read-expr-level 0)))) 1567 (let ((rest (list (math-read-expr-level 0))))
1568 (setcdr last rest) 1568 (setcdr last rest)
@@ -1570,9 +1570,9 @@
1570 (cons 'vec val))) 1570 (cons 'vec val)))
1571 1571
1572(defun math-read-matrix (mat) 1572(defun math-read-matrix (mat)
1573 (while (equal exp-data ";") 1573 (while (equal math-expr-data ";")
1574 (math-read-token) 1574 (math-read-token)
1575 (while (eq exp-token 'space) 1575 (while (eq math-exp-token 'space)
1576 (math-read-token)) 1576 (math-read-token))
1577 (setq mat (nconc mat (list (math-read-vector))))) 1577 (setq mat (nconc mat (list (math-read-vector)))))
1578 mat) 1578 mat)
diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el
index 4ace5fb6780..6480b1960a5 100644
--- a/lisp/calc/calc.el
+++ b/lisp/calc/calc.el
@@ -654,6 +654,20 @@ If nil, selections displayed but ignored.")
654 calc-word-size 654 calc-word-size
655 calc-internal-prec)) 655 calc-internal-prec))
656 656
657(defvar calc-mode-hook nil
658 "Hook run when entering calc-mode.")
659
660(defvar calc-trail-mode-hook nil
661 "Hook run when entering calc-trail-mode.")
662
663(defvar calc-start-hook nil
664 "Hook run when calc is started.")
665
666(defvar calc-end-hook nil
667 "Hook run when calc is quit.")
668
669(defvar calc-load-hook nil
670 "Hook run when calc.el is loaded.")
657 671
658;; Verify that Calc is running on the right kind of system. 672;; Verify that Calc is running on the right kind of system.
659(defvar calc-emacs-type-lucid (not (not (string-match "Lucid" emacs-version)))) 673(defvar calc-emacs-type-lucid (not (not (string-match "Lucid" emacs-version))))
@@ -1056,9 +1070,6 @@ Notations: 3.14e6 3.14 * 10^6
1056 (progn 1070 (progn
1057 (setq calc-loaded-settings-file t) 1071 (setq calc-loaded-settings-file t)
1058 (load calc-settings-file t))) ; t = missing-ok 1072 (load calc-settings-file t))) ; t = missing-ok
1059 (if (and (eq window-system 'x) (boundp 'mouse-map))
1060 (substitute-key-definition 'x-paste-text 'calc-x-paste-text
1061 mouse-map))
1062 (let ((p command-line-args)) 1073 (let ((p command-line-args))
1063 (while p 1074 (while p
1064 (and (equal (car p) "-f") 1075 (and (equal (car p) "-f")
@@ -1069,14 +1080,6 @@ Notations: 3.14e6 3.14 * 10^6
1069 (run-hooks 'calc-mode-hook) 1080 (run-hooks 'calc-mode-hook)
1070 (calc-refresh t) 1081 (calc-refresh t)
1071 (calc-set-mode-line) 1082 (calc-set-mode-line)
1072 ;; The calc-defs variable is a relic. Use calc-define properties instead.
1073 (when (and (boundp 'calc-defs)
1074 calc-defs)
1075 (message "Evaluating calc-defs...")
1076 (calc-need-macros)
1077 (eval (cons 'progn calc-defs))
1078 (setq calc-defs nil)
1079 (calc-set-mode-line))
1080 (calc-check-defines)) 1083 (calc-check-defines))
1081 1084
1082(defvar calc-check-defines 'calc-check-defines) ; suitable for run-hooks 1085(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."
1163 (switch-to-buffer (current-buffer) t) 1166 (switch-to-buffer (current-buffer) t)
1164 (if (get-buffer-window (current-buffer)) 1167 (if (get-buffer-window (current-buffer))
1165 (select-window (get-buffer-window (current-buffer))) 1168 (select-window (get-buffer-window (current-buffer)))
1166 (if (and (boundp 'calc-window-hook) calc-window-hook) 1169 (let ((w (get-largest-window)))
1167 (run-hooks 'calc-window-hook) 1170 (if (and pop-up-windows
1168 (let ((w (get-largest-window))) 1171 (> (window-height w)
1169 (if (and pop-up-windows 1172 (+ window-min-height calc-window-height 2)))
1170 (> (window-height w) 1173 (progn
1171 (+ window-min-height calc-window-height 2))) 1174 (setq w (split-window w
1172 (progn 1175 (- (window-height w)
1173 (setq w (split-window w 1176 calc-window-height 2)
1174 (- (window-height w) 1177 nil))
1175 calc-window-height 2) 1178 (set-window-buffer w (current-buffer))
1176 nil)) 1179 (select-window w))
1177 (set-window-buffer w (current-buffer)) 1180 (pop-to-buffer (current-buffer))))))
1178 (select-window w))
1179 (pop-to-buffer (current-buffer)))))))
1180 (save-excursion 1181 (save-excursion
1181 (set-buffer (calc-trail-buffer)) 1182 (set-buffer (calc-trail-buffer))
1182 (and calc-display-trail 1183 (and calc-display-trail
@@ -1722,27 +1723,6 @@ See calc-keypad for details."
1722 (calc-refresh align))) 1723 (calc-refresh align)))
1723 (setq calc-refresh-count (1+ calc-refresh-count))) 1724 (setq calc-refresh-count (1+ calc-refresh-count)))
1724 1725
1725
1726(defun calc-x-paste-text (arg)
1727 "Move point to mouse position and insert window system cut buffer contents.
1728If mouse is pressed in Calc window, push cut buffer contents onto the stack."
1729 (x-mouse-select arg)
1730 (if (memq major-mode '(calc-mode calc-trail-mode))
1731 (progn
1732 (calc-wrapper
1733 (calc-extensions)
1734 (let* ((buf (x-get-cut-buffer))
1735 (val (math-read-exprs (calc-clean-newlines buf))))
1736 (if (eq (car-safe val) 'error)
1737 (progn
1738 (setq val (math-read-exprs buf))
1739 (if (eq (car-safe val) 'error)
1740 (error "%s in yanked data" (nth 2 val)))))
1741 (calc-enter-result 0 "Xynk" val))))
1742 (x-paste-text arg)))
1743
1744
1745
1746;;;; The Calc Trail buffer. 1726;;;; The Calc Trail buffer.
1747 1727
1748(defun calc-check-trail-aligned () 1728(defun calc-check-trail-aligned ()
@@ -1808,10 +1788,8 @@ If mouse is pressed in Calc window, push cut buffer contents onto the stack."
1808 (not (if flag (memq flag '(nil 0)) win))) 1788 (not (if flag (memq flag '(nil 0)) win)))
1809 (if (null win) 1789 (if (null win)
1810 (progn 1790 (progn
1811 (if (and (boundp 'calc-trail-window-hook) calc-trail-window-hook) 1791 (let ((w (split-window nil (/ (* (window-width) 2) 3) t)))
1812 (run-hooks 'calc-trail-window-hook) 1792 (set-window-buffer w calc-trail-buffer))
1813 (let ((w (split-window nil (/ (* (window-width) 2) 3) t)))
1814 (set-window-buffer w calc-trail-buffer)))
1815 (calc-wrapper 1793 (calc-wrapper
1816 (setq overlay-arrow-string calc-trail-overlay 1794 (setq overlay-arrow-string calc-trail-overlay
1817 overlay-arrow-position calc-trail-pointer) 1795 overlay-arrow-position calc-trail-pointer)
@@ -2254,62 +2232,72 @@ If mouse is pressed in Calc window, push cut buffer contents onto the stack."
2254(defvar math-eval-rules-cache) 2232(defvar math-eval-rules-cache)
2255(defvar math-eval-rules-cache-other) 2233(defvar math-eval-rules-cache-other)
2256;;; Reduce an object to canonical (normalized) form. [O o; Z Z] [Public] 2234;;; Reduce an object to canonical (normalized) form. [O o; Z Z] [Public]
2257(defun math-normalize (a) 2235
2236(defvar math-normalize-a)
2237(defun math-normalize (math-normalize-a)
2258 (cond 2238 (cond
2259 ((not (consp a)) 2239 ((not (consp math-normalize-a))
2260 (if (integerp a) 2240 (if (integerp math-normalize-a)
2261 (if (or (>= a 1000000) (<= a -1000000)) 2241 (if (or (>= math-normalize-a 1000000) (<= math-normalize-a -1000000))
2262 (math-bignum a) 2242 (math-bignum math-normalize-a)
2263 a) 2243 math-normalize-a)
2264 a)) 2244 math-normalize-a))
2265 ((eq (car a) 'bigpos) 2245 ((eq (car math-normalize-a) 'bigpos)
2266 (if (eq (nth (1- (length a)) a) 0) 2246 (if (eq (nth (1- (length math-normalize-a)) math-normalize-a) 0)
2267 (let* ((last (setq a (copy-sequence a))) (digs a)) 2247 (let* ((last (setq math-normalize-a
2248 (copy-sequence math-normalize-a))) (digs math-normalize-a))
2268 (while (setq digs (cdr digs)) 2249 (while (setq digs (cdr digs))
2269 (or (eq (car digs) 0) (setq last digs))) 2250 (or (eq (car digs) 0) (setq last digs)))
2270 (setcdr last nil))) 2251 (setcdr last nil)))
2271 (if (cdr (cdr (cdr a))) 2252 (if (cdr (cdr (cdr math-normalize-a)))
2272 a 2253 math-normalize-a
2273 (cond 2254 (cond
2274 ((cdr (cdr a)) (+ (nth 1 a) (* (nth 2 a) 1000))) 2255 ((cdr (cdr math-normalize-a)) (+ (nth 1 math-normalize-a)
2275 ((cdr a) (nth 1 a)) 2256 (* (nth 2 math-normalize-a) 1000)))
2257 ((cdr math-normalize-a) (nth 1 math-normalize-a))
2276 (t 0)))) 2258 (t 0))))
2277 ((eq (car a) 'bigneg) 2259 ((eq (car math-normalize-a) 'bigneg)
2278 (if (eq (nth (1- (length a)) a) 0) 2260 (if (eq (nth (1- (length math-normalize-a)) math-normalize-a) 0)
2279 (let* ((last (setq a (copy-sequence a))) (digs a)) 2261 (let* ((last (setq math-normalize-a (copy-sequence math-normalize-a)))
2262 (digs math-normalize-a))
2280 (while (setq digs (cdr digs)) 2263 (while (setq digs (cdr digs))
2281 (or (eq (car digs) 0) (setq last digs))) 2264 (or (eq (car digs) 0) (setq last digs)))
2282 (setcdr last nil))) 2265 (setcdr last nil)))
2283 (if (cdr (cdr (cdr a))) 2266 (if (cdr (cdr (cdr math-normalize-a)))
2284 a 2267 math-normalize-a
2285 (cond 2268 (cond
2286 ((cdr (cdr a)) (- (+ (nth 1 a) (* (nth 2 a) 1000)))) 2269 ((cdr (cdr math-normalize-a)) (- (+ (nth 1 math-normalize-a)
2287 ((cdr a) (- (nth 1 a))) 2270 (* (nth 2 math-normalize-a) 1000))))
2271 ((cdr math-normalize-a) (- (nth 1 math-normalize-a)))
2288 (t 0)))) 2272 (t 0))))
2289 ((eq (car a) 'float) 2273 ((eq (car math-normalize-a) 'float)
2290 (math-make-float (math-normalize (nth 1 a)) (nth 2 a))) 2274 (math-make-float (math-normalize (nth 1 math-normalize-a))
2291 ((or (memq (car a) '(frac cplx polar hms date mod sdev intv vec var quote 2275 (nth 2 math-normalize-a)))
2292 special-const calcFunc-if calcFunc-lambda 2276 ((or (memq (car math-normalize-a)
2293 calcFunc-quote calcFunc-condition 2277 '(frac cplx polar hms date mod sdev intv vec var quote
2294 calcFunc-evalto)) 2278 special-const calcFunc-if calcFunc-lambda
2295 (integerp (car a)) 2279 calcFunc-quote calcFunc-condition
2296 (and (consp (car a)) (not (eq (car (car a)) 'lambda)))) 2280 calcFunc-evalto))
2281 (integerp (car math-normalize-a))
2282 (and (consp (car math-normalize-a))
2283 (not (eq (car (car math-normalize-a)) 'lambda))))
2297 (calc-extensions) 2284 (calc-extensions)
2298 (math-normalize-fancy a)) 2285 (math-normalize-fancy math-normalize-a))
2299 (t 2286 (t
2300 (or (and calc-simplify-mode 2287 (or (and calc-simplify-mode
2301 (calc-extensions) 2288 (calc-extensions)
2302 (math-normalize-nonstandard)) 2289 (math-normalize-nonstandard))
2303 (let ((args (mapcar 'math-normalize (cdr a)))) 2290 (let ((args (mapcar 'math-normalize (cdr math-normalize-a))))
2304 (or (condition-case err 2291 (or (condition-case err
2305 (let ((func (assq (car a) '( ( + . math-add ) 2292 (let ((func
2306 ( - . math-sub ) 2293 (assq (car math-normalize-a) '( ( + . math-add )
2307 ( * . math-mul ) 2294 ( - . math-sub )
2308 ( / . math-div ) 2295 ( * . math-mul )
2309 ( % . math-mod ) 2296 ( / . math-div )
2310 ( ^ . math-pow ) 2297 ( % . math-mod )
2311 ( neg . math-neg ) 2298 ( ^ . math-pow )
2312 ( | . math-concat ) )))) 2299 ( neg . math-neg )
2300 ( | . math-concat ) ))))
2313 (or (and var-EvalRules 2301 (or (and var-EvalRules
2314 (progn 2302 (progn
2315 (or (eq var-EvalRules math-eval-rules-cache-tag) 2303 (or (eq var-EvalRules math-eval-rules-cache-tag)
@@ -2317,51 +2305,54 @@ If mouse is pressed in Calc window, push cut buffer contents onto the stack."
2317 (calc-extensions) 2305 (calc-extensions)
2318 (math-recompile-eval-rules))) 2306 (math-recompile-eval-rules)))
2319 (and (or math-eval-rules-cache-other 2307 (and (or math-eval-rules-cache-other
2320 (assq (car a) math-eval-rules-cache)) 2308 (assq (car math-normalize-a)
2309 math-eval-rules-cache))
2321 (math-apply-rewrites 2310 (math-apply-rewrites
2322 (cons (car a) args) 2311 (cons (car math-normalize-a) args)
2323 (cdr math-eval-rules-cache) 2312 (cdr math-eval-rules-cache)
2324 nil math-eval-rules-cache)))) 2313 nil math-eval-rules-cache))))
2325 (if func 2314 (if func
2326 (apply (cdr func) args) 2315 (apply (cdr func) args)
2327 (and (or (consp (car a)) 2316 (and (or (consp (car math-normalize-a))
2328 (fboundp (car a)) 2317 (fboundp (car math-normalize-a))
2329 (and (not calc-extensions-loaded) 2318 (and (not calc-extensions-loaded)
2330 (calc-extensions) 2319 (calc-extensions)
2331 (fboundp (car a)))) 2320 (fboundp (car math-normalize-a))))
2332 (apply (car a) args))))) 2321 (apply (car math-normalize-a) args)))))
2333 (wrong-number-of-arguments 2322 (wrong-number-of-arguments
2334 (calc-record-why "*Wrong number of arguments" 2323 (calc-record-why "*Wrong number of arguments"
2335 (cons (car a) args)) 2324 (cons (car math-normalize-a) args))
2336 nil) 2325 nil)
2337 (wrong-type-argument 2326 (wrong-type-argument
2338 (or calc-next-why (calc-record-why "Wrong type of argument" 2327 (or calc-next-why
2339 (cons (car a) args))) 2328 (calc-record-why "Wrong type of argument"
2329 (cons (car math-normalize-a) args)))
2340 nil) 2330 nil)
2341 (args-out-of-range 2331 (args-out-of-range
2342 (calc-record-why "*Argument out of range" (cons (car a) args)) 2332 (calc-record-why "*Argument out of range"
2333 (cons (car math-normalize-a) args))
2343 nil) 2334 nil)
2344 (inexact-result 2335 (inexact-result
2345 (calc-record-why "No exact representation for result" 2336 (calc-record-why "No exact representation for result"
2346 (cons (car a) args)) 2337 (cons (car math-normalize-a) args))
2347 nil) 2338 nil)
2348 (math-overflow 2339 (math-overflow
2349 (calc-record-why "*Floating-point overflow occurred" 2340 (calc-record-why "*Floating-point overflow occurred"
2350 (cons (car a) args)) 2341 (cons (car math-normalize-a) args))
2351 nil) 2342 nil)
2352 (math-underflow 2343 (math-underflow
2353 (calc-record-why "*Floating-point underflow occurred" 2344 (calc-record-why "*Floating-point underflow occurred"
2354 (cons (car a) args)) 2345 (cons (car math-normalize-a) args))
2355 nil) 2346 nil)
2356 (void-variable 2347 (void-variable
2357 (if (eq (nth 1 err) 'var-EvalRules) 2348 (if (eq (nth 1 err) 'var-EvalRules)
2358 (progn 2349 (progn
2359 (setq var-EvalRules nil) 2350 (setq var-EvalRules nil)
2360 (math-normalize (cons (car a) args))) 2351 (math-normalize (cons (car math-normalize-a) args)))
2361 (calc-record-why "*Variable is void" (nth 1 err))))) 2352 (calc-record-why "*Variable is void" (nth 1 err)))))
2362 (if (consp (car a)) 2353 (if (consp (car math-normalize-a))
2363 (math-dimension-error) 2354 (math-dimension-error)
2364 (cons (car a) args)))))))) 2355 (cons (car math-normalize-a) args))))))))
2365 2356
2366 2357
2367 2358
diff --git a/lisp/calc/calcalg2.el b/lisp/calc/calcalg2.el
index 2a463009e58..ff23c3e5421 100644
--- a/lisp/calc/calcalg2.el
+++ b/lisp/calc/calcalg2.el
@@ -738,8 +738,12 @@
738 (setcar (cdr cur-record) 'cancelled))) 738 (setcar (cdr cur-record) 'cancelled)))
739 (math-replace-integral-parts (car expr))))))) 739 (math-replace-integral-parts (car expr)))))))
740 740
741(defvar math-linear-subst-tried t
742 "Non-nil means that a linear substitution has been tried.")
743
741(defun math-do-integral (expr) 744(defun math-do-integral (expr)
742 (let (t1 t2) 745 (let ((math-linear-subst-tried nil)
746 t1 t2)
743 (or (cond ((not (math-expr-contains expr math-integ-var)) 747 (or (cond ((not (math-expr-contains expr math-integ-var))
744 (math-mul expr math-integ-var)) 748 (math-mul expr math-integ-var))
745 ((equal expr math-integ-var) 749 ((equal expr math-integ-var)
@@ -977,9 +981,8 @@
977 981
978 ;; Integration by substitution, for various likely sub-expressions. 982 ;; Integration by substitution, for various likely sub-expressions.
979 ;; (In first pass, we look only for sub-exprs that are linear in X.) 983 ;; (In first pass, we look only for sub-exprs that are linear in X.)
980 (or (if math-enable-subst 984 (or (math-integ-try-linear-substitutions expr)
981 (math-integ-try-substitutions expr) 985 (math-integ-try-substitutions expr)
982 (math-integ-try-linear-substitutions expr))
983 986
984 ;; If function has sines and cosines, try tan(x/2) substitution. 987 ;; If function has sines and cosines, try tan(x/2) substitution.
985 (and (let ((p (setq rat-in (math-expr-rational-in expr)))) 988 (and (let ((p (setq rat-in (math-expr-rational-in expr))))
@@ -1189,6 +1192,7 @@
1189 1192
1190;;; Look for substitutions of the form u = a x + b. 1193;;; Look for substitutions of the form u = a x + b.
1191(defun math-integ-try-linear-substitutions (sub-expr) 1194(defun math-integ-try-linear-substitutions (sub-expr)
1195 (setq math-linear-subst-tried t)
1192 (and (not (Math-primp sub-expr)) 1196 (and (not (Math-primp sub-expr))
1193 (or (and (not (memq (car sub-expr) '(+ - * / neg))) 1197 (or (and (not (memq (car sub-expr) '(+ - * / neg)))
1194 (not (and (eq (car sub-expr) '^) 1198 (not (and (eq (car sub-expr) '^)
generated by cgit v1.2.1 (git 2.18.0) at 2026-01-19 12:25:11 +0000