diff options
| author | Jay Belanger | 2007-12-02 03:17:22 +0000 |
|---|---|---|
| committer | Jay Belanger | 2007-12-02 03:17:22 +0000 |
| commit | 7cf2461032eddbd1a38b7c21c0a51dbae25fe2a9 (patch) | |
| tree | 3e6d466e51251530e9255edfe791a97ddb186356 | |
| parent | f479e32a8e443a53357905233a7bd5532806d04f (diff) | |
| download | emacs-7cf2461032eddbd1a38b7c21c0a51dbae25fe2a9.tar.gz emacs-7cf2461032eddbd1a38b7c21c0a51dbae25fe2a9.zip | |
(math-compose-vector, math-compose-var, math-tex-expr-is-flat):
Declare as functions.
(calc-lang-slash-idiv, calc-lang-allow-underscores)
math-comp-left-bracket, math-comp-right-bracket, math-comp-comma)
(math-comp-vector-prec): Declare as variables.
(math-var-formatter, math-matrix-formatter,math-lang-adjust-words)
(math-lang-read-symbol, math-land-read, math-punc-table)
(math-compose-subscr,math-dots,math-func-formatter): New property
names to store language specific information.
(math-compose-tex-var, math-compose-tex-intv)
(math-compose-maple-intv, math-compose-eqn-intv, math-compose-tex-sum)
(math-compose-tex-func, math-compose-tex-intv): New functions.
(math-eqn-ignore-words,math-tex-ignore-words,math-latex-ignore-words):
Move from calc.el.
(math-special-function-table): Add entries for tex.
(calc-lang-slash-idiv, calc-lang-allows-underscores): New variables.
(math-compose-latex-frac): Rename from `math-latex-print-frac'.
(math-compose-tex-matrix, math-compose-eqn-matrix)
(math-eqn-special-functions): Move from calccomp.el
| -rw-r--r-- | lisp/calc/calc-lang.el | 535 |
1 files changed, 529 insertions, 6 deletions
diff --git a/lisp/calc/calc-lang.el b/lisp/calc/calc-lang.el index e4c1a345775..a9c3ce0319e 100644 --- a/lisp/calc/calc-lang.el +++ b/lisp/calc/calc-lang.el | |||
| @@ -34,15 +34,25 @@ | |||
| 34 | 34 | ||
| 35 | 35 | ||
| 36 | ;; Declare functions which are defined elsewhere. | 36 | ;; Declare functions which are defined elsewhere. |
| 37 | (declare-function math-compose-vector "calccomp" (a sep prec)) | ||
| 38 | (declare-function math-compose-var "calccomp" (a)) | ||
| 39 | (declare-function math-tex-expr-is-flat "calccomp" (a)) | ||
| 37 | (declare-function math-read-factor "calc-aent" ()) | 40 | (declare-function math-read-factor "calc-aent" ()) |
| 38 | (declare-function math-read-expr-level "calc-aent" (exp-prec &optional exp-term)) | 41 | (declare-function math-read-expr-level "calc-aent" (exp-prec &optional exp-term)) |
| 39 | 42 | ||
| 43 | ;; Declare variables which are defined elsewhere. | ||
| 44 | (defvar calc-lang-slash-idiv) | ||
| 45 | (defvar calc-lang-allow-underscores) | ||
| 46 | (defvar math-comp-left-bracket) | ||
| 47 | (defvar math-comp-right-bracket) | ||
| 48 | (defvar math-comp-comma) | ||
| 49 | (defvar math-comp-vector-prec) | ||
| 50 | |||
| 40 | ;;; Alternate entry/display languages. | 51 | ;;; Alternate entry/display languages. |
| 41 | 52 | ||
| 42 | (defun calc-set-language (lang &optional option no-refresh) | 53 | (defun calc-set-language (lang &optional option no-refresh) |
| 43 | (setq math-expr-opers (or (get lang 'math-oper-table) (math-standard-ops)) | 54 | (setq math-expr-opers (or (get lang 'math-oper-table) (math-standard-ops)) |
| 44 | math-expr-function-mapping (get lang 'math-function-table) | 55 | math-expr-function-mapping (get lang 'math-function-table) |
| 45 | math-expr-special-function-mapping (get lang 'math-special-function-table) | ||
| 46 | math-expr-variable-mapping (get lang 'math-variable-table) | 56 | math-expr-variable-mapping (get lang 'math-variable-table) |
| 47 | calc-language-input-filter (get lang 'math-input-filter) | 57 | calc-language-input-filter (get lang 'math-input-filter) |
| 48 | calc-language-output-filter (get lang 'math-output-filter) | 58 | calc-language-output-filter (get lang 'math-output-filter) |
| @@ -140,6 +150,20 @@ | |||
| 140 | (if (= r 8) (format "0%s" s) | 150 | (if (= r 8) (format "0%s" s) |
| 141 | (format "%d#%s" r s)))))) | 151 | (format "%d#%s" r s)))))) |
| 142 | 152 | ||
| 153 | (put 'c 'math-compose-subscr | ||
| 154 | (function | ||
| 155 | (lambda (a) | ||
| 156 | (let ((args (cdr (cdr a)))) | ||
| 157 | (list 'horiz | ||
| 158 | (math-compose-expr (nth 1 a) 1000) | ||
| 159 | "[" | ||
| 160 | (math-compose-vector args ", " 0) | ||
| 161 | "]"))))) | ||
| 162 | |||
| 163 | (add-to-list 'calc-lang-slash-idiv 'c) | ||
| 164 | (add-to-list 'calc-lang-allow-underscores 'c) | ||
| 165 | (add-to-list 'calc-lang-c-type-hex 'c) | ||
| 166 | (add-to-list 'calc-lang-brackets-are-subscripts 'c) | ||
| 143 | 167 | ||
| 144 | (defun calc-pascal-language (n) | 168 | (defun calc-pascal-language (n) |
| 145 | (interactive "P") | 169 | (interactive "P") |
| @@ -188,6 +212,32 @@ | |||
| 188 | (if (= r 16) (format "$%s" s) | 212 | (if (= r 16) (format "$%s" s) |
| 189 | (format "%d#%s" r s))))) | 213 | (format "%d#%s" r s))))) |
| 190 | 214 | ||
| 215 | (put 'pascal 'math-lang-read-symbol | ||
| 216 | '((?\$ | ||
| 217 | (eq (string-match | ||
| 218 | "\\(\\$[0-9a-fA-F]+\\)\\($\\|[^0-9a-zA-Z]\\)" | ||
| 219 | math-exp-str math-exp-pos) | ||
| 220 | math-exp-pos) | ||
| 221 | (setq math-exp-token 'number | ||
| 222 | math-expr-data (math-match-substring math-exp-str 1) | ||
| 223 | math-exp-pos (match-end 1))))) | ||
| 224 | |||
| 225 | (put 'pascal 'math-compose-subscr | ||
| 226 | (function | ||
| 227 | (lambda (a) | ||
| 228 | (let ((args (cdr (cdr a)))) | ||
| 229 | (while (eq (car-safe (nth 1 a)) 'calcFunc-subscr) | ||
| 230 | (setq args (append (cdr (cdr (nth 1 a))) args) | ||
| 231 | a (nth 1 a))) | ||
| 232 | (list 'horiz | ||
| 233 | (math-compose-expr (nth 1 a) 1000) | ||
| 234 | "[" | ||
| 235 | (math-compose-vector args ", " 0) | ||
| 236 | "]"))))) | ||
| 237 | |||
| 238 | (add-to-list 'calc-lang-allow-underscores 'pascal) | ||
| 239 | (add-to-list 'calc-lang-brackets-are-subscripts 'pascal) | ||
| 240 | |||
| 191 | (defun calc-input-case-filter (str) | 241 | (defun calc-input-case-filter (str) |
| 192 | (cond ((or (null calc-language-option) (= calc-language-option 0)) | 242 | (cond ((or (null calc-language-option) (= calc-language-option 0)) |
| 193 | str) | 243 | str) |
| @@ -258,8 +308,34 @@ | |||
| 258 | ( real . calcFunc-re ))) | 308 | ( real . calcFunc-re ))) |
| 259 | 309 | ||
| 260 | (put 'fortran 'math-input-filter 'calc-input-case-filter) | 310 | (put 'fortran 'math-input-filter 'calc-input-case-filter) |
| 311 | |||
| 261 | (put 'fortran 'math-output-filter 'calc-output-case-filter) | 312 | (put 'fortran 'math-output-filter 'calc-output-case-filter) |
| 262 | 313 | ||
| 314 | (put 'fortran 'math-lang-read-symbol | ||
| 315 | '((?\. | ||
| 316 | (eq (string-match "\\.[a-zA-Z][a-zA-Z][a-zA-Z]?\\." | ||
| 317 | math-exp-str math-exp-pos) math-exp-pos) | ||
| 318 | (setq math-exp-token 'punc | ||
| 319 | math-expr-data (upcase (math-match-substring math-exp-str 0)) | ||
| 320 | math-exp-pos (match-end 0))))) | ||
| 321 | |||
| 322 | (put 'fortran 'math-compose-subscr | ||
| 323 | (function | ||
| 324 | (lambda (a) | ||
| 325 | (let ((args (cdr (cdr a)))) | ||
| 326 | (while (eq (car-safe (nth 1 a)) 'calcFunc-subscr) | ||
| 327 | (setq args (append (cdr (cdr (nth 1 a))) args) | ||
| 328 | a (nth 1 a))) | ||
| 329 | (list 'horiz | ||
| 330 | (math-compose-expr (nth 1 a) 1000) | ||
| 331 | "(" | ||
| 332 | (math-compose-vector args ", " 0) | ||
| 333 | ")"))))) | ||
| 334 | |||
| 335 | (add-to-list 'calc-lang-slash-idiv 'fortran) | ||
| 336 | (add-to-list 'calc-lang-allow-underscores 'fortran) | ||
| 337 | (add-to-list 'calc-lang-parens-are-subscripts 'fortran) | ||
| 338 | |||
| 263 | ;; The next few variables are local to math-read-exprs in calc-aent.el | 339 | ;; The next few variables are local to math-read-exprs in calc-aent.el |
| 264 | ;; and math-read-expr in calc-ext.el, but are set in functions they call. | 340 | ;; and math-read-expr in calc-ext.el, but are set in functions they call. |
| 265 | 341 | ||
| @@ -413,6 +489,11 @@ | |||
| 413 | ( \\phi . calcFunc-totient ) | 489 | ( \\phi . calcFunc-totient ) |
| 414 | ( \\mu . calcFunc-moebius ))) | 490 | ( \\mu . calcFunc-moebius ))) |
| 415 | 491 | ||
| 492 | (put 'tex 'math-special-function-table | ||
| 493 | '((calcFunc-sum . (math-compose-tex-sum "\\sum")) | ||
| 494 | (calcFunc-prod . (math-compose-tex-sum "\\prod")) | ||
| 495 | (intv . math-compose-tex-intv))) | ||
| 496 | |||
| 416 | (put 'tex 'math-variable-table | 497 | (put 'tex 'math-variable-table |
| 417 | '( | 498 | '( |
| 418 | ;; The Greek letters | 499 | ;; The Greek letters |
| @@ -463,8 +544,112 @@ | |||
| 463 | ( \\sum . (math-parse-tex-sum calcFunc-sum) ) | 544 | ( \\sum . (math-parse-tex-sum calcFunc-sum) ) |
| 464 | ( \\prod . (math-parse-tex-sum calcFunc-prod) ))) | 545 | ( \\prod . (math-parse-tex-sum calcFunc-prod) ))) |
| 465 | 546 | ||
| 547 | (put 'tex 'math-punc-table | ||
| 548 | '((?\{ . ?\() | ||
| 549 | (?\} . ?\)) | ||
| 550 | (?\& . ?\,))) | ||
| 551 | |||
| 466 | (put 'tex 'math-complex-format 'i) | 552 | (put 'tex 'math-complex-format 'i) |
| 467 | 553 | ||
| 554 | (put 'tex 'math-input-filter 'math-tex-input-filter) | ||
| 555 | |||
| 556 | (put 'tex 'math-matrix-formatter | ||
| 557 | (function | ||
| 558 | (lambda (a) | ||
| 559 | (if (and (integerp calc-language-option) | ||
| 560 | (or (= calc-language-option 0) | ||
| 561 | (> calc-language-option 1) | ||
| 562 | (< calc-language-option -1))) | ||
| 563 | (append '(vleft 0 "\\matrix{") | ||
| 564 | (math-compose-tex-matrix (cdr a)) | ||
| 565 | '("}")) | ||
| 566 | (append '(horiz "\\matrix{ ") | ||
| 567 | (math-compose-tex-matrix (cdr a)) | ||
| 568 | '(" }")))))) | ||
| 569 | |||
| 570 | (put 'tex 'math-var-formatter 'math-compose-tex-var) | ||
| 571 | |||
| 572 | (put 'tex 'math-func-formatter 'math-compose-tex-func) | ||
| 573 | |||
| 574 | (put 'tex 'math-dots "\\ldots") | ||
| 575 | |||
| 576 | (put 'tex 'math-big-parens '("\\left( " . " \\right)")) | ||
| 577 | |||
| 578 | (put 'tex 'math-evalto '("\\evalto " . " \\to ")) | ||
| 579 | |||
| 580 | (defconst math-tex-ignore-words | ||
| 581 | '( ("\\hbox") ("\\mbox") ("\\text") ("\\left") ("\\right") | ||
| 582 | ("\\,") ("\\>") ("\\:") ("\\;") ("\\!") ("\\ ") | ||
| 583 | ("\\quad") ("\\qquad") ("\\hfil") ("\\hfill") | ||
| 584 | ("\\displaystyle") ("\\textstyle") ("\\dsize") ("\\tsize") | ||
| 585 | ("\\scriptstyle") ("\\scriptscriptstyle") ("\\ssize") ("\\sssize") | ||
| 586 | ("\\rm") ("\\bf") ("\\it") ("\\sl") | ||
| 587 | ("\\roman") ("\\bold") ("\\italic") ("\\slanted") | ||
| 588 | ("\\cal") ("\\mit") ("\\Cal") ("\\Bbb") ("\\frak") ("\\goth") | ||
| 589 | ("\\evalto") | ||
| 590 | ("\\matrix" mat) ("\\bmatrix" mat) ("\\pmatrix" mat) | ||
| 591 | ("\\begin" begenv) | ||
| 592 | ("\\cr" punc ";") ("\\\\" punc ";") ("\\*" punc "*") | ||
| 593 | ("\\{" punc "[") ("\\}" punc "]"))) | ||
| 594 | |||
| 595 | (defconst math-latex-ignore-words | ||
| 596 | (append math-tex-ignore-words | ||
| 597 | '(("\\begin" begenv)))) | ||
| 598 | |||
| 599 | (put 'tex 'math-lang-read-symbol | ||
| 600 | '((?\\ | ||
| 601 | (< math-exp-pos (1- (length math-exp-str))) | ||
| 602 | (progn | ||
| 603 | (or (string-match "\\\\hbox *{\\([a-zA-Z0-9]+\\)}" | ||
| 604 | math-exp-str math-exp-pos) | ||
| 605 | (string-match "\\(\\\\\\([a-zA-Z]+\\|[^a-zA-Z]\\)\\)" | ||
| 606 | math-exp-str math-exp-pos)) | ||
| 607 | (setq math-exp-token 'symbol | ||
| 608 | math-exp-pos (match-end 0) | ||
| 609 | math-expr-data (math-restore-dashes | ||
| 610 | (math-match-substring math-exp-str 1))) | ||
| 611 | (let ((code (assoc math-expr-data math-latex-ignore-words))) | ||
| 612 | (cond ((null code)) | ||
| 613 | ((null (cdr code)) | ||
| 614 | (math-read-token)) | ||
| 615 | ((eq (nth 1 code) 'punc) | ||
| 616 | (setq math-exp-token 'punc | ||
| 617 | math-expr-data (nth 2 code))) | ||
| 618 | ((and (eq (nth 1 code) 'mat) | ||
| 619 | (string-match " *{" math-exp-str math-exp-pos)) | ||
| 620 | (setq math-exp-pos (match-end 0) | ||
| 621 | math-exp-token 'punc | ||
| 622 | math-expr-data "[") | ||
| 623 | (let ((right (string-match "}" math-exp-str math-exp-pos))) | ||
| 624 | (and right | ||
| 625 | (setq math-exp-str (copy-sequence math-exp-str)) | ||
| 626 | (aset math-exp-str right ?\])))))))))) | ||
| 627 | |||
| 628 | (defun math-compose-tex-matrix (a &optional ltx) | ||
| 629 | (if (cdr a) | ||
| 630 | (cons (append (math-compose-vector (cdr (car a)) " & " 0) | ||
| 631 | (if ltx '(" \\\\ ") '(" \\cr "))) | ||
| 632 | (math-compose-tex-matrix (cdr a) ltx)) | ||
| 633 | (list (math-compose-vector (cdr (car a)) " & " 0)))) | ||
| 634 | |||
| 635 | (defun math-compose-tex-sum (a fn) | ||
| 636 | (cond | ||
| 637 | ((nth 4 a) | ||
| 638 | (list 'horiz (nth 1 fn) | ||
| 639 | "_{" (math-compose-expr (nth 2 a) 0) | ||
| 640 | "=" (math-compose-expr (nth 3 a) 0) | ||
| 641 | "}^{" (math-compose-expr (nth 4 a) 0) | ||
| 642 | "}{" (math-compose-expr (nth 1 a) 0) "}")) | ||
| 643 | ((nth 3 a) | ||
| 644 | (list 'horiz (nth 1 fn) | ||
| 645 | "_{" (math-compose-expr (nth 2 a) 0) | ||
| 646 | "=" (math-compose-expr (nth 3 a) 0) | ||
| 647 | "}{" (math-compose-expr (nth 1 a) 0) "}")) | ||
| 648 | (t | ||
| 649 | (list 'horiz (nth 1 fn) | ||
| 650 | "_{" (math-compose-expr (nth 2 a) 0) | ||
| 651 | "}{" (math-compose-expr (nth 1 a) 0) "}")))) | ||
| 652 | |||
| 468 | (defun math-parse-tex-sum (f val) | 653 | (defun math-parse-tex-sum (f val) |
| 469 | (let (low high save) | 654 | (let (low high save) |
| 470 | (or (equal math-expr-data "_") (throw 'syntax "Expected `_'")) | 655 | (or (equal math-expr-data "_") (throw 'syntax "Expected `_'")) |
| @@ -485,7 +670,59 @@ | |||
| 485 | (setq str (concat (substring str 0 (1+ (match-beginning 0))) | 670 | (setq str (concat (substring str 0 (1+ (match-beginning 0))) |
| 486 | (substring str (1- (match-end 0)))))) | 671 | (substring str (1- (match-end 0)))))) |
| 487 | str) | 672 | str) |
| 488 | (put 'tex 'math-input-filter 'math-tex-input-filter) | 673 | |
| 674 | ;(defun math-tex-print-sqrt (a) | ||
| 675 | ; (list 'horiz | ||
| 676 | ; "\\sqrt{" | ||
| 677 | ; (math-compose-expr (nth 1 a) 0) | ||
| 678 | ; "}")) | ||
| 679 | |||
| 680 | (defun math-compose-tex-intv (a) | ||
| 681 | (list 'horiz | ||
| 682 | (if (memq (nth 1 a) '(0 1)) "(" "[") | ||
| 683 | (math-compose-expr (nth 2 a) 0) | ||
| 684 | " \\ldots " | ||
| 685 | (math-compose-expr (nth 3 a) 0) | ||
| 686 | (if (memq (nth 1 a) '(0 2)) ")" "]"))) | ||
| 687 | |||
| 688 | (defun math-compose-tex-var (a v prec) | ||
| 689 | (if (and calc-language-option | ||
| 690 | (not (= calc-language-option 0)) | ||
| 691 | (string-match "\\`[a-zA-Z][a-zA-Z0-9]+\\'" | ||
| 692 | (symbol-name (nth 1 a)))) | ||
| 693 | (if (eq calc-language 'latex) | ||
| 694 | (format "\\text{%s}" (symbol-name (nth 1 a))) | ||
| 695 | (format "\\hbox{%s}" (symbol-name (nth 1 a)))) | ||
| 696 | (math-compose-var a))) | ||
| 697 | |||
| 698 | (defun math-compose-tex-func (func a) | ||
| 699 | (let (left right) | ||
| 700 | (if (and calc-language-option | ||
| 701 | (not (= calc-language-option 0)) | ||
| 702 | (string-match "\\`[a-zA-Z][a-zA-Z0-9]+\\'" func)) | ||
| 703 | (if (< (prefix-numeric-value calc-language-option) 0) | ||
| 704 | (setq func (format "\\%s" func)) | ||
| 705 | (setq func (if (eq calc-language 'latex) | ||
| 706 | (format "\\text{%s}" func) | ||
| 707 | (format "\\hbox{%s}" func))))) | ||
| 708 | (cond ((or (> (length a) 2) | ||
| 709 | (not (math-tex-expr-is-flat (nth 1 a)))) | ||
| 710 | (setq left "\\left( " | ||
| 711 | right " \\right)")) | ||
| 712 | ((and (eq (aref func 0) ?\\) | ||
| 713 | (not (or | ||
| 714 | (string-match "\\hbox{" func) | ||
| 715 | (string-match "\\text{" func))) | ||
| 716 | (= (length a) 2) | ||
| 717 | (or (Math-realp (nth 1 a)) | ||
| 718 | (memq (car (nth 1 a)) '(var *)))) | ||
| 719 | (setq left "{" right "}")) | ||
| 720 | (t (setq left calc-function-open | ||
| 721 | right calc-function-close))) | ||
| 722 | (list 'horiz func | ||
| 723 | left | ||
| 724 | (math-compose-vector (cdr a) ", " 0) | ||
| 725 | right))) | ||
| 489 | 726 | ||
| 490 | (put 'latex 'math-oper-table | 727 | (put 'latex 'math-oper-table |
| 491 | (append (get 'tex 'math-oper-table) | 728 | (append (get 'tex 'math-oper-table) |
| @@ -539,15 +776,93 @@ | |||
| 539 | ( \\mu . calcFunc-moebius )))) | 776 | ( \\mu . calcFunc-moebius )))) |
| 540 | 777 | ||
| 541 | (put 'latex 'math-special-function-table | 778 | (put 'latex 'math-special-function-table |
| 542 | '((/ . (math-latex-print-frac "\\frac")) | 779 | '((/ . (math-compose-latex-frac "\\frac")) |
| 543 | (calcFunc-choose . (math-latex-print-frac "\\binom")))) | 780 | (calcFunc-choose . (math-compose-latex-frac "\\binom")) |
| 781 | (calcFunc-sum . (math-compose-tex-sum "\\sum")) | ||
| 782 | (calcFunc-prod . (math-compose-tex-sum "\\prod")) | ||
| 783 | (intv . math-compose-tex-intv))) | ||
| 544 | 784 | ||
| 545 | (put 'latex 'math-variable-table | 785 | (put 'latex 'math-variable-table |
| 546 | (get 'tex 'math-variable-table)) | 786 | (get 'tex 'math-variable-table)) |
| 547 | 787 | ||
| 548 | (put 'latex 'math-complex-format 'i) | 788 | (put 'latex 'math-punc-table |
| 789 | '((?\{ . ?\() | ||
| 790 | (?\} . ?\)) | ||
| 791 | (?\& . ?\,))) | ||
| 549 | 792 | ||
| 793 | (put 'latex 'math-complex-format 'i) | ||
| 550 | 794 | ||
| 795 | (put 'latex 'math-matrix-formatter | ||
| 796 | (function | ||
| 797 | (lambda (a) | ||
| 798 | (if (and (integerp calc-language-option) | ||
| 799 | (or (= calc-language-option 0) | ||
| 800 | (> calc-language-option 1) | ||
| 801 | (< calc-language-option -1))) | ||
| 802 | (append '(vleft 0 "\\begin{pmatrix}") | ||
| 803 | (math-compose-tex-matrix (cdr a) t) | ||
| 804 | '("\\end{pmatrix}")) | ||
| 805 | (append '(horiz "\\begin{pmatrix} ") | ||
| 806 | (math-compose-tex-matrix (cdr a) t) | ||
| 807 | '(" \\end{pmatrix}")))))) | ||
| 808 | |||
| 809 | (put 'latex 'math-var-formatter 'math-compose-tex-var) | ||
| 810 | |||
| 811 | (put 'latex 'math-func-formatter 'math-compose-tex-func) | ||
| 812 | |||
| 813 | (put 'latex 'math-dots "\\ldots") | ||
| 814 | |||
| 815 | (put 'latex 'math-big-parens '("\\left( " . " \\right)")) | ||
| 816 | |||
| 817 | (put 'latex 'math-evalto '("\\evalto " . " \\to ")) | ||
| 818 | |||
| 819 | (put 'latex 'math-lang-read-symbol | ||
| 820 | '((?\\ | ||
| 821 | (< math-exp-pos (1- (length math-exp-str))) | ||
| 822 | (progn | ||
| 823 | (or (string-match "\\\\hbox *{\\([a-zA-Z0-9]+\\)}" | ||
| 824 | math-exp-str math-exp-pos) | ||
| 825 | (string-match "\\\\text *{\\([a-zA-Z0-9]+\\)}" | ||
| 826 | math-exp-str math-exp-pos) | ||
| 827 | (string-match "\\(\\\\\\([a-zA-Z]+\\|[^a-zA-Z]\\)\\)" | ||
| 828 | math-exp-str math-exp-pos)) | ||
| 829 | (setq math-exp-token 'symbol | ||
| 830 | math-exp-pos (match-end 0) | ||
| 831 | math-expr-data (math-restore-dashes | ||
| 832 | (math-match-substring math-exp-str 1))) | ||
| 833 | (let ((code (assoc math-expr-data math-tex-ignore-words)) | ||
| 834 | envname) | ||
| 835 | (cond ((null code)) | ||
| 836 | ((null (cdr code)) | ||
| 837 | (math-read-token)) | ||
| 838 | ((eq (nth 1 code) 'punc) | ||
| 839 | (setq math-exp-token 'punc | ||
| 840 | math-expr-data (nth 2 code))) | ||
| 841 | ((and (eq (nth 1 code) 'begenv) | ||
| 842 | (string-match " *{\\([^}]*\\)}" math-exp-str math-exp-pos)) | ||
| 843 | (setq math-exp-pos (match-end 0) | ||
| 844 | envname (match-string 1 math-exp-str) | ||
| 845 | math-exp-token 'punc | ||
| 846 | math-expr-data "[") | ||
| 847 | (cond ((or (string= envname "matrix") | ||
| 848 | (string= envname "bmatrix") | ||
| 849 | (string= envname "smallmatrix") | ||
| 850 | (string= envname "pmatrix")) | ||
| 851 | (if (string-match (concat "\\\\end{" envname "}") | ||
| 852 | math-exp-str math-exp-pos) | ||
| 853 | (setq math-exp-str | ||
| 854 | (replace-match "]" t t math-exp-str)) | ||
| 855 | (error "%s" (concat "No closing \\end{" envname "}")))))) | ||
| 856 | ((and (eq (nth 1 code) 'mat) | ||
| 857 | (string-match " *{" math-exp-str math-exp-pos)) | ||
| 858 | (setq math-exp-pos (match-end 0) | ||
| 859 | math-exp-token 'punc | ||
| 860 | math-expr-data "[") | ||
| 861 | (let ((right (string-match "}" math-exp-str math-exp-pos))) | ||
| 862 | (and right | ||
| 863 | (setq math-exp-str (copy-sequence math-exp-str)) | ||
| 864 | (aset math-exp-str right ?\])))))))))) | ||
| 865 | |||
| 551 | (defun math-latex-parse-frac (f val) | 866 | (defun math-latex-parse-frac (f val) |
| 552 | (let (numer denom) | 867 | (let (numer denom) |
| 553 | (setq numer (car (math-read-expr-list))) | 868 | (setq numer (car (math-read-expr-list))) |
| @@ -565,7 +880,7 @@ | |||
| 565 | (setq second (math-read-factor)) | 880 | (setq second (math-read-factor)) |
| 566 | (list (nth 2 f) first second))) | 881 | (list (nth 2 f) first second))) |
| 567 | 882 | ||
| 568 | (defun math-latex-print-frac (a fn) | 883 | (defun math-compose-latex-frac (a fn) |
| 569 | (list 'horiz (nth 1 fn) "{" (math-compose-expr (nth 1 a) -1) | 884 | (list 'horiz (nth 1 fn) "{" (math-compose-expr (nth 1 a) -1) |
| 570 | "}{" | 885 | "}{" |
| 571 | (math-compose-expr (nth 2 a) -1) | 886 | (math-compose-expr (nth 2 a) -1) |
| @@ -645,11 +960,161 @@ | |||
| 645 | ( mu . calcFunc-moebius ) | 960 | ( mu . calcFunc-moebius ) |
| 646 | ( matrix . (math-parse-eqn-matrix) ))) | 961 | ( matrix . (math-parse-eqn-matrix) ))) |
| 647 | 962 | ||
| 963 | (put 'eqn 'math-special-function-table | ||
| 964 | '((intv . math-compose-eqn-intv))) | ||
| 965 | |||
| 966 | (put 'eqn 'math-punc-table | ||
| 967 | '((?\{ . ?\() | ||
| 968 | (?\} . ?\)))) | ||
| 969 | |||
| 648 | (put 'eqn 'math-variable-table | 970 | (put 'eqn 'math-variable-table |
| 649 | '( ( inf . var-uinf ))) | 971 | '( ( inf . var-uinf ))) |
| 650 | 972 | ||
| 651 | (put 'eqn 'math-complex-format 'i) | 973 | (put 'eqn 'math-complex-format 'i) |
| 652 | 974 | ||
| 975 | (put 'eqn 'math-big-parens '("{left ( " . " right )}")) | ||
| 976 | |||
| 977 | (put 'eqn 'math-evalto '("evalto " . " -> ")) | ||
| 978 | |||
| 979 | (put 'eqn 'math-matrix-formatter | ||
| 980 | (function | ||
| 981 | (lambda (a) | ||
| 982 | (append '(horiz "matrix { ") | ||
| 983 | (math-compose-eqn-matrix | ||
| 984 | (cdr (math-transpose a))) | ||
| 985 | '("}"))))) | ||
| 986 | |||
| 987 | (put 'eqn 'math-var-formatter | ||
| 988 | (function | ||
| 989 | (lambda (a v prec) | ||
| 990 | (if (and math-compose-hash-args | ||
| 991 | (let ((p calc-arg-values)) | ||
| 992 | (setq v 1) | ||
| 993 | (while (and p (not (equal (car p) a))) | ||
| 994 | (setq p (and (eq math-compose-hash-args t) (cdr p)) | ||
| 995 | v (1+ v))) | ||
| 996 | p)) | ||
| 997 | (if (eq math-compose-hash-args 1) | ||
| 998 | "#" | ||
| 999 | (format "#%d" v)) | ||
| 1000 | (if (string-match ".'\\'" (symbol-name (nth 2 a))) | ||
| 1001 | (math-compose-expr | ||
| 1002 | (list 'calcFunc-Prime | ||
| 1003 | (list | ||
| 1004 | 'var | ||
| 1005 | (intern (substring (symbol-name (nth 1 a)) 0 -1)) | ||
| 1006 | (intern (substring (symbol-name (nth 2 a)) 0 -1)))) | ||
| 1007 | prec) | ||
| 1008 | (symbol-name (nth 1 a))))))) | ||
| 1009 | |||
| 1010 | (defconst math-eqn-special-funcs | ||
| 1011 | '( calcFunc-log | ||
| 1012 | calcFunc-ln calcFunc-exp | ||
| 1013 | calcFunc-sin calcFunc-cos calcFunc-tan | ||
| 1014 | calcFunc-sec calcFunc-csc calcFunc-cot | ||
| 1015 | calcFunc-sinh calcFunc-cosh calcFunc-tanh | ||
| 1016 | calcFunc-sech calcFunc-csch calcFunc-coth | ||
| 1017 | calcFunc-arcsin calcFunc-arccos calcFunc-arctan | ||
| 1018 | calcFunc-arcsinh calcFunc-arccosh calcFunc-arctanh)) | ||
| 1019 | |||
| 1020 | (put 'eqn 'math-func-formatter | ||
| 1021 | (function | ||
| 1022 | (lambda (func a) | ||
| 1023 | (let (left right) | ||
| 1024 | (if (string-match "[^']'+\\'" func) | ||
| 1025 | (let ((n (- (length func) (match-beginning 0) 1))) | ||
| 1026 | (setq func (substring func 0 (- n))) | ||
| 1027 | (while (>= (setq n (1- n)) 0) | ||
| 1028 | (setq func (concat func " prime"))))) | ||
| 1029 | (cond ((or (> (length a) 2) | ||
| 1030 | (not (math-tex-expr-is-flat (nth 1 a)))) | ||
| 1031 | (setq left "{left ( " | ||
| 1032 | right " right )}")) | ||
| 1033 | |||
| 1034 | ((and | ||
| 1035 | (memq (car a) math-eqn-special-funcs) | ||
| 1036 | (= (length a) 2) | ||
| 1037 | (or (Math-realp (nth 1 a)) | ||
| 1038 | (memq (car (nth 1 a)) '(var *)))) | ||
| 1039 | (setq left "~{" right "}")) | ||
| 1040 | (t | ||
| 1041 | (setq left " ( " | ||
| 1042 | right " )"))) | ||
| 1043 | (list 'horiz func left | ||
| 1044 | (math-compose-vector (cdr a) " , " 0) | ||
| 1045 | right))))) | ||
| 1046 | |||
| 1047 | (put 'eqn 'math-lang-read-symbol | ||
| 1048 | '((?\" | ||
| 1049 | (string-match "\\(\"\\([^\"\\]\\|\\\\.\\)*\\)\\(\"\\|\\'\\)" | ||
| 1050 | math-exp-str math-exp-pos) | ||
| 1051 | (progn | ||
| 1052 | (setq math-exp-str (copy-sequence math-exp-str)) | ||
| 1053 | (aset math-exp-str (match-beginning 1) ?\{) | ||
| 1054 | (if (< (match-end 1) (length math-exp-str)) | ||
| 1055 | (aset math-exp-str (match-end 1) ?\})) | ||
| 1056 | (math-read-token))))) | ||
| 1057 | |||
| 1058 | (defconst math-eqn-ignore-words | ||
| 1059 | '( ("roman") ("bold") ("italic") ("mark") ("lineup") ("evalto") | ||
| 1060 | ("left" ("floor") ("ceil")) | ||
| 1061 | ("right" ("floor") ("ceil")) | ||
| 1062 | ("arc" ("sin") ("cos") ("tan") ("sinh") ("cosh") ("tanh")) | ||
| 1063 | ("size" n) ("font" n) ("fwd" n) ("back" n) ("up" n) ("down" n) | ||
| 1064 | ("above" punc ","))) | ||
| 1065 | |||
| 1066 | (put 'eqn 'math-lang-adjust-words | ||
| 1067 | (function | ||
| 1068 | (lambda () | ||
| 1069 | (let ((code (assoc math-expr-data math-eqn-ignore-words))) | ||
| 1070 | (cond ((null code)) | ||
| 1071 | ((null (cdr code)) | ||
| 1072 | (math-read-token)) | ||
| 1073 | ((consp (nth 1 code)) | ||
| 1074 | (math-read-token) | ||
| 1075 | (if (assoc math-expr-data (cdr code)) | ||
| 1076 | (setq math-expr-data (format "%s %s" | ||
| 1077 | (car code) math-expr-data)))) | ||
| 1078 | ((eq (nth 1 code) 'punc) | ||
| 1079 | (setq math-exp-token 'punc | ||
| 1080 | math-expr-data (nth 2 code))) | ||
| 1081 | (t | ||
| 1082 | (math-read-token) | ||
| 1083 | (math-read-token))))))) | ||
| 1084 | |||
| 1085 | (put 'eqn 'math-lang-read | ||
| 1086 | '((eq (string-match "->\\|<-\\|+-\\|\\\\dots\\|~\\|\\^" | ||
| 1087 | math-exp-str math-exp-pos) | ||
| 1088 | math-exp-pos) | ||
| 1089 | (progn | ||
| 1090 | (setq math-exp-token 'punc | ||
| 1091 | math-expr-data (math-match-substring math-exp-str 0) | ||
| 1092 | math-exp-pos (match-end 0)) | ||
| 1093 | (and (eq (string-match "\\\\dots\\." math-exp-str math-exp-pos) | ||
| 1094 | math-exp-pos) | ||
| 1095 | (setq math-exp-pos (match-end 0))) | ||
| 1096 | (if (memq (aref math-expr-data 0) '(?~ ?^)) | ||
| 1097 | (math-read-token))))) | ||
| 1098 | |||
| 1099 | |||
| 1100 | (defun math-compose-eqn-matrix (a) | ||
| 1101 | (if a | ||
| 1102 | (cons | ||
| 1103 | (cond ((eq calc-matrix-just 'right) "rcol ") | ||
| 1104 | ((eq calc-matrix-just 'center) "ccol ") | ||
| 1105 | (t "lcol ")) | ||
| 1106 | (cons | ||
| 1107 | (list 'break math-compose-level) | ||
| 1108 | (cons | ||
| 1109 | "{ " | ||
| 1110 | (cons | ||
| 1111 | (let ((math-compose-level (1+ math-compose-level))) | ||
| 1112 | (math-compose-vector (cdr (car a)) " above " 1000)) | ||
| 1113 | (cons | ||
| 1114 | " } " | ||
| 1115 | (math-compose-eqn-matrix (cdr a))))))) | ||
| 1116 | nil)) | ||
| 1117 | |||
| 653 | (defun math-parse-eqn-matrix (f sym) | 1118 | (defun math-parse-eqn-matrix (f sym) |
| 654 | (let ((vec nil)) | 1119 | (let ((vec nil)) |
| 655 | (while (assoc math-expr-data '(("ccol") ("lcol") ("rcol"))) | 1120 | (while (assoc math-expr-data '(("ccol") ("lcol") ("rcol"))) |
| @@ -685,6 +1150,14 @@ | |||
| 685 | (intern (concat (symbol-name (nth 2 x)) "'")))) | 1150 | (intern (concat (symbol-name (nth 2 x)) "'")))) |
| 686 | (list 'calcFunc-Prime x))) | 1151 | (list 'calcFunc-Prime x))) |
| 687 | 1152 | ||
| 1153 | (defun math-compose-eqn-intv (a) | ||
| 1154 | (list 'horiz | ||
| 1155 | (if (memq (nth 1 a) '(0 1)) "(" "[") | ||
| 1156 | (math-compose-expr (nth 2 a) 0) | ||
| 1157 | " ... " | ||
| 1158 | (math-compose-expr (nth 3 a) 0) | ||
| 1159 | (if (memq (nth 1 a) '(0 2)) ")" "]"))) | ||
| 1160 | |||
| 688 | 1161 | ||
| 689 | (defun calc-mathematica-language () | 1162 | (defun calc-mathematica-language () |
| 690 | (interactive) | 1163 | (interactive) |
| @@ -794,6 +1267,22 @@ | |||
| 794 | (put 'math 'math-radix-formatter | 1267 | (put 'math 'math-radix-formatter |
| 795 | (function (lambda (r s) (format "%d^^%s" r s)))) | 1268 | (function (lambda (r s) (format "%d^^%s" r s)))) |
| 796 | 1269 | ||
| 1270 | (put 'math 'math-lang-read | ||
| 1271 | '((eq (string-match "\\[\\[\\|->\\|:>" math-exp-str math-exp-pos) | ||
| 1272 | math-exp-pos) | ||
| 1273 | (setq math-exp-token 'punc | ||
| 1274 | math-expr-data (math-match-substring math-exp-str 0) | ||
| 1275 | math-exp-pos (match-end 0)))) | ||
| 1276 | |||
| 1277 | (put 'math 'math-compose-subscr | ||
| 1278 | (function | ||
| 1279 | (lambda (a) | ||
| 1280 | (list 'horiz | ||
| 1281 | (math-compose-expr (nth 1 a) 1000) | ||
| 1282 | "[[" | ||
| 1283 | (math-compose-expr (nth 2 a) 0) | ||
| 1284 | "]]")))) | ||
| 1285 | |||
| 797 | (defun math-read-math-subscr (x op) | 1286 | (defun math-read-math-subscr (x op) |
| 798 | (let ((idx (math-read-expr-level 0))) | 1287 | (let ((idx (math-read-expr-level 0))) |
| 799 | (or (and (equal math-expr-data "]") | 1288 | (or (and (equal math-expr-data "]") |
| @@ -867,6 +1356,9 @@ | |||
| 867 | ( vectdim . calcFunc-vlen ) | 1356 | ( vectdim . calcFunc-vlen ) |
| 868 | )) | 1357 | )) |
| 869 | 1358 | ||
| 1359 | (put 'maple 'math-special-function-table | ||
| 1360 | '((intv . math-compose-maple-intv))) | ||
| 1361 | |||
| 870 | (put 'maple 'math-variable-table | 1362 | (put 'maple 'math-variable-table |
| 871 | '( ( I . var-i ) | 1363 | '( ( I . var-i ) |
| 872 | ( Pi . var-pi ) | 1364 | ( Pi . var-pi ) |
| @@ -878,6 +1370,37 @@ | |||
| 878 | 1370 | ||
| 879 | (put 'maple 'math-complex-format 'I) | 1371 | (put 'maple 'math-complex-format 'I) |
| 880 | 1372 | ||
| 1373 | (put 'maple 'math-matrix-formatter | ||
| 1374 | (function | ||
| 1375 | (lambda (a) | ||
| 1376 | (list 'horiz | ||
| 1377 | "matrix(" | ||
| 1378 | math-comp-left-bracket | ||
| 1379 | (math-compose-vector (cdr a) | ||
| 1380 | (concat math-comp-comma " ") | ||
| 1381 | math-comp-vector-prec) | ||
| 1382 | math-comp-right-bracket | ||
| 1383 | ")")))) | ||
| 1384 | |||
| 1385 | (put 'maple 'math-compose-subscr | ||
| 1386 | (function | ||
| 1387 | (lambda (a) | ||
| 1388 | (let ((args (cdr (cdr a)))) | ||
| 1389 | (list 'horiz | ||
| 1390 | (math-compose-expr (nth 1 a) 1000) | ||
| 1391 | "[" | ||
| 1392 | (math-compose-vector args ", " 0) | ||
| 1393 | "]"))))) | ||
| 1394 | |||
| 1395 | (add-to-list 'calc-lang-allow-underscores 'maple) | ||
| 1396 | (add-to-list 'calc-lang-brackets-are-subscripts 'maple) | ||
| 1397 | |||
| 1398 | (defun math-compose-maple-intv (a) | ||
| 1399 | (list 'horiz | ||
| 1400 | (math-compose-expr (nth 2 a) 0) | ||
| 1401 | " .. " | ||
| 1402 | (math-compose-expr (nth 3 a) 0))) | ||
| 1403 | |||
| 881 | (defun math-read-maple-dots (x op) | 1404 | (defun math-read-maple-dots (x op) |
| 882 | (list 'intv 3 x (math-read-expr-level (nth 3 op)))) | 1405 | (list 'intv 3 x (math-read-expr-level (nth 3 op)))) |
| 883 | 1406 | ||