aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJay Belanger2007-12-02 03:17:22 +0000
committerJay Belanger2007-12-02 03:17:22 +0000
commit7cf2461032eddbd1a38b7c21c0a51dbae25fe2a9 (patch)
tree3e6d466e51251530e9255edfe791a97ddb186356
parentf479e32a8e443a53357905233a7bd5532806d04f (diff)
downloademacs-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.el535
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