procyberian/emacs
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

(math-compose-expr, math-compose-rows): Add LaTeX support.

Browse source 
(math-compose-expr): Add support for special functions.
This commit is contained in:
Jay Belanger 2005-01-31 06:30:37 +00:00
parent ad1c32c76f
commit ddaad6092e
1 changed files with 68 additions and 48 deletions
Download patch file Download diff file Expand all files Collapse all files

76
lisp/calc/calccomp.el
View file

@ -79,7 +79,8 @@
(defun math-compose-expr (a prec) (defun math-compose-expr (a prec)
(let ((math-compose-level (1+ math-compose-level))) (let ((math-compose-level (1+ math-compose-level))
spfn)
(cond (cond
((or (and (eq a math-comp-selected) a) ((or (and (eq a math-comp-selected) a)
(and math-comp-tagged (and math-comp-tagged
@ -89,10 +90,13 @@
(list 'tag a (math-compose-expr a prec)))) (list 'tag a (math-compose-expr a prec))))
((and (not (consp a)) (not (integerp a))) ((and (not (consp a)) (not (integerp a)))
(concat "'" (prin1-to-string a))) (concat "'" (prin1-to-string a)))
((setq spfn (assq (car-safe a) math-expr-special-function-mapping))
(setq spfn (cdr spfn))
(funcall (car spfn) a spfn))
((math-scalarp a) ((math-scalarp a)
(if (or (eq (car-safe a) 'frac) (if (or (eq (car-safe a) 'frac)
(and (nth 1 calc-frac-format) (Math-integerp a))) (and (nth 1 calc-frac-format) (Math-integerp a)))
(if (memq calc-language '(tex eqn math maple c fortran pascal)) (if (memq calc-language '(tex latex eqn math maple c fortran pascal))
(let ((aa (math-adjust-fraction a)) (let ((aa (math-adjust-fraction a))
(calc-frac-format nil)) (calc-frac-format nil))
(math-compose-expr (list '/ (math-compose-expr (list '/
@ -265,6 +269,15 @@
(append '(horiz "\\matrix{ ") (append '(horiz "\\matrix{ ")
(math-compose-tex-matrix (cdr a)) (math-compose-tex-matrix (cdr a))
'(" }")) '(" }"))
(if (and (eq calc-language 'latex)
(math-matrixp a))
(if (memq calc-language-option '(-2 0 2))
(append '(vleft 0 "\\begin{pmatrix}")
(math-compose-tex-matrix (cdr a))
'("\\end{pmatrix}"))
(append '(horiz "\\begin{pmatrix} ")
(math-compose-tex-matrix (cdr a))
'(" \\end{pmatrix}")))
(if (and (eq calc-language 'eqn) (if (and (eq calc-language 'eqn)
(math-matrixp a)) (math-matrixp a))
(append '(horiz "matrix { ") (append '(horiz "matrix { ")
@ -286,13 +299,14 @@
(math-compose-vector (cdr a) (math-compose-vector (cdr a)
(concat math-comp-comma " ") (concat math-comp-comma " ")
math-comp-vector-prec) math-comp-vector-prec)
math-comp-right-bracket)))) math-comp-right-bracket)))))
(list 'horiz (list 'horiz
math-comp-left-bracket math-comp-left-bracket
(math-compose-vector (list (nth 1 a) (nth 2 a) (nth 3 a)) (math-compose-vector (list (nth 1 a) (nth 2 a) (nth 3 a))
(concat math-comp-comma " ") (concat math-comp-comma " ")
math-comp-vector-prec) math-comp-vector-prec)
math-comp-comma (if (eq calc-language 'tex) " \\ldots" " ...") math-comp-comma (if (memq calc-language '(tex latex))
" \\ldots" " ...")
math-comp-comma " " math-comp-comma " "
(list 'break math-compose-level) (list 'break math-compose-level)
(math-compose-expr (nth (1- (length a)) a) (math-compose-expr (nth (1- (length a)) a)
@ -326,12 +340,14 @@
(let ((v (rassq (nth 2 a) math-expr-variable-mapping))) (let ((v (rassq (nth 2 a) math-expr-variable-mapping)))
(if v (if v
(symbol-name (car v)) (symbol-name (car v))
(if (and (eq calc-language 'tex) (if (and (memq calc-language '(tex latex))
calc-language-option calc-language-option
(not (= calc-language-option 0)) (not (= calc-language-option 0))
(string-match "\\`[a-zA-Z][a-zA-Z0-9]+\\'" (string-match "\\`[a-zA-Z][a-zA-Z0-9]+\\'"
(symbol-name (nth 1 a)))) (symbol-name (nth 1 a))))
(format "\\hbox{%s}" (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 (if (and math-compose-hash-args
(let ((p calc-arg-values)) (let ((p calc-arg-values))
(setq v 1) (setq v 1)
@ -359,7 +375,7 @@
(if (eq calc-language 'maple) "" (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) (math-compose-expr (nth 2 a) 0)
(if (eq calc-language 'tex) " \\ldots " (if (memq calc-language '(tex latex)) " \\ldots "
(if (eq calc-language 'eqn) " ... " " .. ")) (if (eq calc-language 'eqn) " ... " " .. "))
(math-compose-expr (nth 3 a) 0) (math-compose-expr (nth 3 a) 0)
(if (eq calc-language 'maple) "" (if (eq calc-language 'maple) ""
@ -404,7 +420,7 @@
(math-compose-expr (nth 2 a) 0) (math-compose-expr (nth 2 a) 0)
"]]")) "]]"))
((and (eq (car a) 'calcFunc-sqrt) ((and (eq (car a) 'calcFunc-sqrt)
(eq calc-language 'tex)) (memq calc-language '(tex latex)))
(list 'horiz (list 'horiz
"\\sqrt{" "\\sqrt{"
(math-compose-expr (nth 1 a) 0) (math-compose-expr (nth 1 a) 0)
@ -440,7 +456,7 @@
(math-comp-height a1) (math-comp-height a1)
a1 '(rule ?-) a2))) a1 '(rule ?-) a2)))
((and (memq (car a) '(calcFunc-sum calcFunc-prod)) ((and (memq (car a) '(calcFunc-sum calcFunc-prod))
(eq calc-language 'tex) (memq calc-language '(tex latex))
(= (length a) 5)) (= (length a) 5))
(list 'horiz (if (eq (car a) 'calcFunc-sum) "\\sum" "\\prod") (list 'horiz (if (eq (car a) 'calcFunc-sum) "\\sum" "\\prod")
"_{" (math-compose-expr (nth 2 a) 0) "_{" (math-compose-expr (nth 2 a) 0)
@ -495,7 +511,7 @@
(integerp (nth 2 a))) (integerp (nth 2 a)))
(let ((c (math-compose-expr (nth 1 a) -1))) (let ((c (math-compose-expr (nth 1 a) -1)))
(if (> prec (nth 2 a)) (if (> prec (nth 2 a))
(if (eq calc-language 'tex) (if (memq calc-language '(tex latex))
(list 'horiz "\\left( " c " \\right)") (list 'horiz "\\left( " c " \\right)")
(if (eq calc-language 'eqn) (if (eq calc-language 'eqn)
(list 'horiz "{left ( " c " right )}") (list 'horiz "{left ( " c " right )}")
@ -633,13 +649,13 @@
(make-list (nth 1 a) c)))))) (make-list (nth 1 a) c))))))
((and (eq (car a) 'calcFunc-evalto) ((and (eq (car a) 'calcFunc-evalto)
(setq calc-any-evaltos t) (setq calc-any-evaltos t)
(memq calc-language '(tex eqn)) (memq calc-language '(tex latex eqn))
(= math-compose-level (if math-comp-tagged 2 1)) (= math-compose-level (if math-comp-tagged 2 1))
(= (length a) 3)) (= (length a) 3))
(list 'horiz (list 'horiz
(if (eq calc-language 'tex) "\\evalto " "evalto ") (if (memq calc-language '(tex latex)) "\\evalto " "evalto ")
(math-compose-expr (nth 1 a) 0) (math-compose-expr (nth 1 a) 0)
(if (eq calc-language 'tex) " \\to " " -> ") (if (memq calc-language '(tex latex)) " \\to " " -> ")
(math-compose-expr (nth 2 a) 0))) (math-compose-expr (nth 2 a) 0)))
(t (t
(let ((op (and (not (eq calc-language 'unform)) (let ((op (and (not (eq calc-language 'unform))
@ -651,7 +667,7 @@
(/= (nth 3 op) -1)) (/= (nth 3 op) -1))
(cond (cond
((> prec (or (nth 4 op) (min (nth 2 op) (nth 3 op)))) ((> prec (or (nth 4 op) (min (nth 2 op) (nth 3 op))))
(if (and (eq calc-language 'tex) (if (and (memq calc-language '(tex latex))
(not (math-tex-expr-is-flat a))) (not (math-tex-expr-is-flat a)))
(if (eq (car-safe a) '/) (if (eq (car-safe a) '/)
(list 'horiz "{" (math-compose-expr a -1) "}") (list 'horiz "{" (math-compose-expr a -1) "}")
@ -668,7 +684,7 @@
(math-compose-expr a -1) (math-compose-expr a -1)
" right )}"))) " right )}")))
(list 'horiz "(" (math-compose-expr a 0) ")")))) (list 'horiz "(" (math-compose-expr a 0) ")"))))
((and (eq calc-language 'tex) ((and (memq calc-language '(tex latex))
(memq (car a) '(/ calcFunc-choose calcFunc-evalto)) (memq (car a) '(/ calcFunc-choose calcFunc-evalto))
(>= prec 0)) (>= prec 0))
(list 'horiz "{" (math-compose-expr a -1) "}")) (list 'horiz "{" (math-compose-expr a -1) "}"))
@ -694,7 +710,7 @@
(and (equal (car op) "^") (and (equal (car op) "^")
(eq (math-comp-first-char lhs) ?-) (eq (math-comp-first-char lhs) ?-)
(setq lhs (list 'horiz "(" lhs ")"))) (setq lhs (list 'horiz "(" lhs ")")))
(and (eq calc-language 'tex) (and (memq calc-language '(tex latex))
(or (equal (car op) "^") (equal (car op) "_")) (or (equal (car op) "^") (equal (car op) "_"))
(not (and (stringp rhs) (= (length rhs) 1))) (not (and (stringp rhs) (= (length rhs) 1)))
(setq rhs (list 'horiz "{" rhs "}"))) (setq rhs (list 'horiz "{" rhs "}")))
@ -761,7 +777,7 @@
((or (> prec (or (nth 4 op) (nth 2 op))) ((or (> prec (or (nth 4 op) (nth 2 op)))
(and (not (eq (assoc (car op) math-expr-opers) op)) (and (not (eq (assoc (car op) math-expr-opers) op))
(> prec 0))) ; don't write x% + y (> prec 0))) ; don't write x% + y
(if (and (eq calc-language 'tex) (if (and (memq calc-language '(tex latex))
(not (math-tex-expr-is-flat a))) (not (math-tex-expr-is-flat a)))
(list 'horiz "\\left( " (list 'horiz "\\left( "
(math-compose-expr a -1) (math-compose-expr a -1)
@ -786,7 +802,7 @@
((and op (= (length a) 2) (= (nth 2 op) -1)) ((and op (= (length a) 2) (= (nth 2 op) -1))
(cond (cond
((eq (nth 3 op) 0) ((eq (nth 3 op) 0)
(let ((lr (and (eq calc-language 'tex) (let ((lr (and (memq calc-language '(tex latex))
(not (math-tex-expr-is-flat (nth 1 a)))))) (not (math-tex-expr-is-flat (nth 1 a))))))
(list 'horiz (list 'horiz
(if lr "\\left" "") (if lr "\\left" "")
@ -799,7 +815,7 @@
(if lr "\\right" "") (if lr "\\right" "")
(car (nth 1 (memq op math-expr-opers)))))) (car (nth 1 (memq op math-expr-opers))))))
((> prec (or (nth 4 op) (nth 3 op))) ((> prec (or (nth 4 op) (nth 3 op)))
(if (and (eq calc-language 'tex) (if (and (memq calc-language '(tex latex))
(not (math-tex-expr-is-flat a))) (not (math-tex-expr-is-flat a)))
(list 'horiz "\\left( " (list 'horiz "\\left( "
(math-compose-expr a -1) (math-compose-expr a -1)
@ -836,6 +852,7 @@
( pascal . math-compose-pascal ) ( pascal . math-compose-pascal )
( fortran . math-compose-fortran ) ( fortran . math-compose-fortran )
( tex . math-compose-tex ) ( tex . math-compose-tex )
( latex . math-compose-latex )
( eqn . math-compose-eqn ) ( eqn . math-compose-eqn )
( math . math-compose-math ) ( math . math-compose-math )
( maple . math-compose-maple )))) ( maple . math-compose-maple ))))
@ -866,20 +883,22 @@
(symbol-name func)))) (symbol-name func))))
(if (memq calc-language '(c fortran pascal maple)) (if (memq calc-language '(c fortran pascal maple))
(setq func (math-to-underscores func))) (setq func (math-to-underscores func)))
(if (and (eq calc-language 'tex) (if (and (memq calc-language '(tex latex))
calc-language-option calc-language-option
(not (= calc-language-option 0)) (not (= calc-language-option 0))
(string-match "\\`[a-zA-Z][a-zA-Z0-9]+\\'" func)) (string-match "\\`[a-zA-Z][a-zA-Z0-9]+\\'" func))
(if (< (prefix-numeric-value calc-language-option) 0) (if (< (prefix-numeric-value calc-language-option) 0)
(setq func (format "\\%s" func)) (setq func (format "\\%s" func))
(setq func (format "\\hbox{%s}" func)))) (setq func (if (eq calc-language 'latex)
(format "\\text{%s}" func)
(format "\\hbox{%s}" func)))))
(if (and (eq calc-language 'eqn) (if (and (eq calc-language 'eqn)
(string-match "[^']'+\\'" func)) (string-match "[^']'+\\'" func))
(let ((n (- (length func) (match-beginning 0) 1))) (let ((n (- (length func) (match-beginning 0) 1)))
(setq func (substring func 0 (- n))) (setq func (substring func 0 (- n)))
(while (>= (setq n (1- n)) 0) (while (>= (setq n (1- n)) 0)
(setq func (concat func " prime"))))) (setq func (concat func " prime")))))
(cond ((and (eq calc-language 'tex) (cond ((and (eq calc-language '(tex latex))
(or (> (length a) 2) (or (> (length a) 2)
(not (math-tex-expr-is-flat (nth 1 a))))) (not (math-tex-expr-is-flat (nth 1 a)))))
(setq left "\\left( " (setq left "\\left( "
@ -889,11 +908,13 @@
(not (math-tex-expr-is-flat (nth 1 a))))) (not (math-tex-expr-is-flat (nth 1 a)))))
(setq left "{left ( " (setq left "{left ( "
right " right )}")) right " right )}"))
((and (or (and (eq calc-language 'tex) ((and (or (and (memq calc-language '(tex latex))
(eq (aref func 0) ?\\)) (eq (aref func 0) ?\\))
(and (eq calc-language 'eqn) (and (eq calc-language 'eqn)
(memq (car a) math-eqn-special-funcs))) (memq (car a) math-eqn-special-funcs)))
(not (string-match "\\hbox{" func)) (not (or
(string-match "\\hbox{" func)
(string-match "\\text{" func)))
(= (length a) 2) (= (length a) 2)
(or (Math-realp (nth 1 a)) (or (Math-realp (nth 1 a))
(memq (car (nth 1 a)) '(var *)))) (memq (car (nth 1 a)) '(var *))))
@ -968,7 +989,7 @@
(if (<= count 0) (if (<= count 0)
(if (< count 0) (if (< count 0)
(math-compose-rows (cdr a) -1 nil) (math-compose-rows (cdr a) -1 nil)
(cons (concat (if (eq calc-language 'tex) " \\ldots" " ...") (cons (concat (if (memq calc-language '(tex latex)) " \\ldots" " ...")
math-comp-comma) math-comp-comma)
(math-compose-rows (cdr a) -1 nil))) (math-compose-rows (cdr a) -1 nil)))
(cons (list 'horiz (cons (list 'horiz
@ -983,9 +1004,8 @@
(defun math-compose-tex-matrix (a) (defun math-compose-tex-matrix (a)
(if (cdr a) (if (cdr a)
(cons (math-compose-vector (cdr (car a)) " & " 0) (cons (append (math-compose-vector (cdr (car a)) " & " 0) '(" \\\\ "))
(cons " \\\\ " (math-compose-tex-matrix (cdr a)))
(math-compose-tex-matrix (cdr a))))
(list (math-compose-vector (cdr (car a)) " & " 0)))) (list (math-compose-vector (cdr (car a)) " & " 0))))
(defun math-compose-eqn-matrix (a) (defun math-compose-eqn-matrix (a)