diff options
Diffstat (limited to 'lisp/calc')
| -rw-r--r-- | lisp/calc/README | 2 | ||||
| -rw-r--r-- | lisp/calc/calc-aent.el | 224 | ||||
| -rw-r--r-- | lisp/calc/calc-ext.el | 47 | ||||
| -rw-r--r-- | lisp/calc/calc-forms.el | 6 | ||||
| -rw-r--r-- | lisp/calc/calc-help.el | 5 | ||||
| -rw-r--r-- | lisp/calc/calc-lang.el | 545 | ||||
| -rw-r--r-- | lisp/calc/calc-macs.el | 10 | ||||
| -rw-r--r-- | lisp/calc/calc-menu.el | 1214 | ||||
| -rw-r--r-- | lisp/calc/calc-misc.el | 29 | ||||
| -rw-r--r-- | lisp/calc/calc-mode.el | 4 | ||||
| -rw-r--r-- | lisp/calc/calc-nlfit.el | 16 | ||||
| -rw-r--r-- | lisp/calc/calc-prog.el | 5 | ||||
| -rw-r--r-- | lisp/calc/calc-vec.el | 4 | ||||
| -rw-r--r-- | lisp/calc/calc.el | 119 | ||||
| -rw-r--r-- | lisp/calc/calcalg3.el | 24 | ||||
| -rw-r--r-- | lisp/calc/calccomp.el | 289 |
16 files changed, 2120 insertions, 423 deletions
diff --git a/lisp/calc/README b/lisp/calc/README index dc474c43813..fbbd73b8fee 100644 --- a/lisp/calc/README +++ b/lisp/calc/README @@ -72,6 +72,8 @@ opinions. Summary of changes to "Calc" ------- -- ------- -- ---- +* Added a menu. + * Added logistic non-linear curves to curve-fitting. * Added option of plotting data points and curve when curve-fitting. diff --git a/lisp/calc/calc-aent.el b/lisp/calc/calc-aent.el index ffd07bd8f2e..697d510ac02 100644 --- a/lisp/calc/calc-aent.el +++ b/lisp/calc/calc-aent.el @@ -32,6 +32,25 @@ (require 'calc) (require 'calc-macs) +;; Declare functions which are defined elsewhere. +(declare-function calc-refresh-evaltos "calc-ext" (&optional which-var)) +(declare-function calc-execute-kbd-macro "calc-prog" (mac arg &rest prefix)) +(declare-function math-is-true "calc-ext" (expr)) +(declare-function calc-explain-why "calc-stuff" (why &optional more)) +(declare-function calc-alg-edit "calc-yank" (str)) +(declare-function math-composite-inequalities "calc-prog" (x op)) +(declare-function math-flatten-lands "calc-rewr" (expr)) +(declare-function math-multi-subst "calc-map" (expr olds news)) +(declare-function calcFunc-vmatches "calc-rewr" (expr pat)) +(declare-function math-simplify "calc-alg" (top-expr)) +(declare-function math-known-matrixp "calc-arith" (a)) +(declare-function math-parse-fortran-subscr "calc-lang" (sym args)) +(declare-function math-to-radians-2 "calc-math" (a)) +(declare-function math-read-string "calc-ext" ()) +(declare-function math-read-brackets "calc-vec" (space-sep math-rb-close)) +(declare-function math-read-angle-brackets "calc-forms" ()) + + (defvar calc-quick-calc-history nil "The history list for quick-calc.") @@ -603,6 +622,7 @@ in Calc algebraic input.") (defvar calc-user-parse-table nil) (defvar calc-last-main-parse-table nil) +(defvar calc-last-user-lang-parse-table nil) (defvar calc-last-lang-parse-table nil) (defvar calc-user-tokens nil) (defvar calc-user-token-chars nil) @@ -612,10 +632,12 @@ in Calc algebraic input.") (defun math-build-parse-table () (let ((mtab (cdr (assq nil calc-user-parse-tables))) - (ltab (cdr (assq calc-language calc-user-parse-tables)))) + (ltab (cdr (assq calc-language calc-user-parse-tables))) + (lltab (get calc-language 'math-parse-table))) (or (and (eq mtab calc-last-main-parse-table) - (eq ltab calc-last-lang-parse-table)) - (let ((p (append mtab ltab)) + (eq ltab calc-last-user-lang-parse-table) + (eq lltab calc-last-lang-parse-table)) + (let ((p (append mtab ltab lltab)) (math-toks nil)) (setq calc-user-parse-table p) (setq calc-user-token-chars nil) @@ -629,7 +651,8 @@ in Calc algebraic input.") (length y))))) "\\|") calc-last-main-parse-table mtab - calc-last-lang-parse-table ltab))))) + calc-last-user-lang-parse-table ltab + calc-last-lang-parse-table lltab))))) (defun math-find-user-tokens (p) (while p @@ -660,7 +683,8 @@ in Calc algebraic input.") (setq math-exp-old-pos math-exp-pos math-exp-token 'end math-expr-data "\000") - (let ((ch (aref math-exp-str math-exp-pos))) + (let (adfn + (ch (aref math-exp-str math-exp-pos))) (setq math-exp-old-pos math-exp-pos) (cond ((memq ch '(32 10 9)) (setq math-exp-pos (1+ math-exp-pos)) @@ -677,7 +701,7 @@ in Calc algebraic input.") math-exp-pos (match-end 0))) ((or (and (>= ch ?a) (<= ch ?z)) (and (>= ch ?A) (<= ch ?Z))) - (string-match (if (memq calc-language '(c fortran pascal maple)) + (string-match (if (memq calc-language calc-lang-allow-underscores) "[a-zA-Z0-9_#]*" "[a-zA-Z0-9'#]*") math-exp-str math-exp-pos) @@ -685,22 +709,8 @@ in Calc algebraic input.") math-exp-pos (match-end 0) math-expr-data (math-restore-dashes (math-match-substring math-exp-str 0))) - (if (eq calc-language 'eqn) - (let ((code (assoc math-expr-data math-eqn-ignore-words))) - (cond ((null code)) - ((null (cdr code)) - (math-read-token)) - ((consp (nth 1 code)) - (math-read-token) - (if (assoc math-expr-data (cdr code)) - (setq math-expr-data (format "%s %s" - (car code) math-expr-data)))) - ((eq (nth 1 code) 'punc) - (setq math-exp-token 'punc - math-expr-data (nth 2 code))) - (t - (math-read-token) - (math-read-token)))))) + (if (setq adfn (get calc-language 'math-lang-adjust-words)) + (funcall adfn))) ((or (and (>= ch ?0) (<= ch ?9)) (and (eq ch '?\.) (eq (string-match "\\.[0-9]" math-exp-str math-exp-pos) @@ -709,35 +719,31 @@ in Calc algebraic input.") (eq (string-match "_\\.?[0-9]" math-exp-str math-exp-pos) math-exp-pos) (or (eq math-exp-pos 0) - (and (memq calc-language '(nil flat big unform - tex latex eqn)) + (and (not (memq calc-language + calc-lang-allow-underscores)) (eq (string-match "[^])}\"a-zA-Z0-9'$]_" math-exp-str (1- math-exp-pos)) (1- math-exp-pos)))))) - (or (and (eq calc-language 'c) + (or (and (memq calc-language calc-lang-c-type-hex) (string-match "0[xX][0-9a-fA-F]+" math-exp-str math-exp-pos)) (string-match "_?\\([0-9]+.?0*@ *\\)?\\([0-9]+.?0*' *\\)?\\(0*\\([2-9]\\|1[0-4]\\)\\(#\\|\\^\\^\\)[0-9a-dA-D.]+[eE][-+_]?[0-9]+\\|0*\\([2-9]\\|[0-2][0-9]\\|3[0-6]\\)\\(#\\|\\^\\^\\)[0-9a-zA-Z:.]+\\|[0-9]+:[0-9:]+\\|[0-9.]+\\([eE][-+_]?[0-9]+\\)?\"?\\)?" math-exp-str math-exp-pos)) (setq math-exp-token 'number math-expr-data (math-match-substring math-exp-str 0) math-exp-pos (match-end 0))) + ((and (setq adfn + (assq ch (get calc-language 'math-lang-read-symbol))) + (eval (nth 1 adfn))) + (eval (nth 2 adfn))) ((eq ch ?\$) - (if (and (eq calc-language 'pascal) - (eq (string-match - "\\(\\$[0-9a-fA-F]+\\)\\($\\|[^0-9a-zA-Z]\\)" - math-exp-str math-exp-pos) - math-exp-pos)) - (setq math-exp-token 'number - math-expr-data (math-match-substring math-exp-str 1) - math-exp-pos (match-end 1)) - (if (eq (string-match "\\$\\([1-9][0-9]*\\)" math-exp-str math-exp-pos) - math-exp-pos) - (setq math-expr-data (- (string-to-number (math-match-substring - math-exp-str 1)))) - (string-match "\\$+" math-exp-str math-exp-pos) - (setq math-expr-data (- (match-end 0) (match-beginning 0)))) - (setq math-exp-token 'dollar - math-exp-pos (match-end 0)))) + (if (eq (string-match "\\$\\([1-9][0-9]*\\)" math-exp-str math-exp-pos) + math-exp-pos) + (setq math-expr-data (- (string-to-number (math-match-substring + math-exp-str 1)))) + (string-match "\\$+" math-exp-str math-exp-pos) + (setq math-expr-data (- (match-end 0) (match-beginning 0)))) + (setq math-exp-token 'dollar + math-exp-pos (match-end 0))) ((eq ch ?\#) (if (eq (string-match "#\\([1-9][0-9]*\\)" math-exp-str math-exp-pos) math-exp-pos) @@ -756,120 +762,18 @@ in Calc algebraic input.") ((and (eq ch ?\") (string-match "\\(\"\\([^\"\\]\\|\\\\.\\)*\\)\\(\"\\|\\'\\)" math-exp-str math-exp-pos)) - (if (eq calc-language 'eqn) - (progn - (setq math-exp-str (copy-sequence math-exp-str)) - (aset math-exp-str (match-beginning 1) ?\{) - (if (< (match-end 1) (length math-exp-str)) - (aset math-exp-str (match-end 1) ?\})) - (math-read-token)) - (setq math-exp-token 'string - math-expr-data (math-match-substring math-exp-str 1) - math-exp-pos (match-end 0)))) - ((and (= ch ?\\) (eq calc-language 'tex) - (< math-exp-pos (1- (length math-exp-str)))) - (or (string-match "\\\\hbox *{\\([a-zA-Z0-9]+\\)}" - math-exp-str math-exp-pos) - (string-match "\\(\\\\\\([a-zA-Z]+\\|[^a-zA-Z]\\)\\)" - math-exp-str math-exp-pos)) - (setq math-exp-token 'symbol - math-exp-pos (match-end 0) - math-expr-data (math-restore-dashes - (math-match-substring math-exp-str 1))) - (let ((code (assoc math-expr-data math-latex-ignore-words))) - (cond ((null code)) - ((null (cdr code)) - (math-read-token)) - ((eq (nth 1 code) 'punc) - (setq math-exp-token 'punc - math-expr-data (nth 2 code))) - ((and (eq (nth 1 code) 'mat) - (string-match " *{" math-exp-str math-exp-pos)) - (setq math-exp-pos (match-end 0) - math-exp-token 'punc - math-expr-data "[") - (let ((right (string-match "}" math-exp-str math-exp-pos))) - (and right - (setq math-exp-str (copy-sequence math-exp-str)) - (aset math-exp-str right ?\]))))))) - ((and (= ch ?\\) (eq calc-language 'latex) - (< math-exp-pos (1- (length math-exp-str)))) - (or (string-match "\\\\hbox *{\\([a-zA-Z0-9]+\\)}" - math-exp-str math-exp-pos) - (string-match "\\\\text *{\\([a-zA-Z0-9]+\\)}" - math-exp-str math-exp-pos) - (string-match "\\(\\\\\\([a-zA-Z]+\\|[^a-zA-Z]\\)\\)" - math-exp-str math-exp-pos)) - (setq math-exp-token 'symbol - math-exp-pos (match-end 0) - math-expr-data (math-restore-dashes - (math-match-substring math-exp-str 1))) - (let ((code (assoc math-expr-data math-tex-ignore-words)) - envname) - (cond ((null code)) - ((null (cdr code)) - (math-read-token)) - ((eq (nth 1 code) 'punc) - (setq math-exp-token 'punc - math-expr-data (nth 2 code))) - ((and (eq (nth 1 code) 'begenv) - (string-match " *{\\([^}]*\\)}" math-exp-str math-exp-pos)) - (setq math-exp-pos (match-end 0) - envname (match-string 1 math-exp-str) - math-exp-token 'punc - math-expr-data "[") - (cond ((or (string= envname "matrix") - (string= envname "bmatrix") - (string= envname "smallmatrix") - (string= envname "pmatrix")) - (if (string-match (concat "\\\\end{" envname "}") - math-exp-str math-exp-pos) - (setq math-exp-str - (replace-match "]" t t math-exp-str)) - (error "%s" (concat "No closing \\end{" envname "}")))))) - ((and (eq (nth 1 code) 'mat) - (string-match " *{" math-exp-str math-exp-pos)) - (setq math-exp-pos (match-end 0) - math-exp-token 'punc - math-expr-data "[") - (let ((right (string-match "}" math-exp-str math-exp-pos))) - (and right - (setq math-exp-str (copy-sequence math-exp-str)) - (aset math-exp-str right ?\]))))))) - ((and (= ch ?\.) (eq calc-language 'fortran) - (eq (string-match "\\.[a-zA-Z][a-zA-Z][a-zA-Z]?\\." - math-exp-str math-exp-pos) math-exp-pos)) - (setq math-exp-token 'punc - math-expr-data (upcase (math-match-substring math-exp-str 0)) - math-exp-pos (match-end 0))) - ((and (eq calc-language 'math) - (eq (string-match "\\[\\[\\|->\\|:>" math-exp-str math-exp-pos) - math-exp-pos)) - (setq math-exp-token 'punc - math-expr-data (math-match-substring math-exp-str 0) - math-exp-pos (match-end 0))) - ((and (eq calc-language 'eqn) - (eq (string-match "->\\|<-\\|+-\\|\\\\dots\\|~\\|\\^" - math-exp-str math-exp-pos) - math-exp-pos)) - (setq math-exp-token 'punc - math-expr-data (math-match-substring math-exp-str 0) - math-exp-pos (match-end 0)) - (and (eq (string-match "\\\\dots\\." math-exp-str math-exp-pos) - math-exp-pos) - (setq math-exp-pos (match-end 0))) - (if (memq (aref math-expr-data 0) '(?~ ?^)) - (math-read-token))) + (setq math-exp-token 'string + math-expr-data (math-match-substring math-exp-str 1) + math-exp-pos (match-end 0))) + ((and (setq adfn (get calc-language 'math-lang-read))) + (eval (nth 0 adfn)) + (eval (nth 1 adfn))) ((eq (string-match "%%.*$" math-exp-str math-exp-pos) math-exp-pos) (setq math-exp-pos (match-end 0)) (math-read-token)) (t - (if (and (eq ch ?\{) (memq calc-language '(tex latex eqn))) - (setq ch ?\()) - (if (and (eq ch ?\}) (memq calc-language '(tex latex eqn))) - (setq ch ?\))) - (if (and (eq ch ?\&) (memq calc-language '(tex latex))) - (setq ch ?\,)) + (if (setq adfn (assq ch (get calc-language 'math-punc-table))) + (setq ch (cdr adfn))) (setq math-exp-token 'punc math-expr-data (char-to-string ch) math-exp-pos (1+ math-exp-pos))))))) @@ -902,7 +806,9 @@ in Calc algebraic input.") (memq math-exp-token '(symbol number dollar hash)) (equal math-expr-data "(") (and (equal math-expr-data "[") - (not (eq calc-language 'math)) + (not (equal + (get calc-language + 'math-function-open) "[")) (not (and math-exp-keep-spaces (eq (car-safe x) 'vec))))) (or (not (setq op (assoc math-expr-data math-expr-opers))) @@ -1178,7 +1084,9 @@ in Calc algebraic input.") (eq math-exp-token 'end))) (throw 'syntax "Expected `)'")) (math-read-token) - (if (and (eq calc-language 'fortran) args + (if (and (memq calc-language + calc-lang-parens-are-subscripts) + args (require 'calc-ext) (let ((calc-matrix-mode 'scalar)) (math-known-matrixp @@ -1216,11 +1124,15 @@ in Calc algebraic input.") (substring (symbol-name (cdr v)) 4)) (cdr v)))))) - (while (and (memq calc-language '(c pascal maple)) + (while (and (memq calc-language + calc-lang-brackets-are-subscripts) (equal math-expr-data "[")) (math-read-token) - (setq val (append (list 'calcFunc-subscr val) - (math-read-expr-list))) + (let ((el (math-read-expr-list))) + (while el + (setq val (append (list 'calcFunc-subscr val) + (list (car el)))) + (setq el (cdr el)))) (if (equal math-expr-data "]") (math-read-token) (throw 'syntax "Expected ']'"))) diff --git a/lisp/calc/calc-ext.el b/lisp/calc/calc-ext.el index bb054de4951..140335a3d02 100644 --- a/lisp/calc/calc-ext.el +++ b/lisp/calc/calc-ext.el @@ -30,6 +30,51 @@ (require 'calc) (require 'calc-macs) +;; Declare functions which are defined elsewhere. +(declare-function math-clip "calc-bin" (a &optional w)) +(declare-function math-round "calc-arith" (a &optional prec)) +(declare-function math-simplify "calc-alg" (top-expr)) +(declare-function math-simplify-extended "calc-alg" (a)) +(declare-function math-simplify-units "calc-units" (a)) +(declare-function calc-set-language "calc-lang" (lang &optional option no-refresh)) +(declare-function calc-flush-caches "calc-stuff" (&optional inhibit-msg)) +(declare-function calc-save-modes "calc-mode" ()) +(declare-function calc-embedded-modes-change "calc-embed" (vars)) +(declare-function calc-embedded-var-change "calc-embed" (var &optional buf)) +(declare-function math-mul-float "calc-arith" (a b)) +(declare-function math-arctan-raw "calc-math" (x)) +(declare-function math-sqrt-raw "calc-math" (a &optional guess)) +(declare-function math-sqrt-float "calc-math" (a &optional guess)) +(declare-function math-exp-minus-1-raw "calc-math" (x)) +(declare-function math-normalize-polar "calc-cplx" (a)) +(declare-function math-normalize-hms "calc-forms" (a)) +(declare-function math-normalize-mod "calc-forms" (a)) +(declare-function math-make-sdev "calc-forms" (x sigma)) +(declare-function math-make-intv "calc-forms" (mask lo hi)) +(declare-function math-normalize-logical-op "calc-prog" (a)) +(declare-function math-possible-signs "calc-arith" (a &optional origin)) +(declare-function math-infinite-dir "calc-math" (a &optional inf)) +(declare-function math-calcFunc-to-var "calc-map" (f)) +(declare-function calc-embedded-evaluate-expr "calc-embed" (x)) +(declare-function math-known-nonzerop "calc-arith" (a)) +(declare-function math-read-expr-level "calc-aent" (exp-prec &optional exp-term)) +(declare-function math-read-big-rec "calc-lang" (math-rb-h1 math-rb-v1 math-rb-h2 math-rb-v2 &optional baseline prec short)) +(declare-function math-read-big-balance "calc-lang" (h v what &optional commas)) +(declare-function math-format-date "calc-forms" (math-fd-date)) +(declare-function math-vector-is-string "calccomp" (a)) +(declare-function math-vector-to-string "calccomp" (a &optional quoted)) +(declare-function math-format-radix-float "calc-bin" (a prec)) +(declare-function math-compose-expr "calccomp" (a prec)) +(declare-function math-abs "calc-arith" (a)) +(declare-function math-format-bignum-binary "calc-bin" (a)) +(declare-function math-format-bignum-octal "calc-bin" (a)) +(declare-function math-format-bignum-hex "calc-bin" (a)) +(declare-function math-format-bignum-radix "calc-bin" (a)) +(declare-function math-compute-max-digits "calc-bin" (w r)) +(declare-function math-map-vec "calc-vec" (f a)) +(declare-function math-make-frac "calc-frac" (num den)) + + (defvar math-simplifying nil) (defvar math-living-dangerously nil) ; true if unsafe simplifications are okay. (defvar math-integrating nil) @@ -2090,7 +2135,7 @@ calc-kill calc-kill-region calc-yank)))) ;;; True if A is a real or will evaluate to a real. [P x] [Public] (defun math-provably-realp (a) (or (Math-realp a) - (math-provably-integer a) + (math-provably-integerp a) (memq (car-safe a) '(abs arg)))) ;;; True if A is a non-real, complex number. [P x] [Public] diff --git a/lisp/calc/calc-forms.el b/lisp/calc/calc-forms.el index 3839fc93666..13048c85dce 100644 --- a/lisp/calc/calc-forms.el +++ b/lisp/calc/calc-forms.el @@ -32,6 +32,12 @@ (require 'calc-ext) (require 'calc-macs) +;; Declare functions which are defined elsewhere. +(declare-function calendar-current-time-zone "cal-dst" ()) +(declare-function calendar-absolute-from-gregorian "calendar" (date)) +(declare-function dst-in-effect "cal-dst" (date)) + + (defun calc-time () (interactive) (calc-wrapper diff --git a/lisp/calc/calc-help.el b/lisp/calc/calc-help.el index ed1c93e8694..49d1fd937ba 100644 --- a/lisp/calc/calc-help.el +++ b/lisp/calc/calc-help.el @@ -32,6 +32,11 @@ (require 'calc-ext) (require 'calc-macs) +;; Declare functions which are defined elsewhere. +(declare-function Info-goto-node "info" (nodename &optional fork)) +(declare-function Info-last "info" ()) + + (defun calc-help-prefix (arg) "This key is the prefix for Calc help functions. See calc-help-for-help." (interactive "P") diff --git a/lisp/calc/calc-lang.el b/lisp/calc/calc-lang.el index 3871a1b0f09..2ae23cd5aa9 100644 --- a/lisp/calc/calc-lang.el +++ b/lisp/calc/calc-lang.el @@ -32,12 +32,27 @@ (require 'calc-ext) (require 'calc-macs) + +;; Declare functions which are defined elsewhere. +(declare-function math-compose-vector "calccomp" (a sep prec)) +(declare-function math-compose-var "calccomp" (a)) +(declare-function math-tex-expr-is-flat "calccomp" (a)) +(declare-function math-read-factor "calc-aent" ()) +(declare-function math-read-expr-level "calc-aent" (exp-prec &optional exp-term)) + +;; Declare variables which are defined elsewhere. +(defvar calc-lang-slash-idiv) +(defvar calc-lang-allow-underscores) +(defvar math-comp-left-bracket) +(defvar math-comp-right-bracket) +(defvar math-comp-comma) +(defvar math-comp-vector-prec) + ;;; Alternate entry/display languages. (defun calc-set-language (lang &optional option no-refresh) (setq math-expr-opers (or (get lang 'math-oper-table) (math-standard-ops)) math-expr-function-mapping (get lang 'math-function-table) - math-expr-special-function-mapping (get lang 'math-special-function-table) math-expr-variable-mapping (get lang 'math-variable-table) calc-language-input-filter (get lang 'math-input-filter) calc-language-output-filter (get lang 'math-output-filter) @@ -135,6 +150,20 @@ (if (= r 8) (format "0%s" s) (format "%d#%s" r s)))))) +(put 'c 'math-compose-subscr + (function + (lambda (a) + (let ((args (cdr (cdr a)))) + (list 'horiz + (math-compose-expr (nth 1 a) 1000) + "[" + (math-compose-vector args ", " 0) + "]"))))) + +(add-to-list 'calc-lang-slash-idiv 'c) +(add-to-list 'calc-lang-allow-underscores 'c) +(add-to-list 'calc-lang-c-type-hex 'c) +(add-to-list 'calc-lang-brackets-are-subscripts 'c) (defun calc-pascal-language (n) (interactive "P") @@ -183,6 +212,32 @@ (if (= r 16) (format "$%s" s) (format "%d#%s" r s))))) +(put 'pascal 'math-lang-read-symbol + '((?\$ + (eq (string-match + "\\(\\$[0-9a-fA-F]+\\)\\($\\|[^0-9a-zA-Z]\\)" + math-exp-str math-exp-pos) + math-exp-pos) + (setq math-exp-token 'number + math-expr-data (math-match-substring math-exp-str 1) + math-exp-pos (match-end 1))))) + +(put 'pascal 'math-compose-subscr + (function + (lambda (a) + (let ((args (cdr (cdr a)))) + (while (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) + "[" + (math-compose-vector args ", " 0) + "]"))))) + +(add-to-list 'calc-lang-allow-underscores 'pascal) +(add-to-list 'calc-lang-brackets-are-subscripts 'pascal) + (defun calc-input-case-filter (str) (cond ((or (null calc-language-option) (= calc-language-option 0)) str) @@ -253,8 +308,34 @@ ( real . calcFunc-re ))) (put 'fortran 'math-input-filter 'calc-input-case-filter) + (put 'fortran 'math-output-filter 'calc-output-case-filter) +(put 'fortran 'math-lang-read-symbol + '((?\. + (eq (string-match "\\.[a-zA-Z][a-zA-Z][a-zA-Z]?\\." + math-exp-str math-exp-pos) math-exp-pos) + (setq math-exp-token 'punc + math-expr-data (upcase (math-match-substring math-exp-str 0)) + math-exp-pos (match-end 0))))) + +(put 'fortran 'math-compose-subscr + (function + (lambda (a) + (let ((args (cdr (cdr a)))) + (while (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) + "(" + (math-compose-vector args ", " 0) + ")"))))) + +(add-to-list 'calc-lang-slash-idiv 'fortran) +(add-to-list 'calc-lang-allow-underscores 'fortran) +(add-to-list 'calc-lang-parens-are-subscripts 'fortran) + ;; The next few variables are local to math-read-exprs in calc-aent.el ;; and math-read-expr in calc-ext.el, but are set in functions they call. @@ -354,10 +435,10 @@ ( "\\times" * 191 190 ) ( "*" * 191 190 ) ( "2x" * 191 190 ) - ( "/" / 185 186 ) ( "+" + 180 181 ) ( "-" - 180 181 ) ( "\\over" / 170 171 ) + ( "/" / 170 171 ) ( "\\choose" calcFunc-choose 170 171 ) ( "\\mod" % 170 171 ) ( "<" calcFunc-lt 160 161 ) @@ -408,6 +489,11 @@ ( \\phi . calcFunc-totient ) ( \\mu . calcFunc-moebius ))) +(put 'tex 'math-special-function-table + '((calcFunc-sum . (math-compose-tex-sum "\\sum")) + (calcFunc-prod . (math-compose-tex-sum "\\prod")) + (intv . math-compose-tex-intv))) + (put 'tex 'math-variable-table '( ;; The Greek letters @@ -458,8 +544,112 @@ ( \\sum . (math-parse-tex-sum calcFunc-sum) ) ( \\prod . (math-parse-tex-sum calcFunc-prod) ))) +(put 'tex 'math-punc-table + '((?\{ . ?\() + (?\} . ?\)) + (?\& . ?\,))) + (put 'tex 'math-complex-format 'i) +(put 'tex 'math-input-filter 'math-tex-input-filter) + +(put 'tex 'math-matrix-formatter + (function + (lambda (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)) + '(" }")))))) + +(put 'tex 'math-var-formatter 'math-compose-tex-var) + +(put 'tex 'math-func-formatter 'math-compose-tex-func) + +(put 'tex 'math-dots "\\ldots") + +(put 'tex 'math-big-parens '("\\left( " . " \\right)")) + +(put 'tex 'math-evalto '("\\evalto " . " \\to ")) + +(defconst math-tex-ignore-words + '( ("\\hbox") ("\\mbox") ("\\text") ("\\left") ("\\right") + ("\\,") ("\\>") ("\\:") ("\\;") ("\\!") ("\\ ") + ("\\quad") ("\\qquad") ("\\hfil") ("\\hfill") + ("\\displaystyle") ("\\textstyle") ("\\dsize") ("\\tsize") + ("\\scriptstyle") ("\\scriptscriptstyle") ("\\ssize") ("\\sssize") + ("\\rm") ("\\bf") ("\\it") ("\\sl") + ("\\roman") ("\\bold") ("\\italic") ("\\slanted") + ("\\cal") ("\\mit") ("\\Cal") ("\\Bbb") ("\\frak") ("\\goth") + ("\\evalto") + ("\\matrix" mat) ("\\bmatrix" mat) ("\\pmatrix" mat) + ("\\begin" begenv) + ("\\cr" punc ";") ("\\\\" punc ";") ("\\*" punc "*") + ("\\{" punc "[") ("\\}" punc "]"))) + +(defconst math-latex-ignore-words + (append math-tex-ignore-words + '(("\\begin" begenv)))) + +(put 'tex 'math-lang-read-symbol + '((?\\ + (< math-exp-pos (1- (length math-exp-str))) + (progn + (or (string-match "\\\\hbox *{\\([a-zA-Z0-9]+\\)}" + math-exp-str math-exp-pos) + (string-match "\\(\\\\\\([a-zA-Z]+\\|[^a-zA-Z]\\)\\)" + math-exp-str math-exp-pos)) + (setq math-exp-token 'symbol + math-exp-pos (match-end 0) + math-expr-data (math-restore-dashes + (math-match-substring math-exp-str 1))) + (let ((code (assoc math-expr-data math-latex-ignore-words))) + (cond ((null code)) + ((null (cdr code)) + (math-read-token)) + ((eq (nth 1 code) 'punc) + (setq math-exp-token 'punc + math-expr-data (nth 2 code))) + ((and (eq (nth 1 code) 'mat) + (string-match " *{" math-exp-str math-exp-pos)) + (setq math-exp-pos (match-end 0) + math-exp-token 'punc + math-expr-data "[") + (let ((right (string-match "}" math-exp-str math-exp-pos))) + (and right + (setq math-exp-str (copy-sequence math-exp-str)) + (aset math-exp-str right ?\])))))))))) + +(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-tex-sum (a fn) + (cond + ((nth 4 a) + (list 'horiz (nth 1 fn) + "_{" (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) "}")) + ((nth 3 a) + (list 'horiz (nth 1 fn) + "_{" (math-compose-expr (nth 2 a) 0) + "=" (math-compose-expr (nth 3 a) 0) + "}{" (math-compose-expr (nth 1 a) 0) "}")) + (t + (list 'horiz (nth 1 fn) + "_{" (math-compose-expr (nth 2 a) 0) + "}{" (math-compose-expr (nth 1 a) 0) "}")))) + (defun math-parse-tex-sum (f val) (let (low high save) (or (equal math-expr-data "_") (throw 'syntax "Expected `_'")) @@ -480,7 +670,59 @@ (setq str (concat (substring str 0 (1+ (match-beginning 0))) (substring str (1- (match-end 0)))))) str) -(put 'tex 'math-input-filter 'math-tex-input-filter) + +;(defun math-tex-print-sqrt (a) +; (list 'horiz +; "\\sqrt{" +; (math-compose-expr (nth 1 a) 0) +; "}")) + +(defun math-compose-tex-intv (a) + (list 'horiz + (if (memq (nth 1 a) '(0 1)) "(" "[") + (math-compose-expr (nth 2 a) 0) + " \\ldots " + (math-compose-expr (nth 3 a) 0) + (if (memq (nth 1 a) '(0 2)) ")" "]"))) + +(defun math-compose-tex-var (a prec) + (if (and 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)))) + (math-compose-var a))) + +(defun math-compose-tex-func (func a) + (let (left right) + (if (and 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))))) + (cond ((or (> (length a) 2) + (not (math-tex-expr-is-flat (nth 1 a)))) + (setq left "\\left( " + right " \\right)")) + ((and (eq (aref func 0) ?\\) + (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 "{" right "}")) + (t (setq left calc-function-open + right calc-function-close))) + (list 'horiz func + left + (math-compose-vector (cdr a) ", " 0) + right))) (put 'latex 'math-oper-table (append (get 'tex 'math-oper-table) @@ -496,7 +738,7 @@ ( "\\Vec" calcFunc-VEC -1 950 ) ( "\\dddot" calcFunc-dddot -1 950 ) ( "\\ddddot" calcFunc-ddddot -1 950 ) - ( "\div" / 170 171 ) + ( "\\div" / 170 171 ) ( "\\le" calcFunc-leq 160 161 ) ( "\\leqq" calcFunc-leq 160 161 ) ( "\\leqsland" calcFunc-leq 160 161 ) @@ -534,15 +776,93 @@ ( \\mu . calcFunc-moebius )))) (put 'latex 'math-special-function-table - '((/ . (math-latex-print-frac "\\frac")) - (calcFunc-choose . (math-latex-print-frac "\\binom")))) + '((/ . (math-compose-latex-frac "\\frac")) + (calcFunc-choose . (math-compose-latex-frac "\\binom")) + (calcFunc-sum . (math-compose-tex-sum "\\sum")) + (calcFunc-prod . (math-compose-tex-sum "\\prod")) + (intv . math-compose-tex-intv))) (put 'latex 'math-variable-table (get 'tex 'math-variable-table)) -(put 'latex 'math-complex-format 'i) +(put 'latex 'math-punc-table + '((?\{ . ?\() + (?\} . ?\)) + (?\& . ?\,))) +(put 'latex 'math-complex-format 'i) +(put 'latex 'math-matrix-formatter + (function + (lambda (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}")))))) + +(put 'latex 'math-var-formatter 'math-compose-tex-var) + +(put 'latex 'math-func-formatter 'math-compose-tex-func) + +(put 'latex 'math-dots "\\ldots") + +(put 'latex 'math-big-parens '("\\left( " . " \\right)")) + +(put 'latex 'math-evalto '("\\evalto " . " \\to ")) + +(put 'latex 'math-lang-read-symbol + '((?\\ + (< math-exp-pos (1- (length math-exp-str))) + (progn + (or (string-match "\\\\hbox *{\\([a-zA-Z0-9]+\\)}" + math-exp-str math-exp-pos) + (string-match "\\\\text *{\\([a-zA-Z0-9]+\\)}" + math-exp-str math-exp-pos) + (string-match "\\(\\\\\\([a-zA-Z]+\\|[^a-zA-Z]\\)\\)" + math-exp-str math-exp-pos)) + (setq math-exp-token 'symbol + math-exp-pos (match-end 0) + math-expr-data (math-restore-dashes + (math-match-substring math-exp-str 1))) + (let ((code (assoc math-expr-data math-tex-ignore-words)) + envname) + (cond ((null code)) + ((null (cdr code)) + (math-read-token)) + ((eq (nth 1 code) 'punc) + (setq math-exp-token 'punc + math-expr-data (nth 2 code))) + ((and (eq (nth 1 code) 'begenv) + (string-match " *{\\([^}]*\\)}" math-exp-str math-exp-pos)) + (setq math-exp-pos (match-end 0) + envname (match-string 1 math-exp-str) + math-exp-token 'punc + math-expr-data "[") + (cond ((or (string= envname "matrix") + (string= envname "bmatrix") + (string= envname "smallmatrix") + (string= envname "pmatrix")) + (if (string-match (concat "\\\\end{" envname "}") + math-exp-str math-exp-pos) + (setq math-exp-str + (replace-match "]" t t math-exp-str)) + (error "%s" (concat "No closing \\end{" envname "}")))))) + ((and (eq (nth 1 code) 'mat) + (string-match " *{" math-exp-str math-exp-pos)) + (setq math-exp-pos (match-end 0) + math-exp-token 'punc + math-expr-data "[") + (let ((right (string-match "}" math-exp-str math-exp-pos))) + (and right + (setq math-exp-str (copy-sequence math-exp-str)) + (aset math-exp-str right ?\])))))))))) + (defun math-latex-parse-frac (f val) (let (numer denom) (setq numer (car (math-read-expr-list))) @@ -560,7 +880,7 @@ (setq second (math-read-factor)) (list (nth 2 f) first second))) -(defun math-latex-print-frac (a fn) +(defun math-compose-latex-frac (a fn) (list 'horiz (nth 1 fn) "{" (math-compose-expr (nth 1 a) -1) "}{" (math-compose-expr (nth 2 a) -1) @@ -640,11 +960,162 @@ ( mu . calcFunc-moebius ) ( matrix . (math-parse-eqn-matrix) ))) +(put 'eqn 'math-special-function-table + '((intv . math-compose-eqn-intv))) + +(put 'eqn 'math-punc-table + '((?\{ . ?\() + (?\} . ?\)))) + (put 'eqn 'math-variable-table '( ( inf . var-uinf ))) (put 'eqn 'math-complex-format 'i) +(put 'eqn 'math-big-parens '("{left ( " . " right )}")) + +(put 'eqn 'math-evalto '("evalto " . " -> ")) + +(put 'eqn 'math-matrix-formatter + (function + (lambda (a) + (append '(horiz "matrix { ") + (math-compose-eqn-matrix + (cdr (math-transpose a))) + '("}"))))) + +(put 'eqn 'math-var-formatter + (function + (lambda (a prec) + (let (v) + (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 (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)))))))) + +(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)) + +(put 'eqn 'math-func-formatter + (function + (lambda (func a) + (let (left right) + (if (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 ((or (> (length a) 2) + (not (math-tex-expr-is-flat (nth 1 a)))) + (setq left "{left ( " + right " right )}")) + + ((and + (memq (car a) math-eqn-special-funcs) + (= (length a) 2) + (or (Math-realp (nth 1 a)) + (memq (car (nth 1 a)) '(var *)))) + (setq left "~{" right "}")) + (t + (setq left " ( " + right " )"))) + (list 'horiz func left + (math-compose-vector (cdr a) " , " 0) + right))))) + +(put 'eqn 'math-lang-read-symbol + '((?\" + (string-match "\\(\"\\([^\"\\]\\|\\\\.\\)*\\)\\(\"\\|\\'\\)" + math-exp-str math-exp-pos) + (progn + (setq math-exp-str (copy-sequence math-exp-str)) + (aset math-exp-str (match-beginning 1) ?\{) + (if (< (match-end 1) (length math-exp-str)) + (aset math-exp-str (match-end 1) ?\})) + (math-read-token))))) + +(defconst math-eqn-ignore-words + '( ("roman") ("bold") ("italic") ("mark") ("lineup") ("evalto") + ("left" ("floor") ("ceil")) + ("right" ("floor") ("ceil")) + ("arc" ("sin") ("cos") ("tan") ("sinh") ("cosh") ("tanh")) + ("size" n) ("font" n) ("fwd" n) ("back" n) ("up" n) ("down" n) + ("above" punc ","))) + +(put 'eqn 'math-lang-adjust-words + (function + (lambda () + (let ((code (assoc math-expr-data math-eqn-ignore-words))) + (cond ((null code)) + ((null (cdr code)) + (math-read-token)) + ((consp (nth 1 code)) + (math-read-token) + (if (assoc math-expr-data (cdr code)) + (setq math-expr-data (format "%s %s" + (car code) math-expr-data)))) + ((eq (nth 1 code) 'punc) + (setq math-exp-token 'punc + math-expr-data (nth 2 code))) + (t + (math-read-token) + (math-read-token))))))) + +(put 'eqn 'math-lang-read + '((eq (string-match "->\\|<-\\|+-\\|\\\\dots\\|~\\|\\^" + math-exp-str math-exp-pos) + math-exp-pos) + (progn + (setq math-exp-token 'punc + math-expr-data (math-match-substring math-exp-str 0) + math-exp-pos (match-end 0)) + (and (eq (string-match "\\\\dots\\." math-exp-str math-exp-pos) + math-exp-pos) + (setq math-exp-pos (match-end 0))) + (if (memq (aref math-expr-data 0) '(?~ ?^)) + (math-read-token))))) + + +(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-parse-eqn-matrix (f sym) (let ((vec nil)) (while (assoc math-expr-data '(("ccol") ("lcol") ("rcol"))) @@ -680,6 +1151,14 @@ (intern (concat (symbol-name (nth 2 x)) "'")))) (list 'calcFunc-Prime x))) +(defun math-compose-eqn-intv (a) + (list 'horiz + (if (memq (nth 1 a) '(0 1)) "(" "[") + (math-compose-expr (nth 2 a) 0) + " ... " + (math-compose-expr (nth 3 a) 0) + (if (memq (nth 1 a) '(0 2)) ")" "]"))) + (defun calc-mathematica-language () (interactive) @@ -789,6 +1268,22 @@ (put 'math 'math-radix-formatter (function (lambda (r s) (format "%d^^%s" r s)))) +(put 'math 'math-lang-read + '((eq (string-match "\\[\\[\\|->\\|:>" math-exp-str math-exp-pos) + math-exp-pos) + (setq math-exp-token 'punc + math-expr-data (math-match-substring math-exp-str 0) + math-exp-pos (match-end 0)))) + +(put 'math 'math-compose-subscr + (function + (lambda (a) + (list 'horiz + (math-compose-expr (nth 1 a) 1000) + "[[" + (math-compose-expr (nth 2 a) 0) + "]]")))) + (defun math-read-math-subscr (x op) (let ((idx (math-read-expr-level 0))) (or (and (equal math-expr-data "]") @@ -862,6 +1357,9 @@ ( vectdim . calcFunc-vlen ) )) +(put 'maple 'math-special-function-table + '((intv . math-compose-maple-intv))) + (put 'maple 'math-variable-table '( ( I . var-i ) ( Pi . var-pi ) @@ -873,6 +1371,37 @@ (put 'maple 'math-complex-format 'I) +(put 'maple 'math-matrix-formatter + (function + (lambda (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 + ")")))) + +(put 'maple 'math-compose-subscr + (function + (lambda (a) + (let ((args (cdr (cdr a)))) + (list 'horiz + (math-compose-expr (nth 1 a) 1000) + "[" + (math-compose-vector args ", " 0) + "]"))))) + +(add-to-list 'calc-lang-allow-underscores 'maple) +(add-to-list 'calc-lang-brackets-are-subscripts 'maple) + +(defun math-compose-maple-intv (a) + (list 'horiz + (math-compose-expr (nth 2 a) 0) + " .. " + (math-compose-expr (nth 3 a) 0))) + (defun math-read-maple-dots (x op) (list 'intv 3 x (math-read-expr-level (nth 3 op)))) diff --git a/lisp/calc/calc-macs.el b/lisp/calc/calc-macs.el index 27001b43f36..8e939cdde7b 100644 --- a/lisp/calc/calc-macs.el +++ b/lisp/calc/calc-macs.el @@ -27,6 +27,16 @@ ;;; Code: +;; Declare functions which are defined elsewhere. +(declare-function math-zerop "calc-misc" (a)) +(declare-function math-negp "calc-misc" (a)) +(declare-function math-looks-negp "calc-misc" (a)) +(declare-function math-posp "calc-misc" (a)) +(declare-function math-compare "calc-ext" (a b)) +(declare-function math-bignum "calc" (a)) +(declare-function math-compare-bignum "calc-ext" (a b)) + + (defmacro calc-wrapper (&rest body) `(calc-do (function (lambda () ,@body)))) diff --git a/lisp/calc/calc-menu.el b/lisp/calc/calc-menu.el new file mode 100644 index 00000000000..22c42adc124 --- /dev/null +++ b/lisp/calc/calc-menu.el @@ -0,0 +1,1214 @@ +;;; calc-menu.el --- a menu for Calc + +;; Copyright (C) 2007 Free Software Foundation, Inc. + +;; 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 +;; 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. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; 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. + +;;; Commentary: + +(defvar calc-arithmetic-menu + (list "Arithmetic" + (list "Basic" + ["-(1:)" calc-change-sign :keys "n"] + ["(2:) + (1:)" calc-plus :keys "+"] + ["(2:) - (1:)" calc-minus :keys "-"] + ["(2:) * (1:)" calc-times :keys "*"] + ["(2:) / (1:)" calc-divide :keys "/"] + ["(2:) ^ (1:)" calc-power :keys "^"] + ["(2:) ^ (1/(1:))" + (progn + (require 'calc-ext) + (let ((calc-inverse-flag t)) + (call-interactively 'calc-power))) + :keys "I ^" + :help "The (1:)th root of (2:)"] + ["abs(1:)" + (progn + (require 'calc-arith) + (call-interactively 'calc-abs)) + :keys "A" + :help "Absolute value"] + ["1/(1:)" + (progn + (require 'calc-arith) + (call-interactively 'calc-inv)) + :keys "&"] + ["sqrt(1:)" + (progn + (require 'calc-math) + (call-interactively 'calc-sqrt)) + :keys "Q"] + ["idiv(2:,1:)" + (progn + (require 'calc-arith) + (call-interactively 'calc-idiv)) + :keys "\\" + :help "The integer quotient of (2:) over (1:)"] + ["(2:) mod (1:)" + (progn + (require 'calc-misc) + (call-interactively 'calc-mod)) + :keys "%" + :help "The remainder when (2:) is divided by (1:)"]) + (list "Rounding" + ["floor(1:)" + (progn + (require 'calc-arith) + (call-interactively 'calc-floor)) + :keys "F" + :help "The greatest integer less than or equal to (1:)"] + ["ceiling(1:)" + (progn + (require 'calc-arith) + (call-interactively 'calc-ceiling)) + :keys "I F" + :help "The smallest integer greater than or equal to (1:)"] + ["round(1:)" + (progn + (require 'calc-arith) + (call-interactively 'calc-round)) + :keys "R" + :help "The nearest integer to (1:)"] + ["truncate(1:)" + (progn + (require 'calc-arith) + (call-interactively 'calc-trunc)) + :keys "I R" + :help "The integer part of (1:)"]) + (list "Complex Numbers" + ["Re(1:)" + (progn + (require 'calc-cplx) + (call-interactively 'calc-re)) + :keys "f r"] + ["Im(1:)" + (progn + (require 'calc-cplx) + (call-interactively 'calc-im)) + :keys "f i"] + ["conj(1:)" + (progn + (require 'calc-cplx) + (call-interactively 'calc-conj)) + :keys "J" + :help "The complex conjugate of (1:)"] + ["length(1:)" + (progn (require 'calc-arith) + (call-interactively 'calc-abs)) + :keys "A" + :help "The length (absolute value) of (1:)"] + ["arg(1:)" + (progn + (require 'calc-cplx) + (call-interactively 'calc-argument)) + :keys "G" + :help "The argument (polar angle) of (1:)"]) + (list "Conversion" + ["Convert (1:) to a float" + (progn + (require 'calc-ext) + (call-interactively 'calc-float)) + :keys "c f"] + ["Convert (1:) to a fraction" + (progn + (require 'calc-ext) + (call-interactively 'calc-fraction)) + :keys "c F"]) + (list "Binary" + ["Set word size" + (progn + (require 'calc-bin) + (call-interactively 'calc-word-size)) + :keys "b w"] + ["Clip (1:) to word size" + (progn + (require 'calc-bin) + (call-interactively 'calc-clip)) + :keys "b c" + :help "Reduce (1:) modulo 2^wordsize"] + ["(2:) and (1:)" + (progn + (require 'calc-bin) + (call-interactively 'calc-and)) + :keys "b a" + :help "Bitwise AND [modulo 2^wordsize]"] + ["(2:) or (1:)" + (progn + (require 'calc-bin) + (call-interactively 'calc-or)) + :keys "b o" + :help "Bitwise inclusive OR [modulo 2^wordsize]"] + ["(2:) xor (1:)" + (progn + (require 'calc-bin) + (call-interactively 'calc-xor)) + :keys "b x" + :help "Bitwise exclusive OR [modulo 2^wordsize]"] + ["diff(2:,1:)" + (progn + (require 'calc-bin) + (call-interactively 'calc-diff)) + :keys "b d" + :help "Bitwise difference [modulo 2^wordsize]"] + ["not (1:)" + (progn + (require 'calc-bin) + (call-interactively 'calc-not)) + :keys "b n" + :help "Bitwise NOT [modulo 2^wordsize]"] + ["left shift(1:)" + (progn + (require 'calc-bin) + (call-interactively 'calc-lshift-binary)) + :keys "b l" + :help "Shift (1:)[modulo 2^wordsize] one bit left"] + ["right shift(1:)" + (progn + (require 'calc-bin) + (call-interactively 'calc-rshift-binary)) + :keys "b r" + :help "Shift (1:)[modulo 2^wordsize] one bit right, putting 0s on the left"] + ["arithmetic right shift(1:)" + (progn + (require 'calc-bin) + (call-interactively 'calc-rshift-arith)) + :keys "b R" + :help "Shift (1:)[modulo 2^wordsize] one bit right, duplicating the leftmost bit"] + ["rotate(1:)" + (progn + (require 'calc-bin) + (call-interactively 'calc-rotate-binary)) + :keys "b t" + :help "Rotate (1:)[modulo 2^wordsize] one bit left"]) + "-------" + ["Help on Arithmetic" + (calc-info-goto-node "Arithmetic")]) + "Menu for Calc's arithmetic functions.") + +(defvar calc-scientific-function-menu + (list "Scientific Functions" + (list "Constants" + ["pi" + (progn + (require 'calc-math) + (call-interactively 'calc-pi)) + :keys "P"] + ["e" + (progn + (require 'calc-math) + (let ((calc-hyperbolic-flag t)) + (call-interactively 'calc-pi))) + :keys "H P"] + ["phi" + (progn + (require 'calc-math) + (let ((calc-inverse-flag t) + (calc-hyperbolic-flag t)) + (call-interactively 'calc-pi))) + :keys "I H P" + :help "The golden ratio"] + ["gamma" + (progn + (require 'calc-math) + (let ((calc-inverse-flag t)) + (call-interactively 'calc-pi))) + :keys "I P" + :help "Euler's constant"]) + (list "Logs and Exps" + ["ln(1:)" + (progn + (require 'calc-math) + (call-interactively 'calc-ln)) + :keys "L" + :help "The natural logarithm"] + ["e^(1:)" + (progn + (require 'calc-math) + (call-interactively 'calc-exp)) + :keys "E"] + ["log(1:) [base 10]" + (progn + (require 'calc-math) + (call-interactively 'calc-log10)) + :keys "H L" + :help "The common logarithm"] + ["10^(1:)" + (progn + (require 'calc-math) + (let ((calc-inverse-flag t)) + (call-interactively 'calc-log10))) + :keys "I H L"] + ["log(2:) [base(1:)]" + (progn + (require 'calc-math) + (call-interactively 'calc-log)) + :keys "B" + :help "The logarithm with an arbitrary base"] + ["(2:) ^ (1:)" + calc-power + :keys "^"]) + (list "Trigonometric Functions" + ["sin(1:)" + (progn + (require 'calc-math) + (call-interactively 'calc-sin)) + :keys "S"] + ["cos(1:)" + (progn + (require 'calc-math) + (call-interactively 'calc-cos)) + :keys "C"] + ["tan(1:)" + (progn + (require 'calc-math) + (call-interactively 'calc-tan)) + :keys "T"] + ["arcsin(1:)" + (progn + (require 'calc-math) + (call-interactively 'calc-arcsin)) + :keys "I S"] + ["arccos(1:)" + (progn + (require 'calc-math) + (call-interactively 'calc-arccos)) + :keys "I C"] + ["arctan(1:)" + (progn + (require 'calc-math) + (call-interactively 'calc-arctan)) + :keys "I T"] + ["arctan2(2:,1:)" + (progn + (require 'calc-math) + (call-interactively 'calc-arctan2)) + :keys "f T"] + "--Angle Measure--" + ["Radians" + (progn + (require 'calc-math) + (calc-radians-mode)) + :keys "m r" + :style radio + :selected (eq calc-angle-mode 'rad)] + ["Degrees" + (progn + (require 'calc-math) + (calc-degrees-mode)) + :keys "m d" + :style radio + :selected (eq calc-angle-mode 'deg)] + ["HMS" + (progn + (require 'calc-math) + (calc-hms-mode)) + :keys "m h" + :style radio + :selected (eq calc-angle-mode 'hms)]) + (list "Hyperbolic Functions" + ["sinh(1:)" + (progn + (require 'calc-math) + (call-interactively 'calc-sinh)) + :keys "H S"] + ["cosh(1:)" + (progn + (require 'calc-math) + (call-interactively 'calc-cosh)) + :keys "H C"] + ["tanh(1:)" + (progn + (require 'calc-math) + (call-interactively 'calc-tanh)) + :keys "H T"] + ["arcsinh(1:)" + (progn + (require 'calc-math) + (call-interactively 'calc-arcsinh)) + :keys "I H S"] + ["arccosh(1:)" + (progn + (require 'calc-math) + (call-interactively 'calc-arccosh)) + :keys "I H C"] + ["arctanh(1:)" + (progn + (require 'calc-math) + (call-interactively 'calc-arctanh)) + :keys "I H T"]) + (list "Advanced Math Functions" + ["Gamma(1:)" + (progn + (require 'calc-comb) + (call-interactively 'calc-gamma)) + :keys "f g" + :help "The Euler Gamma function"] + ["GammaP(2:,1:)" + (progn + (require 'calc-funcs) + (call-interactively 'calc-inc-gamma)) + :keys "f G" + :help "The lower incomplete Gamma function"] + ["Beta(2:,1:)" + (progn + (require 'calc-funcs) + (call-interactively 'calc-beta)) + :keys "f b" + :help "The Euler Beta function"] + ["BetaI(3:,2:,1:)" + (progn + (require 'calc-funcs) + (call-interactively 'calc-inc-beta)) + :keys "f B" + :help "The incomplete Beta function"] + ["erf(1:)" + (progn + (require 'calc-funcs) + (call-interactively 'calc-erf)) + :keys "f e" + :help "The error function"] + ["BesselJ(2:,1:)" + (progn + (require 'calc-funcs) + (call-interactively 'calc-bessel-J)) + :keys "f j" + :help "The Bessel function of the first kind (of order (2:))"] + ["BesselY(2:,1:)" + (progn + (require 'calc-funcs) + (call-interactively 'calc-bessel-Y)) + :keys "f y" + :help "The Bessel function of the second kind (of order (2:))"]) + (list "Combinatorial Functions" + ["gcd(2:,1:)" + (progn + (require 'calc-comb) + (call-interactively 'calc-gcd)) + :keys "k g"] + ["lcm(2:,1:)" + (progn + (require 'calc-comb) + (call-interactively 'calc-lcm)) + :keys "k l"] + ["factorial(1:)" + (progn + (require 'calc-comb) + (call-interactively 'calc-factorial)) + :keys "!"] + ["(2:) choose (1:)" + (progn + (require 'calc-comb) + (call-interactively 'calc-choose)) + :keys "k c"] + ["permutations(2:,1:)" + (progn + (require 'calc-comb) + (call-interactively 'calc-perm)) + :keys "H k c"] + ["Primality test for (1:)" + (progn + (require 'calc-comb) + (call-interactively 'calc-prime-test)) + :keys "k p" + :help "For large (1:), a probabilistic test"] + ["Factor (1:) into primes" + (progn + (require 'calc-comb) + (call-interactively 'calc-prime-factors)) + :keys "k f"] + ["Next prime after (1:)" + (progn + (require 'calc-comb) + (call-interactively 'calc-next-prime)) + :keys "k n"] + ["Previous prime before (1:)" + (progn + (require 'calc-comb) + (call-interactively 'calc-prev-prime)) + :keys "I k n"] + ["phi(1:)" + (progn + (require 'calc-comb) + (call-interactively 'calc-totient)) + :keys "k n" + :help "Euler's totient function"] + ["random(1:)" + (progn + (require 'calc-comb) + (call-interactively 'calc-random)) + :keys "k r" + :help "A random number >=1 and < (1:)"]) + "----" + ["Help on Scientific Functions" + (calc-info-goto-node "Scientific Functions")]) + "Menu for Calc's scientific functions.") + +(defvar calc-algebra-menu + (list "Algebra" + (list "Simplification" + ["Simplify (1:)" + (progn + (require 'calc-alg) + (call-interactively 'calc-simplify)) + :keys "a s"] + ["Simplify (1:) with extended rules" + (progn + (require 'calc-alg) + (call-interactively 'calc-simplify-extended)) + :keys "a e" + :help "Apply possibly unsafe simplifications"]) + (list "Manipulation" + ["Expand formula (1:)" + (progn + (require 'calc-alg) + (call-interactively 'calc-expand-formula)) + :keys "a \"" + :help "Expand (1:) into its defining formula, if possible"] + ["Evaluate variables in (1:)" + (progn + (require 'calc-ext) + (call-interactively 'calc-evaluate)) + :keys "="] + ["Make substitution in (1:)" + (progn + (require 'calc-alg) + (call-interactively 'calc-substitute)) + :keys "a b" + :help + "Substitute all occurrences of a sub-expression with a new sub-expression"]) + (list "Polynomials" + ["Factor (1:)" + (progn + (require 'calc-alg) + (call-interactively 'calc-factor)) + :keys "a f"] + ["Collect terms in (1:)" + (progn + (require 'calc-alg) + (call-interactively 'calc-collect)) + :keys "a c" + :help "Arrange as a polynomial in a given variable"] + ["Expand (1:)" + (progn + (require 'calc-alg) + (call-interactively 'calc-expand)) + :keys "a x" + :help "Apply distributive law everywhere"] + ["Find roots of (1:)" + (progn + (require 'calcalg2) + (call-interactively 'calc-poly-roots)) + :keys "a P"]) + (list "Calculus" + ["Differentiate (1:)" + (progn + (require 'calcalg2) + (call-interactively 'calc-derivative)) + :keys "a d"] + ["Integrate (1:) [indefinite]" + (progn + (require 'calcalg2) + (call-interactively 'calc-integral)) + :keys "a i"] + ["Integrate (1:) [definite]" + (progn + (require 'calcalg2) + (let ((var (read-string "Integration variable: "))) + (calc-tabular-command 'calcFunc-integ "Integration" + "intg" nil var nil nil))) + :keys "C-u a i"] + ["Integrate (1:) [numeric]" + (progn + (require 'calcalg2) + (call-interactively 'calc-num-integral)) + :keys "a I" + :help "Integrate using the open Romberg method"] + ["Taylor expand (1:)" + (progn + (require 'calcalg2) + (call-interactively 'calc-taylor)) + :keys "a t"] + ["Minimize (2:) [initial guess = (1:)]" + (progn + (require 'calcalg3) + (call-interactively 'calc-find-minimum)) + :keys "a N" + :help "Find a local minimum"] + ["Maximize (2:) [initial guess = (1:)]" + (progn + (require 'calcalg3) + (call-interactively 'calc-find-maximum)) + :keys "a X" + :help "Find a local maximum"]) + (list "Solving" + ["Solve equation (1:)" + (progn + (require 'calcalg2) + (call-interactively 'calc-solve-for)) + :keys "a S"] + ["Solve equation (2:) numerically [initial guess = (1:)]" + (progn + (require 'calcalg3) + (call-interactively 'calc-find-root)) + :keys "a R"] + ["Find roots of polynomial (1:)" + (progn + (require 'calcalg2) + (call-interactively 'calc-poly-roots)) + :keys "a P"]) + (list "Curve Fitting" + ["Fit (1:)=[x values, y values] to a curve" + (progn + (require 'calcalg3) + (call-interactively 'calc-curve-fit)) + :keys "a F"]) + "----" + ["Help on Algebra" + (calc-info-goto-node "Algebra")]) + "Menu for Calc's algebraic facilities.") + + +(defvar calc-graphics-menu + (list "Graphics" + ["Graph 2D [(1:)= y values, (2:)= x values]" + (progn + (require 'calc-graph) + (call-interactively 'calc-graph-fast)) + :keys "g f"] + ["Graph 3D [(1:)= z values, (2:)= y values, (3:)= x values]" + (progn + (require 'calc-graph) + (call-interactively 'calc-graph-fast-3d)) + :keys "g F"] + "----" + ["Help on Graphics" + (calc-info-goto-node "Graphics")]) + "Menu for Calc's graphics.") + + +(defvar calc-vectors-menu + (list "Matrices/Vectors" + (list "Matrices" + ["(2:) + (1:)" calc-plus :keys "+"] + ["(2:) - (1:)" calc-minus :keys "-"] + ["(2:) * (1:)" calc-times :keys "*"] + ["(1:)^(-1)" + (progn + (require 'calc-arith) + (call-interactively 'calc-inv)) + :keys "&"] + ["Create an identity matrix" + (progn + (require 'calc-vec) + (call-interactively 'calc-ident)) + :keys "v i"] + ["transpose(1:)" + (progn + (require 'calc-vec) + (call-interactively 'calc-transpose)) + :keys "v t"] + ["det(1:)" + (progn + (require 'calc-mtx) + (call-interactively 'calc-mdet)) + :keys "V D"] + ["trace(1:)" + (progn + (require 'calc-mtx) + (call-interactively 'calc-mtrace)) + :keys "V T"] + ["LUD decompose (1:)" + (progn + (require 'calc-mtx) + (call-interactively 'calc-mlud)) + :keys "V L"] + ["Extract a row from (1:)" + (progn + (require 'calc-vec) + (call-interactively 'calc-mrow)) + :keys "v r"] + ["Extract a column from (1:)" + (progn + (require 'calc-vec) + (call-interactively 'calc-mcol)) + :keys "v c"]) + (list "Vectors" + ["Extract the first element of (1:)" + (progn + (require 'calc-vec) + (call-interactively 'calc-head)) + :keys "v h"] + ["Extract an element from (1:)" + (progn + (require 'calc-vec) + (call-interactively 'calc-mrow)) + :keys "v r"] + ["Reverse (1:)" + (progn + (require 'calc-vec) + (call-interactively 'calc-reverse-vector)) + :keys "v v"] + ["Unpack (1:)" + (progn + (require 'calc-vec) + (call-interactively 'calc-unpack)) + :keys "v u" + :help "Separate the elements of (1:)"] + ["(2:) cross (1:)" + (progn + (require 'calc-vec) + (call-interactively 'calc-cross)) + :keys "V C" + :help "The cross product in R^3"] + ["(2:) dot (1:)" + calc-mult + :keys "*" + :help "The dot product"] + ["Map a function across (1:)" + (progn + (require 'calc-map) + (call-interactively 'calc-map)) + :keys "V M" + :help "Apply a function to each element"]) + (list "Vectors As Sets" + ["Remove duplicates from (1:)" + (progn + (require 'calc-vec) + (call-interactively 'calc-remove-duplicates)) + :keys "V +"] + ["(2:) union (1:)" + (progn + (require 'calc-vec) + (call-interactively 'calc-set-union)) + :keys "V V"] + ["(2:) intersect (1:)" + (progn + (require 'calc-vec) + (call-interactively 'calc-set-intersect)) + :keys "V ^"] + ["(2:) \\ (1:)" + (progn + (require 'calc-vec) + (call-interactively 'calc-set-difference)) + :keys "V -" + :help "Set difference"]) + (list "Statistics On Vectors" + ["length(1:)" + (progn + (require 'calc-stat) + (call-interactively 'calc-vector-count)) + :keys "u #" + :help "The number of data values"] + ["sum(1:)" + (progn + (require 'calc-stat) + (call-interactively 'calc-vector-sum)) + :keys "u +" + :help "The sum of the data values"] + ["max(1:)" + (progn + (require 'calc-stat) + (call-interactively 'calc-vector-max)) + :keys "u x" + :help "The maximum of the data values"] + ["min(1:)" + (progn + (require 'calc-stat) + (call-interactively 'calc-vector-min)) + :keys "u N" + :help "The minumum of the data values"] + ["mean(1:)" + (progn + (require 'calc-stat) + (call-interactively 'calc-vector-mean)) + :keys "u M" + :help "The average (arithmetic mean) of the data values"] + ["mean(1:) with error" + (progn + (require 'calc-stat) + (call-interactively 'calc-vector-mean-error)) + :keys "I u M" + :help "The average (arithmetic mean) of the data values as an error form"] + ["sdev(1:)" + (progn + (require 'calc-stat) + (call-interactively 'calc-vector-sdev)) + :keys "u S" + :help "The sample sdev, sqrt[sum((values - mean)^2)/(N-1)]"] + ["variance(1:)" + (progn + (require 'calc-stat) + (call-interactively 'calc-vector-variance)) + :keys "H u S" + :help "The sample variance, sum((values - mean)^2)/(N-1)"] + ["population sdev(1:)" + (progn + (require 'calc-stat) + (call-interactively 'calc-vector-pop-sdev)) + :keys "I u S" + :help "The population sdev, sqrt[sum((values - mean)^2)/N]"] + ["population variance(1:)" + (progn + (require 'calc-stat) + (call-interactively 'calc-vector-pop-variance)) + :keys "H I u S" + :help "The population variance, sum((values - mean)^2)/N"] + ["median(1:)" + (progn + (require 'calc-stat) + (call-interactively 'calc-vector-median)) + :keys "H u M" + :help "The median of the data values"] + ["harmonic mean(1:)" + (progn + (require 'calc-stat) + (call-interactively 'calc-vector-harmonic-mean)) + :keys "H I u M"] + ["geometric mean(1:)" + (progn + (require 'calc-stat) + (call-interactively 'calc-vector-geometric-mean)) + :keys "u G"] + ["arithmetic-geometric mean(1:)" + (progn + (require 'calc-stat) + (let ((calc-hyperbolic-flag t)) + (call-interactively 'calc-vector-geometric-mean))) + :keys "H u G"] + ["RMS(1:)" + (progn (require 'calc-arith) + (call-interactively 'calc-abs)) + :keys "A" + :help "The root-mean-square, or quadratic mean"]) + ["Abbreviate long vectors" + (progn + (require 'calc-mode) + (call-interactively 'calc-full-vectors)) + :keys "v ." + :style toggle + :selected (not calc-full-vectors)] + "----" + ["Help on Matrices/Vectors" + (calc-info-goto-node "Matrix Functions")]) + "Menu for Calc's vector and matrix functions.") + +(defvar calc-units-menu + (list "Units" + ["Convert units in (1:)" + (progn + (require 'calc-units) + (call-interactively 'calc-convert-units )) + :keys "u c"] + ["Convert temperature in (1:)" + (progn + (require 'calc-units) + (call-interactively 'calc-convert-temperature)) + :keys "u t"] + ["Simplify units in (1:)" + (progn + (require 'calc-units) + (call-interactively 'calc-simplify-units)) + :keys "u s"] + ["View units table" + (progn + (require 'calc-units) + (call-interactively 'calc-view-units-table)) + :keys "u V"] + "----" + ["Help on Units" + (calc-info-goto-node "Units")]) + "Menu for Calc's units functions.") + +(defvar calc-variables-menu + (list "Variables" + ["Store (1:) into a variable" + (progn + (require 'calc-store) + (call-interactively 'calc-store)) + :keys "s s"] + ["Recall a variable value" + (progn + (require 'calc-store) + (call-interactively 'calc-recall )) + :keys "s r"] + ["Edit the value of a variable" + (progn + (require 'calc-store) + (call-interactively 'calc-edit-variable)) + :keys "s e"] + ["Exchange (1:) with a variable value" + (progn + (require 'calc-store) + (call-interactively 'calc-store-exchange)) + :keys "s x"] + ["Clear variable value" + (progn + (require 'calc-store) + (call-interactively 'calc-unstore)) + :keys "s u"] + ["Evaluate variables in (1:)" + (progn + (require 'calc-ext) + (call-interactively 'calc-evaluate)) + :keys "="] + ["Evaluate (1:), assigning a value to a variable" + (progn + (require 'calc-store) + (call-interactively 'calc-let)) + :keys "s l" + :help "Evaluate (1:) under a temporary assignment of a variable"] + "----" + ["Help on Variables" + (calc-info-goto-node "Store and Recall")]) + "Menu for Calc's variables.") + +(defvar calc-stack-menu + (list "Stack" + ["Remove (1:)" + calc-pop + :keys "DEL"] + ["Switch (1:) and (2:)" + calc-roll-down + :keys "TAB"] + ["Duplicate (1:)" + calc-enter + :keys "RET"] + ["Edit (1:)" + (progn + (require 'calc-yank) + (call-interactively calc-edit)) + :keys "`"] + "----" + ["Help on Stack" + (calc-info-goto-node "Stack and Trail")]) + "Menu for Calc's stack functions.") + +(defvar calc-errors-menu + (list "Undo" + ["Undo" + (progn + (require 'calc-undo) + (call-interactively 'calc-undo)) + :keys "U"] + ["Redo" + (progn + (require 'calc-undo) + (call-interactively 'calc-redo)) + :keys "D"] + "----" + ["Help on Undo" + (progn + (calc-info-goto-node "Introduction") + (Info-goto-node "Undo"))])) + +(defvar calc-modes-menu + (list "Modes" + ["Precision" + (progn + (require 'calc-ext) + (call-interactively 'calc-precision)) + :keys "p" + :help "Set the precision for floating point calculations"] + ["Fraction mode" + (progn + (require 'calc-frac) + (call-interactively 'calc-frac-mode)) + :keys "m f" + :style toggle + :selected calc-prefer-frac + :help "Leave integer quotients as fractions"] + ["Symbolic mode" + (lambda () + (interactive) + (require 'calc-mode) + (calc-symbolic-mode nil)) + :keys "m s" + :style toggle + :selected calc-symbolic-mode + :help "Leave functions producing inexact answers in symbolic form"] + ["Infinite mode" + (lambda () + (interactive) + (require 'calc-mode) + (calc-infinite-mode nil)) + :keys "m i" + :style toggle + :selected calc-infinite-mode + :help "Let expressions like 1/0 produce infinite results"] + ["Abbreviate long vectors" + (progn + (require 'calc-mode) + (call-interactively 'calc-full-vectors)) + :keys "v ." + :style toggle + :selected (not calc-full-vectors)] + (list "Angle Measure" + ["Radians" + (progn + (require 'calc-math) + (call-interactively 'calc-radians-mode)) + :keys "m r" + :style radio + :selected (eq calc-angle-mode 'rad)] + ["Degrees" + (progn + (require 'calc-math) + (call-interactively 'calc-degrees-mode)) + :keys "m d" + :style radio + :selected (eq calc-angle-mode 'deg)] + ["HMS" + (progn + (require 'calc-math) + (call-interactively 'calc-hms-mode)) + :keys "m h" + :style radio + :selected (eq calc-angle-mode 'hms)]) + (list "Radix" + ["Decimal" + (progn + (require 'calc-bin) + (call-interactively 'calc-decimal-radix)) + :keys "d 0" + :style radio + :selected (= calc-number-radix 10)] + ["Binary" + (progn + (require 'calc-bin) + (call-interactively 'calc-binary-radix)) + :keys "d 2" + :style radio + :selected (= calc-number-radix 2)] + ["Octal" + (progn + (require 'calc-bin) + (call-interactively 'calc-octal-radix)) + :keys "d 8" + :style radio + :selected (= calc-number-radix 8)] + ["Hexadecimal" + (progn + (require 'calc-bin) + (call-interactively 'calc-hex-radix)) + :keys "d 6" + :style radio + :selected (= calc-number-radix 16)] + ["Other" + (progn + (require 'calc-bin) + (call-interactively 'calc-radix)) + :keys "d r" + :style radio + :selected (not + (or + (= calc-number-radix 10) + (= calc-number-radix 2) + (= calc-number-radix 8) + (= calc-number-radix 16)))]) + (list "Float Format" + ["Normal" + (progn + (require 'calc-mode) + (call-interactively 'calc-normal-notation)) + :keys "d n" + :style radio + :selected (eq (car-safe calc-float-format) 'float)] + ["Fixed point" + (progn + (require 'calc-mode) + (call-interactively 'calc-fix-notation)) + :keys "d f" + :style radio + :selected (eq (car-safe calc-float-format) 'fix)] + ["Scientific notation" + (progn + (require 'calc-mode) + (call-interactively 'calc-sci-notation)) + :keys "d s" + :style radio + :selected (eq (car-safe calc-float-format) 'sci)] + ["Engineering notation" + (progn + (require 'calc-mode) + (call-interactively 'calc-eng-notation)) + :keys "d e" + :style radio + :selected (eq (car-safe calc-float-format) 'eng)]) + (list "Algebraic" + ["Normal" + (progn + (require 'calc-mode) + (cond + (calc-incomplete-algebraic-mode + (calc-algebraic-mode t)) + (calc-algebraic-mode + (calc-algebraic-mode nil)))) + :style radio + :selected (not calc-algebraic-mode)] + ["Algebraic mode" + (progn + (require 'calc-mode) + (if (or + calc-incomplete-algebraic-mode + (not calc-algebraic-mode)) + (calc-algebraic-mode nil))) + :keys "m a" + :style radio + :selected (and calc-algebraic-mode + (not calc-incomplete-algebraic-mode)) + :help "Keys which start numeric entry also start algebraic entry"] + ["Incomplete algebraic mode" + (progn + (require 'calc-mode) + (unless calc-incomplete-algebraic-mode + (calc-algebraic-mode t))) + :keys "C-u m a" + :style radio + :selected calc-incomplete-algebraic-mode + :help "Only ( and [ begin algebraic entry"] + ["Total algebraic mode" + (progn + (require 'calc-mode) + (unless (eq calc-algebraic-mode 'total) + (calc-total-algebraic-mode nil))) + :keys "m t" + :style radio + :selected (eq calc-algebraic-mode 'total) + :help "All regular letters and punctuation begin algebraic entry"]) + (list "Language" + ["Normal" + (progn + (require 'calc-lang) + (call-interactively 'calc-normal-language)) + :keys "d N" + :style radio + :selected (eq calc-language nil)] + ["Big" + (progn + (require 'calc-lang) + (call-interactively 'calc-big-language)) + :keys "d B" + :style radio + :selected (eq calc-language 'big) + :help "Use textual approximations to various mathematical notations"] + ["Flat" + (progn + (require 'calc-lang) + (call-interactively 'calc-flat-language)) + :keys "d O" + :style radio + :selected (eq calc-language 'flat) + :help "Write matrices on a single line"] + ["C" + (progn + (require 'calc-lang) + (call-interactively 'calc-c-language)) + :keys "d C" + :style radio + :selected (eq calc-language 'c)] + ["Pascal" + (progn + (require 'calc-lang) + (call-interactively 'calc-pascal-language)) + :keys "d P" + :style radio + :selected (eq calc-language 'pascal)] + ["Fortran" + (progn + (require 'calc-lang) + (call-interactively 'calc-fortran-language)) + :keys "d F" + :style radio + :selected (eq calc-language 'fortran)] + ["TeX" + (progn + (require 'calc-lang) + (call-interactively 'calc-tex-language)) + :keys "d T" + :style radio + :selected (eq calc-language 'tex)] + ["LaTeX" + (progn + (require 'calc-lang) + (call-interactively 'calc-latex-language)) + :keys "d L" + :style radio + :selected (eq calc-language 'latex)] + ["Eqn" + (progn + (require 'calc-lang) + (call-interactively 'calc-eqn-language)) + :keys "d E" + :style radio + :selected (eq calc-language 'eqn)]) + "----" + ["Save mode settings" calc-save-modes :keys "m m"] + "----" + ["Help on Modes" + (calc-info-goto-node "Mode settings")]) + "Menu for Calc's mode settings.") + +(defvar calc-help-menu + (list "Help" + ["Manual" + calc-info + :keys "h i"] + ["Tutorial" + calc-tutorial + :keys "h t"] + ["Summary" + calc-info-summary + :keys "h s"] + "----" + ["Help on Help" + (progn + (calc-info-goto-node "Introduction") + (Info-goto-node "Help Commands"))]) + "Menu for Calc's help functions.") + +(defvar calc-mode-map) + +(easy-menu-define + calc-menu + calc-mode-map + "Menu for Calc." + (list "Calc" + :visible '(eq major-mode 'calc-mode) + calc-arithmetic-menu + calc-scientific-function-menu + calc-algebra-menu + calc-graphics-menu + calc-vectors-menu + calc-units-menu + calc-variables-menu + calc-stack-menu + calc-errors-menu + calc-modes-menu + calc-help-menu + ["Reset" + (progn + (require 'calc-ext) + (call-interactively 'calc-reset)) + :help "Reset Calc to its initial state"] + ["Quit" calc-quit])) + +(provide 'calc-menu) + +;; arch-tag: 9612c86a-cd4f-4baa-ab0b-40af7344d21f diff --git a/lisp/calc/calc-misc.el b/lisp/calc/calc-misc.el index b660e046a21..f63e0fa42f9 100644 --- a/lisp/calc/calc-misc.el +++ b/lisp/calc/calc-misc.el @@ -32,6 +32,35 @@ (require 'calc) (require 'calc-macs) +;; Declare functions which are defined elsewhere. +(declare-function calc-do-keypad "calc-keypd" (&optional full-display interactive)) +(declare-function calc-inv-hyp-prefix-help "calc-help" ()) +(declare-function calc-inverse-prefix-help "calc-help" ()) +(declare-function calc-hyperbolic-prefix-help "calc-help" ()) +(declare-function calc-explain-why "calc-stuff" (why &optional more)) +(declare-function calc-clear-command-flag "calc-ext" (f)) +(declare-function calc-roll-down-with-selections "calc-sel" (n m)) +(declare-function calc-roll-up-with-selections "calc-sel" (n m)) +(declare-function calc-last-args "calc-undo" (n)) +(declare-function calc-is-inverse "calc-ext" ()) +(declare-function calc-do-prefix-help "calc-ext" (msgs group key)) +(declare-function math-objvecp "calc-ext" (a)) +(declare-function math-known-scalarp "calc-arith" (a &optional assume-scalar)) +(declare-function math-vectorp "calc-ext" (a)) +(declare-function math-matrixp "calc-ext" (a)) +(declare-function math-trunc-special "calc-arith" (a prec)) +(declare-function math-trunc-fancy "calc-arith" (a)) +(declare-function math-floor-special "calc-arith" (a prec)) +(declare-function math-floor-fancy "calc-arith" (a)) +(declare-function math-square-matrixp "calc-ext" (a)) +(declare-function math-matrix-inv-raw "calc-mtx" (m)) +(declare-function math-known-matrixp "calc-arith" (a)) +(declare-function math-mod-fancy "calc-arith" (a b)) +(declare-function math-pow-of-zero "calc-arith" (a b)) +(declare-function math-pow-zero "calc-arith" (a b)) +(declare-function math-pow-fancy "calc-arith" (a b)) + + (defun calc-dispatch-help (arg) "C-x* is a prefix key sequence; follow it with one of these letters: diff --git a/lisp/calc/calc-mode.el b/lisp/calc/calc-mode.el index 3d6fafc844a..d7daf1bf997 100644 --- a/lisp/calc/calc-mode.el +++ b/lisp/calc/calc-mode.el @@ -32,6 +32,10 @@ (require 'calc-ext) (require 'calc-macs) +;; Declare functions which are defined elsewhere. +(declare-function calc-embedded-save-original-modes "calc-embed" ()) + + (defun calc-line-numbering (n) (interactive "P") (calc-wrapper diff --git a/lisp/calc/calc-nlfit.el b/lisp/calc/calc-nlfit.el index 489599781f6..4019058a567 100644 --- a/lisp/calc/calc-nlfit.el +++ b/lisp/calc/calc-nlfit.el @@ -61,6 +61,11 @@ ;;; Code: (require 'calc-arith) +(require 'calcalg3) + +;; Declare functions which are defined elsewhere. +(declare-function calc-get-fit-variables "calcalg3" (nv nc &optional defv defc with-y homog)) +(declare-function math-map-binop "calcalg3" (binop args1 args2)) (defun math-nlfit-least-squares (xdata ydata &optional sdata sigmas) "Return the parameters A and B for the best least squares fit y=a+bx." @@ -188,7 +193,7 @@ ;;; the maximum value of q. (defun math-nlfit-find-qmax (qdata pdata tdata) - (let* ((ratios (mapcar* 'math-div pdata qdata)) + (let* ((ratios (math-map-binop 'math-div pdata qdata)) (lsdata (math-nlfit-least-squares ratios tdata)) (qmax (math-max-list (car qdata) (cdr qdata))) (a (math-neg (math-div (nth 1 lsdata) (nth 0 lsdata))))) @@ -295,7 +300,7 @@ (mat nil) (k 0)) (while (< k i) - (setq mat (cons (copy-list row) mat)) + (setq mat (cons (copy-sequence row) mat)) (setq k (1+ k))) mat)) @@ -513,7 +518,7 @@ (let* ((Ctilda (math-nlfit-make-Ctilda C lambda)) (dtilda (math-nlfit-make-dtilda d (length (car C)))) (zeta (math-nlfit-givens Ctilda dtilda)) - (newparms (mapcar* 'math-add (copy-tree parms) zeta)) + (newparms (math-map-binop 'math-add (copy-tree parms) zeta)) (newchisq (math-nlfit-chi-sq xlist ylist newparms fn slist))) (if (math-lessp newchisq chisq) (progn @@ -692,7 +697,8 @@ (nth 0 sigmacovar))) (finalparms (if sigmas - (mapcar* (lambda (x y) (list 'sdev x y)) finalparms sigmas) + (math-map-binop + (lambda (x y) (list 'sdev x y)) finalparms sigmas) finalparms)) (soln (funcall solnexpr finalparms var))) (let ((calc-fit-to-trail t) @@ -752,7 +758,7 @@ (mapcar (lambda (x) (math-get-sdev x t)) pdata) nil)) (pdata (mapcar (lambda (x) (math-get-value x)) pdata)) - (poverqdata (mapcar* 'math-div pdata qdata)) + (poverqdata (math-map-binop 'math-div pdata qdata)) (parmvals (math-nlfit-least-squares qdata poverqdata sdata sdevv)) (finalparms (list (nth 0 parmvals) (math-neg diff --git a/lisp/calc/calc-prog.el b/lisp/calc/calc-prog.el index 4ceeeba3b42..87adf48006d 100644 --- a/lisp/calc/calc-prog.el +++ b/lisp/calc/calc-prog.el @@ -32,6 +32,11 @@ (require 'calc-ext) (require 'calc-macs) +;; Declare functions which are defined elsewhere. +(declare-function edmacro-format-keys "edmacro" (macro &optional verbose)) +(declare-function edmacro-parse-keys "edmacro" (string &optional need-vector)) +(declare-function math-read-expr-level "calc-aent" (exp-prec &optional exp-term)) + (defun calc-equal-to (arg) (interactive "P") diff --git a/lisp/calc/calc-vec.el b/lisp/calc/calc-vec.el index e4b3e1e5bbc..e224e1ca6f5 100644 --- a/lisp/calc/calc-vec.el +++ b/lisp/calc/calc-vec.el @@ -32,6 +32,10 @@ (require 'calc-ext) (require 'calc-macs) +;; Declare functions which are defined elsewhere. +(declare-function math-read-expr-level "calc-aent" (exp-prec &optional exp-term)) + + (defun calc-display-strings (n) (interactive "P") (calc-wrapper diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index 5cfccb4f8db..69cacec2220 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el @@ -206,6 +206,84 @@ (require 'calc-macs) +;; Declare functions which are defined elsewhere. +(declare-function calc-set-language "calc-lang" (lang &optional option no-refresh)) +(declare-function calc-edit-finish "calc-yank" (&optional keep)) +(declare-function calc-edit-cancel "calc-yank" ()) +(declare-function calc-do-quick-calc "calc-aent" ()) +(declare-function calc-do-calc-eval "calc-aent" (str separator args)) +(declare-function calc-do-keypad "calc-keypd" (&optional full-display interactive)) +(declare-function calcFunc-unixtime "calc-forms" (date &optional zone)) +(declare-function math-parse-date "calc-forms" (math-pd-str)) +(declare-function math-lessp "calc-ext" (a b)) +(declare-function calc-embedded-finish-command "calc-embed" ()) +(declare-function calc-embedded-select-buffer "calc-embed" ()) +(declare-function calc-embedded-mode-line-change "calc-embed" ()) +(declare-function calc-push-list-in-macro "calc-prog" (vals m sels)) +(declare-function calc-replace-selections "calc-sel" (n vals m)) +(declare-function calc-record-list "calc-misc" (vals &optional prefix)) +(declare-function calc-normalize-fancy "calc-ext" (val)) +(declare-function calc-do-handle-whys "calc-misc" ()) +(declare-function calc-top-selected "calc-sel" (&optional n m)) +(declare-function calc-sel-error "calc-sel" ()) +(declare-function calc-pop-stack-in-macro "calc-prog" (n mm)) +(declare-function calc-embedded-stack-change "calc-embed" ()) +(declare-function calc-refresh-evaltos "calc-ext" (&optional which-var)) +(declare-function calc-do-refresh "calc-misc" ()) +(declare-function calc-binary-op-fancy "calc-ext" (name func arg ident unary)) +(declare-function calc-unary-op-fancy "calc-ext" (name func arg)) +(declare-function calc-delete-selection "calc-sel" (n)) +(declare-function calc-alg-digit-entry "calc-aent" ()) +(declare-function calc-alg-entry "calc-aent" (&optional initial prompt)) +(declare-function calc-dots "calc-incom" ()) +(declare-function calc-temp-minibuffer-message "calc-misc" (m)) +(declare-function math-read-radix-digit "calc-misc" (dig)) +(declare-function calc-digit-dots "calc-incom" ()) +(declare-function math-normalize-fancy "calc-ext" (a)) +(declare-function math-normalize-nonstandard "calc-ext" ()) +(declare-function math-recompile-eval-rules "calc-alg" ()) +(declare-function math-apply-rewrites "calc-rewr" (expr rules &optional heads math-apply-rw-ruleset)) +(declare-function calc-record-why "calc-misc" (&rest stuff)) +(declare-function math-dimension-error "calc-vec" ()) +(declare-function calc-incomplete-error "calc-incom" (a)) +(declare-function math-float-fancy "calc-arith" (a)) +(declare-function math-neg-fancy "calc-arith" (a)) +(declare-function math-zerop "calc-misc" (a)) +(declare-function calc-add-fractions "calc-frac" (a b)) +(declare-function math-add-objects-fancy "calc-arith" (a b)) +(declare-function math-add-symb-fancy "calc-arith" (a b)) +(declare-function math-mul-zero "calc-arith" (a b)) +(declare-function calc-mul-fractions "calc-frac" (a b)) +(declare-function math-mul-objects-fancy "calc-arith" (a b)) +(declare-function math-mul-symb-fancy "calc-arith" (a b)) +(declare-function math-reject-arg "calc-misc" (&optional a p option)) +(declare-function math-div-by-zero "calc-arith" (a b)) +(declare-function math-div-zero "calc-arith" (a b)) +(declare-function math-make-frac "calc-frac" (num den)) +(declare-function calc-div-fractions "calc-frac" (a b)) +(declare-function math-div-objects-fancy "calc-arith" (a b)) +(declare-function math-div-symb-fancy "calc-arith" (a b)) +(declare-function math-compose-expr "calccomp" (a prec)) +(declare-function math-comp-width "calccomp" (c)) +(declare-function math-composition-to-string "calccomp" (c &optional width)) +(declare-function math-stack-value-offset-fancy "calccomp" ()) +(declare-function math-format-flat-expr-fancy "calc-ext" (a prec)) +(declare-function math-adjust-fraction "calc-ext" (a)) +(declare-function math-format-binary "calc-bin" (a)) +(declare-function math-format-radix "calc-bin" (a)) +(declare-function math-group-float "calc-ext" (str)) +(declare-function math-mod "calc-misc" (a b)) +(declare-function math-format-number-fancy "calc-ext" (a prec)) +(declare-function math-format-bignum-fancy "calc-ext" (a)) +(declare-function math-read-number-fancy "calc-ext" (s)) +(declare-function calc-do-grab-region "calc-yank" (top bot arg)) +(declare-function calc-do-grab-rectangle "calc-yank" (top bot arg &optional reduce)) +(declare-function calc-do-embedded "calc-embed" (calc-embed-arg end obeg oend)) +(declare-function calc-do-embedded-activate "calc-embed" (calc-embed-arg cbuf)) +(declare-function math-do-defmath "calc-prog" (func args body)) +(declare-function calc-load-everything "calc-ext" ()) + + (defgroup calc nil "GNU Calc." :prefix "calc-" @@ -889,6 +967,16 @@ If nil, selections displayed but ignored.") "Function through which to pass strings before parsing.") (defvar calc-radix-formatter nil "Formatting function used for non-decimal numbers.") +(defvar calc-lang-slash-idiv nil + "A list of languages in which / might represent integer division.") +(defvar calc-lang-allow-underscores nil + "A list of languages which allow underscores in variable names.") +(defvar calc-lang-c-type-hex nil + "Languages in which octal and hex numbers are written with leading 0 and 0x,") +(defvar calc-lang-brackets-are-subscripts nil + "Languages in which subscripts are indicated by brackets.") +(defvar calc-lang-parens-are-subscripts nil + "Languages in which subscripts are indicated by parentheses.") (defvar calc-last-kill nil) ; Last number killed in calc-mode. (defvar calc-dollar-values nil) ; Values to be used for '$'. @@ -911,7 +999,6 @@ If nil, selections displayed but ignored.") (defvar math-eval-rules-cache-tag t) (defvar math-radix-explicit-format t) (defvar math-expr-function-mapping nil) -(defvar math-expr-special-function-mapping nil) (defvar math-expr-variable-mapping nil) (defvar math-read-expr-quotes nil) (defvar math-working-step nil) @@ -1009,6 +1096,7 @@ If nil, selections displayed but ignored.") (if calc-scan-for-dels (append (where-is-internal 'delete-backward-char global-map) (where-is-internal 'backward-delete-char global-map) + (where-is-internal 'backward-delete-char-untabify global-map) '("\C-d")) '("\177" "\C-d"))) @@ -1221,6 +1309,7 @@ Notations: 3.14e6 3.14 * 10^6 (string-match "full" (nth 1 p)) (setq calc-standalone-flag t)) (setq p (cdr p)))) + (require 'calc-menu) (run-mode-hooks 'calc-mode-hook) (calc-refresh t) (calc-set-mode-line) @@ -3497,34 +3586,6 @@ and all digits are kept, regardless of Calc's current precision." (math-read-bignum (substring s 0 (- math-bignum-digit-length)))) (list (string-to-number s)))) - -(defconst math-tex-ignore-words - '( ("\\hbox") ("\\mbox") ("\\text") ("\\left") ("\\right") - ("\\,") ("\\>") ("\\:") ("\\;") ("\\!") ("\\ ") - ("\\quad") ("\\qquad") ("\\hfil") ("\\hfill") - ("\\displaystyle") ("\\textstyle") ("\\dsize") ("\\tsize") - ("\\scriptstyle") ("\\scriptscriptstyle") ("\\ssize") ("\\sssize") - ("\\rm") ("\\bf") ("\\it") ("\\sl") - ("\\roman") ("\\bold") ("\\italic") ("\\slanted") - ("\\cal") ("\\mit") ("\\Cal") ("\\Bbb") ("\\frak") ("\\goth") - ("\\evalto") - ("\\matrix" mat) ("\\bmatrix" mat) ("\\pmatrix" mat) - ("\\begin" begenv) - ("\\cr" punc ";") ("\\\\" punc ";") ("\\*" punc "*") - ("\\{" punc "[") ("\\}" punc "]"))) - -(defconst math-latex-ignore-words - (append math-tex-ignore-words - '(("\\begin" begenv)))) - -(defconst math-eqn-ignore-words - '( ("roman") ("bold") ("italic") ("mark") ("lineup") ("evalto") - ("left" ("floor") ("ceil")) - ("right" ("floor") ("ceil")) - ("arc" ("sin") ("cos") ("tan") ("sinh") ("cosh") ("tanh")) - ("size" n) ("font" n) ("fwd" n) ("back" n) ("up" n) ("down" n) - ("above" punc ","))) - (defconst math-standard-opers '( ( "_" calcFunc-subscr 1200 1201 ) ( "%" calcFunc-percent 1100 -1 ) diff --git a/lisp/calc/calcalg3.el b/lisp/calc/calcalg3.el index 5aa410be19e..374b0487cfe 100644 --- a/lisp/calc/calcalg3.el +++ b/lisp/calc/calcalg3.el @@ -32,6 +32,24 @@ (require 'calc-ext) (require 'calc-macs) +;; Declare functions which are defined elsewhere. +(declare-function calc-fit-s-shaped-logistic-curve "calc-nlfit" (arg)) +(declare-function calc-fit-bell-shaped-logistic-curve "calc-nlfit" (arg)) +(declare-function calc-fit-hubbert-linear-curve "calc-nlfit" (&optional sdv)) +(declare-function calc-graph-add-curve "calc-graph" (xdata ydata &optional zdata)) +(declare-function calc-graph-lookup "calc-graph" (thing)) +(declare-function calc-graph-set-styles "calc-graph" (lines points &optional yerr)) +(declare-function math-min-list "calc-arith" (a b)) +(declare-function math-max-list "calc-arith" (a b)) + + +(defun math-map-binop (binop args1 args2) + "Apply BINOP to the elements of the lists ARGS1 and ARGS2" + (if args1 + (cons + (funcall binop (car args1) (car args2)) + (funcall 'math-map-binop binop (cdr args1) (cdr args2))))) + (defun calc-find-root (var) (interactive "sVariable(s) to solve for: ") (calc-slow-wrapper @@ -239,9 +257,9 @@ (nth 1 plot) (cons 'vec - (mapcar* 'calcFunc-div - (cdr (nth 2 plot)) - (cdr (nth 1 plot))))))) + (math-map-binop 'calcFunc-div + (cdr (nth 2 plot)) + (cdr (nth 1 plot))))))) (calc-fit-hubbert-linear-curve func)) ((memq key '(?e ?E)) (calc-get-fit-variables calc-curve-nvars diff --git a/lisp/calc/calccomp.el b/lisp/calc/calccomp.el index 6bd663cef5b..dd59b366881 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,6 +70,21 @@ (defvar math-comp-right-bracket) (defvar math-comp-comma) +(defun math-compose-var (a) + (let (v) + (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 calc-lang-allow-underscores) + (math-to-underscores (symbol-name (nth 1 a))) + (symbol-name (nth 1 a)))))) (defun math-compose-expr (a prec) (let ((math-compose-level (1+ math-compose-level)) @@ -94,17 +99,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)) @@ -268,59 +280,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) @@ -354,62 +332,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)) @@ -426,25 +365,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 @@ -469,14 +389,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))) @@ -525,11 +437,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)) @@ -663,13 +573,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)) @@ -895,56 +805,14 @@ (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-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) @@ -1003,8 +871,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 " ") " ") @@ -1016,31 +888,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)) |