;;; calccomp.el --- composition functions for Calc
;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007 Free Software Foundation, Inc.
+;; 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
(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
;;;
;;; (tag X C) Composition C corresponds to sub-expression X
-;; math-comp-just and math-comp-comma-spc are local to
-;; math-compose-expr, but are used by math-compose-matrix, which is
+;; math-comp-just and math-comp-comma-spc are local to
+;; math-compose-expr, but are used by math-compose-matrix, which is
;; called by math-compose-expr
(defvar math-comp-just)
(defvar math-comp-comma-spc)
-;; math-comp-vector-prec is local to math-compose-expr, but is used by
-;; math-compose-matrix and math-compose-rows, which are called by
+;; math-comp-vector-prec is local to math-compose-expr, but is used by
+;; math-compose-matrix and math-compose-rows, which are called by
;; math-compose-expr.
(defvar math-comp-vector-prec)
-;; math-comp-left-bracket, math-comp-right-bracket and math-comp-comma are
-;; local to math-compose-expr, but are used by math-compose-rows, which is
+;; math-comp-left-bracket, math-comp-right-bracket and math-comp-comma are
+;; local to math-compose-expr, but are used by math-compose-rows, which is
;; called by math-compose-expr.
(defvar math-comp-left-bracket)
(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))
(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))
(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 " ")
+ (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)
(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))
", "
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
(list 'horiz "(" (math-compose-expr (nth 1 a) 0) ")")
(math-compose-expr (nth 1 a) 201))
(let ((calc-language 'flat)
- (calc-number-radix 10))
+ (calc-number-radix 10)
+ (calc-twos-complement-mode nil))
(math-compose-expr (nth 2 a) 0))))
((and (eq (car a) '/)
(eq calc-language 'big))
(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)))
(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))
(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))
(and prevc nextc
(or (and (>= nextc ?a) (<= nextc ?z))
(and (>= nextc ?A) (<= nextc ?Z))
+ (and (>= nextc ?α) (<= nextc ?ω))
+ (and (>= nextc ?Α) (<= nextc ?Ω))
(and (>= nextc ?0) (<= nextc ?9))
(memq nextc '(?. ?_ ?#
?\( ?\[ ?\{))
(not (math-tex-expr-is-flat (nth 1 a))))))
(list 'horiz
(if lr "\\left" "")
- (if (string-match "\\`u\\([^a-zA-Z]\\)\\'" (car op))
+ (if (string-match "\\`u\\([^a-zA-Zα-ωΑ-Ω]\\)\\'" (car op))
(substring (car op) 1)
(car op))
(if (or lr (> (length (car op)) 2)) " " "")
(t
(let ((rhs (math-compose-expr (nth 1 a) (nth 3 op))))
(list 'horiz
- (let ((ops (if (string-match "\\`u\\([^a-zA-Z]\\)\\'"
+ (let ((ops (if (string-match "\\`u\\([^a-zA-Zα-ωΑ-Ω]\\)\\'"
(car op))
(substring (car op) 1)
(car op))))
( 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)))
(setq func (car func2)))
(setq func (math-remove-dashes
(if (string-match
- "\\`calcFunc-\\([a-zA-Z0-9']+\\)\\'"
+ "\\`calcFunc-\\([a-zA-Zα-ωΑ-Ω0-9']+\\)\\'"
(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)
math-comp-vector-prec)
(if (= col cols)
""
- (concat
+ (concat
math-comp-comma-spc " ")))))
a)))
res)))
(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 " ") " ")
(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))
(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))
(if (memq prec '(196 201)) ")" "")))))
;; The variables math-svo-c, math-svo-wid and math-svo-off are local
-;; to math-stack-value-offset in calc.el, but are used by
+;; to math-stack-value-offset in calc.el, but are used by
;; math-stack-value-offset-fancy, which is called by math-stack-value-offset..
(defvar math-svo-c)
(defvar math-svo-wid)
;;; of the formula.
;; The variables math-comp-full-width, math-comp-highlight, math-comp-word,
-;; math-comp-level, math-comp-margin and math-comp-buf are local to
-;; math-comp-to-string-flat, but are used by math-comp-to-string-flat-term,
+;; math-comp-level, math-comp-margin and math-comp-buf are local to
+;; math-comp-to-string-flat, but are used by math-comp-to-string-flat-term,
;; which is called by math-comp-to-string-flat.
-;; math-comp-highlight and math-comp-buf are also local to
-;; math-comp-simplify-term and math-comp-simplify respectively, but are used
+;; math-comp-highlight and math-comp-buf are also local to
+;; math-comp-simplify-term and math-comp-simplify respectively, but are used
;; by math-comp-add-string.
(defvar math-comp-full-width)
(defvar math-comp-highlight)
(cond ((not (consp c))
(if math-comp-highlight
(setq c (math-comp-highlight-string c)))
- (setq math-comp-word (if (= (length math-comp-word) 0) c
+ (setq math-comp-word (if (= (length math-comp-word) 0) c
(concat math-comp-word c))
math-comp-pos (+ math-comp-pos (length c))))
(defun math-comp-highlight-string (s)
(setq s (copy-sequence s))
- (let ((i (length s)))
- (while (>= (setq i (1- i)) 0)
- (or (memq (aref s i) '(32 ?\n))
- (aset s i (if calc-show-selections ?\. ?\#)))))
- s)
-
+ (if calc-highlight-selections-with-faces
+ (if (not calc-show-selections)
+ (propertize s 'face 'calc-selected-face)
+ (propertize s 'face 'calc-nonselected-face))
+ (let ((i (length s)))
+ (while (>= (setq i (1- i)) 0)
+ (or (memq (aref s i) '(32 ?\n))
+ (aset s i (if calc-show-selections ?\. ?\#)))))
+ s))
;; The variable math-comp-sel-tag is local to calc-find-selected-part
-;; in calc-sel.el, but is used by math-comp-sel-flat-term and
-;; math-comp-add-string-sel, which are called (indirectly) by
+;; in calc-sel.el, but is used by math-comp-sel-flat-term and
+;; math-comp-add-string-sel, which are called (indirectly) by
;; calc-find-selected-part.
(defvar math-comp-sel-tag)
(provide 'calccomp)
-;;; arch-tag: 7c45d10a-a286-4dab-af49-7ae8989fbf78
+;; Local variables:
+;; coding: utf-8
+;; End:
+
+;; arch-tag: 7c45d10a-a286-4dab-af49-7ae8989fbf78
;;; calccomp.el ends here
HCoop / bpt / emacs.git / blobdiff