diff options
Diffstat (limited to 'lisp/calc/calccomp.el')
| -rw-r--r-- | lisp/calc/calccomp.el | 304 |
1 files changed, 83 insertions, 221 deletions
diff --git a/lisp/calc/calccomp.el b/lisp/calc/calccomp.el index 90e431a61e7..d2111131f03 100644 --- a/lisp/calc/calccomp.el +++ b/lisp/calc/calccomp.el @@ -32,16 +32,6 @@ (require 'calc-ext) (require 'calc-macs) -(defconst math-eqn-special-funcs - '( calcFunc-log - calcFunc-ln calcFunc-exp - calcFunc-sin calcFunc-cos calcFunc-tan - calcFunc-sec calcFunc-csc calcFunc-cot - calcFunc-sinh calcFunc-cosh calcFunc-tanh - calcFunc-sech calcFunc-csch calcFunc-coth - calcFunc-arcsin calcFunc-arccos calcFunc-arctan - calcFunc-arcsinh calcFunc-arccosh calcFunc-arctanh)) - ;;; A "composition" has one of the following forms: ;;; ;;; "string" A literal string @@ -80,9 +70,28 @@ (defvar math-comp-right-bracket) (defvar math-comp-comma) +(defun math-compose-var (a) + (let (v sn) + (if (and math-compose-hash-args + (let ((p calc-arg-values)) + (setq v 1) + (while (and p (not (equal (car p) a))) + (setq p (and (eq math-compose-hash-args t) (cdr p)) + v (1+ v))) + p)) + (if (eq math-compose-hash-args 1) + "#" + (format "#%d" v)) + (setq sn (symbol-name (nth 1 a))) + (if (memq calc-language calc-lang-allow-percentsigns) + (setq sn (math-to-percentsigns sn))) + (if (memq calc-language calc-lang-allow-underscores) + (setq sn (math-to-underscores sn))) + sn))) (defun math-compose-expr (a prec) (let ((math-compose-level (1+ math-compose-level)) + (math-expr-opers (math-expr-ops)) spfn) (cond ((or (and (eq a math-comp-selected) a) @@ -93,17 +102,24 @@ (list 'tag a (math-compose-expr a prec)))) ((and (not (consp a)) (not (integerp a))) (concat "'" (prin1-to-string a))) - ((setq spfn (assq (car-safe a) math-expr-special-function-mapping)) + ((setq spfn (assq (car-safe a) + (get calc-language 'math-special-function-table))) (setq spfn (cdr spfn)) - (funcall (car spfn) a spfn)) + (if (consp spfn) + (funcall (car spfn) a spfn) + (funcall spfn a))) ((math-scalarp a) (if (or (eq (car-safe a) 'frac) (and (nth 1 calc-frac-format) (Math-integerp a))) - (if (memq calc-language '(tex latex eqn math maple c fortran pascal)) + (if (and + calc-language + (not (memq calc-language + '(flat big unform)))) (let ((aa (math-adjust-fraction a)) (calc-frac-format nil)) (math-compose-expr (list '/ - (if (memq calc-language '(c fortran)) + (if (memq calc-language + calc-lang-slash-idiv) (math-float (nth 1 aa)) (nth 1 aa)) (nth 2 aa)) prec)) @@ -267,59 +283,25 @@ (cdr a) (if full rows 3) t))))) (if (or calc-full-vectors (< (length a) 7)) - (if (and (eq calc-language 'tex) - (math-matrixp a)) - (if (and (integerp calc-language-option) - (or (= calc-language-option 0) - (> calc-language-option 1) - (< calc-language-option -1))) - (append '(vleft 0 "\\matrix{") - (math-compose-tex-matrix (cdr a)) - '("}")) - (append '(horiz "\\matrix{ ") - (math-compose-tex-matrix (cdr a)) - '(" }"))) - (if (and (eq calc-language 'latex) - (math-matrixp a)) - (if (and (integerp calc-language-option) - (or (= calc-language-option 0) - (> calc-language-option 1) - (< calc-language-option -1))) - (append '(vleft 0 "\\begin{pmatrix}") - (math-compose-tex-matrix (cdr a) t) - '("\\end{pmatrix}")) - (append '(horiz "\\begin{pmatrix} ") - (math-compose-tex-matrix (cdr a) t) - '(" \\end{pmatrix}"))) - (if (and (eq calc-language 'eqn) - (math-matrixp a)) - (append '(horiz "matrix { ") - (math-compose-eqn-matrix - (cdr (math-transpose a))) - '("}")) - (if (and (eq calc-language 'maple) - (math-matrixp a)) - (list 'horiz - "matrix(" - math-comp-left-bracket - (math-compose-vector (cdr a) - (concat math-comp-comma " ") - math-comp-vector-prec) - math-comp-right-bracket - ")") - (list 'horiz - math-comp-left-bracket - (math-compose-vector (cdr a) - (concat math-comp-comma " ") - math-comp-vector-prec) - math-comp-right-bracket))))) + (if (and + (setq spfn (get calc-language 'math-matrix-formatter)) + (math-matrixp a)) + (funcall spfn a) + (list 'horiz + math-comp-left-bracket + (math-compose-vector (cdr a) + (concat math-comp-comma " ") + math-comp-vector-prec) + math-comp-right-bracket)) (list 'horiz math-comp-left-bracket (math-compose-vector (list (nth 1 a) (nth 2 a) (nth 3 a)) (concat math-comp-comma " ") math-comp-vector-prec) - math-comp-comma (if (memq calc-language '(tex latex)) - " \\ldots" " ...") + math-comp-comma + (if (setq spfn (get calc-language 'math-dots)) + (concat " " spfn) + " ...") math-comp-comma " " (list 'break math-compose-level) (math-compose-expr (nth (1- (length a)) a) @@ -353,62 +335,23 @@ (let ((v (rassq (nth 2 a) math-expr-variable-mapping))) (if v (symbol-name (car v)) - (if (and (memq calc-language '(tex latex)) - calc-language-option - (not (= calc-language-option 0)) - (string-match "\\`[a-zA-Z][a-zA-Z0-9]+\\'" - (symbol-name (nth 1 a)))) - (if (eq calc-language 'latex) - (format "\\text{%s}" (symbol-name (nth 1 a))) - (format "\\hbox{%s}" (symbol-name (nth 1 a)))) - (if (and math-compose-hash-args - (let ((p calc-arg-values)) - (setq v 1) - (while (and p (not (equal (car p) a))) - (setq p (and (eq math-compose-hash-args t) (cdr p)) - v (1+ v))) - p)) - (if (eq math-compose-hash-args 1) - "#" - (format "#%d" v)) - (if (memq calc-language '(c fortran pascal maple)) - (math-to-underscores (symbol-name (nth 1 a))) - (if (and (eq calc-language 'eqn) - (string-match ".'\\'" (symbol-name (nth 2 a)))) - (math-compose-expr - (list 'calcFunc-Prime - (list - 'var - (intern (substring (symbol-name (nth 1 a)) 0 -1)) - (intern (substring (symbol-name (nth 2 a)) 0 -1)))) - prec) - (symbol-name (nth 1 a))))))))) + (if (setq spfn (get calc-language 'math-var-formatter)) + (funcall spfn a prec) + (math-compose-var a))))) ((eq (car a) 'intv) (list 'horiz - (if (eq calc-language 'maple) "" - (if (memq (nth 1 a) '(0 1)) "(" "[")) + (if (memq (nth 1 a) '(0 1)) "(" "[") (math-compose-expr (nth 2 a) 0) - (if (memq calc-language '(tex latex)) " \\ldots " - (if (eq calc-language 'eqn) " ... " " .. ")) + " .. " (math-compose-expr (nth 3 a) 0) - (if (eq calc-language 'maple) "" - (if (memq (nth 1 a) '(0 2)) ")" "]")))) + (if (memq (nth 1 a) '(0 2)) ")" "]"))) ((eq (car a) 'date) (if (eq (car calc-date-format) 'X) (math-format-date a) (concat "<" (math-format-date a) ">"))) - ((and (eq (car a) 'calcFunc-subscr) (cdr (cdr a)) - (memq calc-language '(c pascal fortran maple))) - (let ((args (cdr (cdr a)))) - (while (and (memq calc-language '(pascal fortran)) - (eq (car-safe (nth 1 a)) 'calcFunc-subscr)) - (setq args (append (cdr (cdr (nth 1 a))) args) - a (nth 1 a))) - (list 'horiz - (math-compose-expr (nth 1 a) 1000) - (if (eq calc-language 'fortran) "(" "[") - (math-compose-vector args ", " 0) - (if (eq calc-language 'fortran) ")" "]")))) + ((and (eq (car a) 'calcFunc-subscr) + (setq spfn (get calc-language 'math-compose-subscr))) + (funcall spfn a)) ((and (eq (car a) 'calcFunc-subscr) (= (length a) 3) (eq calc-language 'big)) (let* ((a1 (math-compose-expr (nth 1 a) 1000)) @@ -425,25 +368,6 @@ ", " a2)) (list 'subscr a1 a2)))) - ((and (eq (car a) 'calcFunc-subscr) (= (length a) 3) - (eq calc-language 'math)) - (list 'horiz - (math-compose-expr (nth 1 a) 1000) - "[[" - (math-compose-expr (nth 2 a) 0) - "]]")) - ((and (eq (car a) 'calcFunc-sqrt) - (memq calc-language '(tex latex))) - (list 'horiz - "\\sqrt{" - (math-compose-expr (nth 1 a) 0) - "}")) - ((and nil (eq (car a) 'calcFunc-sqrt) - (eq calc-language 'eqn)) - (list 'horiz - "sqrt {" - (math-compose-expr (nth 1 a) -1) - "}")) ((and (eq (car a) '^) (eq calc-language 'big)) (list 'supscr @@ -468,14 +392,6 @@ (list 'vcent (math-comp-height a1) a1 '(rule ?-) a2))) - ((and (memq (car a) '(calcFunc-sum calcFunc-prod)) - (memq calc-language '(tex latex)) - (= (length a) 5)) - (list 'horiz (if (eq (car a) 'calcFunc-sum) "\\sum" "\\prod") - "_{" (math-compose-expr (nth 2 a) 0) - "=" (math-compose-expr (nth 3 a) 0) - "}^{" (math-compose-expr (nth 4 a) 0) - "}{" (math-compose-expr (nth 1 a) 0) "}")) ((and (eq (car a) 'calcFunc-lambda) (> (length a) 2) (memq calc-language '(nil flat big))) @@ -524,11 +440,9 @@ (integerp (nth 2 a))) (let ((c (math-compose-expr (nth 1 a) -1))) (if (> prec (nth 2 a)) - (if (memq calc-language '(tex latex)) - (list 'horiz "\\left( " c " \\right)") - (if (eq calc-language 'eqn) - (list 'horiz "{left ( " c " right )}") - (list 'horiz "(" c ")"))) + (if (setq spfn (get calc-language 'math-big-parens)) + (list 'horiz (car spfn) c (cdr spfn)) + (list 'horiz "(" c ")")) c))) ((and (eq (car a) 'calcFunc-choriz) (not (eq calc-language 'unform)) @@ -662,13 +576,13 @@ (make-list (nth 1 a) c)))))) ((and (eq (car a) 'calcFunc-evalto) (setq calc-any-evaltos t) - (memq calc-language '(tex latex eqn)) + (setq spfn (get calc-language 'math-evalto)) (= math-compose-level (if math-comp-tagged 2 1)) (= (length a) 3)) (list 'horiz - (if (memq calc-language '(tex latex)) "\\evalto " "evalto ") + (car spfn) (math-compose-expr (nth 1 a) 0) - (if (memq calc-language '(tex latex)) " \\to " " -> ") + (cdr spfn) (math-compose-expr (nth 2 a) 0))) (t (let ((op (and (not (eq calc-language 'unform)) @@ -867,6 +781,9 @@ ( tex . math-compose-tex ) ( latex . math-compose-latex ) ( eqn . math-compose-eqn ) + ( yacas . math-compose-yacas ) + ( maxima . math-compose-maxima ) + ( giac . math-compose-giac ) ( math . math-compose-math ) ( maple . math-compose-maple )))) (setq op (get (car a) (cdr op))) @@ -894,56 +811,16 @@ (symbol-name func)) (math-match-substring (symbol-name func) 1) (symbol-name func)))) - (if (memq calc-language '(c fortran pascal maple)) + (if (memq calc-language calc-lang-allow-percentsigns) + (setq func (math-to-percentsigns func))) + (if (memq calc-language calc-lang-allow-underscores) (setq func (math-to-underscores func))) - (if (and (memq calc-language '(tex latex)) - calc-language-option - (not (= calc-language-option 0)) - (string-match "\\`[a-zA-Z][a-zA-Z0-9]+\\'" func)) - (if (< (prefix-numeric-value calc-language-option) 0) - (setq func (format "\\%s" func)) - (setq func (if (eq calc-language 'latex) - (format "\\text{%s}" func) - (format "\\hbox{%s}" func))))) - (if (and (eq calc-language 'eqn) - (string-match "[^']'+\\'" func)) - (let ((n (- (length func) (match-beginning 0) 1))) - (setq func (substring func 0 (- n))) - (while (>= (setq n (1- n)) 0) - (setq func (concat func " prime"))))) - (cond ((and (memq calc-language '(tex latex)) - (or (> (length a) 2) - (not (math-tex-expr-is-flat (nth 1 a))))) - (setq left "\\left( " - right " \\right)")) - ((and (eq calc-language 'eqn) - (or (> (length a) 2) - (not (math-tex-expr-is-flat (nth 1 a))))) - (setq left "{left ( " - right " right )}")) - ((and (or (and (memq calc-language '(tex latex)) - (eq (aref func 0) ?\\)) - (and (eq calc-language 'eqn) - (memq (car a) math-eqn-special-funcs))) - (not (or - (string-match "\\hbox{" func) - (string-match "\\text{" func))) - (= (length a) 2) - (or (Math-realp (nth 1 a)) - (memq (car (nth 1 a)) '(var *)))) - (setq left (if (eq calc-language 'eqn) "~{" "{") - right "}")) - ((eq calc-language 'eqn) - (setq left " ( " - right " )")) - (t (setq left calc-function-open - right calc-function-close))) - (list 'horiz func left - (math-compose-vector (cdr a) - (if (eq calc-language 'eqn) - " , " ", ") - 0) - right))))))))) + (if (setq spfn (get calc-language 'math-func-formatter)) + (funcall spfn func a) + + (list 'horiz func calc-function-open + (math-compose-vector (cdr a) ", " 0) + calc-function-close)))))))))) (defun math-prod-first-term (x) @@ -1002,8 +879,12 @@ (if (<= count 0) (if (< count 0) (math-compose-rows (cdr a) -1 nil) - (cons (concat (if (memq calc-language '(tex latex)) " \\ldots" " ...") - math-comp-comma) + (cons (concat + (let ((mdots (get calc-language 'math-dots))) + (if mdots + (concat " " mdots) + " ...")) + math-comp-comma) (math-compose-rows (cdr a) -1 nil))) (cons (list 'horiz (if first (concat math-comp-left-bracket " ") " ") @@ -1015,31 +896,6 @@ (math-compose-expr (car a) math-comp-vector-prec) (concat " " math-comp-right-bracket))))) -(defun math-compose-tex-matrix (a &optional ltx) - (if (cdr a) - (cons (append (math-compose-vector (cdr (car a)) " & " 0) - (if ltx '(" \\\\ ") '(" \\cr "))) - (math-compose-tex-matrix (cdr a) ltx)) - (list (math-compose-vector (cdr (car a)) " & " 0)))) - -(defun math-compose-eqn-matrix (a) - (if a - (cons - (cond ((eq calc-matrix-just 'right) "rcol ") - ((eq calc-matrix-just 'center) "ccol ") - (t "lcol ")) - (cons - (list 'break math-compose-level) - (cons - "{ " - (cons - (let ((math-compose-level (1+ math-compose-level))) - (math-compose-vector (cdr (car a)) " above " 1000)) - (cons - " } " - (math-compose-eqn-matrix (cdr a))))))) - nil)) - (defun math-vector-is-string (a) (while (and (setq a (cdr a)) (or (and (natnump (car a)) @@ -1091,6 +947,12 @@ (concat (math-match-substring x 1) "_" (math-match-substring x 2))) x)) +(defun math-to-percentsigns (x) + (if (string-match "\\`\\(.*\\)o'o\\(.*\\)\\'" x) + (math-to-underscores + (concat (math-match-substring x 1) "%" (math-match-substring x 2))) + x)) + (defun math-tex-expr-is-flat (a) (or (Math-integerp a) (memq (car a) '(float var)) |