Mercurial > emacs
diff lisp/calc/calc-ext.el @ 40785:2fb9d407ae73
Initial import of Calc 2.02f.
| author | Eli Zaretskii <eliz@gnu.org> |
|---|---|
| date | Tue, 06 Nov 2001 18:59:06 +0000 |
| parents | |
| children | d277eddc41c4 |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/calc/calc-ext.el Tue Nov 06 18:59:06 2001 +0000 @@ -0,0 +1,3439 @@ +;; Calculator for GNU Emacs, part II +;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc. +;; Written by Dave Gillespie, daveg@synaptics.com. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY. No author or distributor +;; accepts responsibility to anyone for the consequences of using it +;; or for whether it serves any particular purpose or works at all, +;; unless he says so in writing. Refer to the GNU Emacs General Public +;; License for full details. + +;; Everyone is granted permission to copy, modify and redistribute +;; GNU Emacs, but only under the conditions described in the +;; GNU Emacs General Public License. A copy of this license is +;; supposed to have been given to you along with GNU Emacs so you +;; can know your rights and responsibilities. It should be in a +;; file named COPYING. Among other things, the copyright notice +;; and this notice must be preserved on all copies. + + + +(provide 'calc-ext) + +(setq calc-extensions-loaded t) + +;;; This function is the autoload "hook" to cause this file to be loaded. +;;;###autoload +(defun calc-extensions () + "This function is part of the autoload linkage for parts of Calc." + t +) + +;;; Auto-load calc.el part, in case this part was loaded first. +(if (fboundp 'calc-dispatch) + (and (eq (car-safe (symbol-function 'calc-dispatch)) 'autoload) + (load (nth 1 (symbol-function 'calc-dispatch)))) + (if (fboundp 'calc) + (and (eq (car-safe (symbol-function 'calc)) 'autoload) + (load (nth 1 (symbol-function 'calc)))) + (error "Main part of Calc must be present in order to load this file."))) + +(require 'calc-macs) + +;;; The following was made a function so that it could be byte-compiled. +(defun calc-init-extensions () + + (setq gc-cons-threshold (max gc-cons-threshold 250000)) + + (define-key calc-mode-map ":" 'calc-fdiv) + (define-key calc-mode-map "\\" 'calc-idiv) + (define-key calc-mode-map "|" 'calc-concat) + (define-key calc-mode-map "!" 'calc-factorial) + (define-key calc-mode-map "C" 'calc-cos) + (define-key calc-mode-map "E" 'calc-exp) + (define-key calc-mode-map "H" 'calc-hyperbolic) + (define-key calc-mode-map "I" 'calc-inverse) + (define-key calc-mode-map "J" 'calc-conj) + (define-key calc-mode-map "L" 'calc-ln) + (define-key calc-mode-map "N" 'calc-eval-num) + (define-key calc-mode-map "P" 'calc-pi) + (define-key calc-mode-map "Q" 'calc-sqrt) + (define-key calc-mode-map "R" 'calc-round) + (define-key calc-mode-map "S" 'calc-sin) + (define-key calc-mode-map "T" 'calc-tan) + (define-key calc-mode-map "U" 'calc-undo) + (define-key calc-mode-map "X" 'calc-call-last-kbd-macro) + (define-key calc-mode-map "o" 'calc-realign) + (define-key calc-mode-map "p" 'calc-precision) + (define-key calc-mode-map "w" 'calc-why) + (define-key calc-mode-map "x" 'calc-execute-extended-command) + (define-key calc-mode-map "y" 'calc-copy-to-buffer) + + (define-key calc-mode-map "(" 'calc-begin-complex) + (define-key calc-mode-map ")" 'calc-end-complex) + (define-key calc-mode-map "[" 'calc-begin-vector) + (define-key calc-mode-map "]" 'calc-end-vector) + (define-key calc-mode-map "," 'calc-comma) + (define-key calc-mode-map ";" 'calc-semi) + (define-key calc-mode-map "`" 'calc-edit) + (define-key calc-mode-map "=" 'calc-evaluate) + (define-key calc-mode-map "~" 'calc-num-prefix) + (define-key calc-mode-map "<" 'calc-scroll-left) + (define-key calc-mode-map ">" 'calc-scroll-right) + (define-key calc-mode-map "{" 'calc-scroll-down) + (define-key calc-mode-map "}" 'calc-scroll-up) + (define-key calc-mode-map "\C-k" 'calc-kill) + (define-key calc-mode-map "\M-k" 'calc-copy-as-kill) + (define-key calc-mode-map "\C-w" 'calc-kill-region) + (define-key calc-mode-map "\M-w" 'calc-copy-region-as-kill) + (define-key calc-mode-map "\C-y" 'calc-yank) + (define-key calc-mode-map "\C-_" 'calc-undo) + (define-key calc-mode-map "\C-xu" 'calc-undo) + (define-key calc-mode-map "\M-\C-m" 'calc-last-args) + + (define-key calc-mode-map "a" nil) + (define-key calc-mode-map "a?" 'calc-a-prefix-help) + (define-key calc-mode-map "aa" 'calc-apart) + (define-key calc-mode-map "ab" 'calc-substitute) + (define-key calc-mode-map "ac" 'calc-collect) + (define-key calc-mode-map "ad" 'calc-derivative) + (define-key calc-mode-map "ae" 'calc-simplify-extended) + (define-key calc-mode-map "af" 'calc-factor) + (define-key calc-mode-map "ag" 'calc-poly-gcd) + (define-key calc-mode-map "ai" 'calc-integral) + (define-key calc-mode-map "am" 'calc-match) + (define-key calc-mode-map "an" 'calc-normalize-rat) + (define-key calc-mode-map "ap" 'calc-poly-interp) + (define-key calc-mode-map "ar" 'calc-rewrite) + (define-key calc-mode-map "as" 'calc-simplify) + (define-key calc-mode-map "at" 'calc-taylor) + (define-key calc-mode-map "av" 'calc-alg-evaluate) + (define-key calc-mode-map "ax" 'calc-expand) + (define-key calc-mode-map "aA" 'calc-abs) + (define-key calc-mode-map "aF" 'calc-curve-fit) + (define-key calc-mode-map "aI" 'calc-num-integral) + (define-key calc-mode-map "aM" 'calc-map-equation) + (define-key calc-mode-map "aN" 'calc-find-minimum) + (define-key calc-mode-map "aP" 'calc-poly-roots) + (define-key calc-mode-map "aS" 'calc-solve-for) + (define-key calc-mode-map "aR" 'calc-find-root) + (define-key calc-mode-map "aT" 'calc-tabulate) + (define-key calc-mode-map "aX" 'calc-find-maximum) + (define-key calc-mode-map "a+" 'calc-summation) + (define-key calc-mode-map "a-" 'calc-alt-summation) + (define-key calc-mode-map "a*" 'calc-product) + (define-key calc-mode-map "a\\" 'calc-poly-div) + (define-key calc-mode-map "a%" 'calc-poly-rem) + (define-key calc-mode-map "a/" 'calc-poly-div-rem) + (define-key calc-mode-map "a=" 'calc-equal-to) + (define-key calc-mode-map "a#" 'calc-not-equal-to) + (define-key calc-mode-map "a<" 'calc-less-than) + (define-key calc-mode-map "a>" 'calc-greater-than) + (define-key calc-mode-map "a[" 'calc-less-equal) + (define-key calc-mode-map "a]" 'calc-greater-equal) + (define-key calc-mode-map "a." 'calc-remove-equal) + (define-key calc-mode-map "a{" 'calc-in-set) + (define-key calc-mode-map "a&" 'calc-logical-and) + (define-key calc-mode-map "a|" 'calc-logical-or) + (define-key calc-mode-map "a!" 'calc-logical-not) + (define-key calc-mode-map "a:" 'calc-logical-if) + (define-key calc-mode-map "a_" 'calc-subscript) + (define-key calc-mode-map "a\"" 'calc-expand-formula) + + (define-key calc-mode-map "b" nil) + (define-key calc-mode-map "b?" 'calc-b-prefix-help) + (define-key calc-mode-map "ba" 'calc-and) + (define-key calc-mode-map "bc" 'calc-clip) + (define-key calc-mode-map "bd" 'calc-diff) + (define-key calc-mode-map "bl" 'calc-lshift-binary) + (define-key calc-mode-map "bn" 'calc-not) + (define-key calc-mode-map "bo" 'calc-or) + (define-key calc-mode-map "bp" 'calc-pack-bits) + (define-key calc-mode-map "br" 'calc-rshift-binary) + (define-key calc-mode-map "bt" 'calc-rotate-binary) + (define-key calc-mode-map "bu" 'calc-unpack-bits) + (define-key calc-mode-map "bw" 'calc-word-size) + (define-key calc-mode-map "bx" 'calc-xor) + (define-key calc-mode-map "bB" 'calc-log) + (define-key calc-mode-map "bD" 'calc-fin-ddb) + (define-key calc-mode-map "bF" 'calc-fin-fv) + (define-key calc-mode-map "bI" 'calc-fin-irr) + (define-key calc-mode-map "bL" 'calc-lshift-arith) + (define-key calc-mode-map "bM" 'calc-fin-pmt) + (define-key calc-mode-map "bN" 'calc-fin-npv) + (define-key calc-mode-map "bP" 'calc-fin-pv) + (define-key calc-mode-map "bR" 'calc-rshift-arith) + (define-key calc-mode-map "bS" 'calc-fin-sln) + (define-key calc-mode-map "bT" 'calc-fin-rate) + (define-key calc-mode-map "bY" 'calc-fin-syd) + (define-key calc-mode-map "b#" 'calc-fin-nper) + (define-key calc-mode-map "b%" 'calc-percent-change) + + (define-key calc-mode-map "c" nil) + (define-key calc-mode-map "c?" 'calc-c-prefix-help) + (define-key calc-mode-map "cc" 'calc-clean) + (define-key calc-mode-map "cd" 'calc-to-degrees) + (define-key calc-mode-map "cf" 'calc-float) + (define-key calc-mode-map "ch" 'calc-to-hms) + (define-key calc-mode-map "cp" 'calc-polar) + (define-key calc-mode-map "cr" 'calc-to-radians) + (define-key calc-mode-map "cC" 'calc-cos) + (define-key calc-mode-map "cF" 'calc-fraction) + (define-key calc-mode-map "c%" 'calc-convert-percent) + + (define-key calc-mode-map "d" nil) + (define-key calc-mode-map "d?" 'calc-d-prefix-help) + (define-key calc-mode-map "d0" 'calc-decimal-radix) + (define-key calc-mode-map "d2" 'calc-binary-radix) + (define-key calc-mode-map "d6" 'calc-hex-radix) + (define-key calc-mode-map "d8" 'calc-octal-radix) + (define-key calc-mode-map "db" 'calc-line-breaking) + (define-key calc-mode-map "dc" 'calc-complex-notation) + (define-key calc-mode-map "dd" 'calc-date-notation) + (define-key calc-mode-map "de" 'calc-eng-notation) + (define-key calc-mode-map "df" 'calc-fix-notation) + (define-key calc-mode-map "dg" 'calc-group-digits) + (define-key calc-mode-map "dh" 'calc-hms-notation) + (define-key calc-mode-map "di" 'calc-i-notation) + (define-key calc-mode-map "dj" 'calc-j-notation) + (define-key calc-mode-map "dl" 'calc-line-numbering) + (define-key calc-mode-map "dn" 'calc-normal-notation) + (define-key calc-mode-map "do" 'calc-over-notation) + (define-key calc-mode-map "dp" 'calc-show-plain) + (define-key calc-mode-map "dr" 'calc-radix) + (define-key calc-mode-map "ds" 'calc-sci-notation) + (define-key calc-mode-map "dt" 'calc-truncate-stack) + (define-key calc-mode-map "dw" 'calc-auto-why) + (define-key calc-mode-map "dz" 'calc-leading-zeros) + (define-key calc-mode-map "dB" 'calc-big-language) + (define-key calc-mode-map "dD" 'calc-redo) + (define-key calc-mode-map "dC" 'calc-c-language) + (define-key calc-mode-map "dE" 'calc-eqn-language) + (define-key calc-mode-map "dF" 'calc-fortran-language) + (define-key calc-mode-map "dM" 'calc-mathematica-language) + (define-key calc-mode-map "dN" 'calc-normal-language) + (define-key calc-mode-map "dO" 'calc-flat-language) + (define-key calc-mode-map "dP" 'calc-pascal-language) + (define-key calc-mode-map "dT" 'calc-tex-language) + (define-key calc-mode-map "dU" 'calc-unformatted-language) + (define-key calc-mode-map "dW" 'calc-maple-language) + (define-key calc-mode-map "d[" 'calc-truncate-up) + (define-key calc-mode-map "d]" 'calc-truncate-down) + (define-key calc-mode-map "d." 'calc-point-char) + (define-key calc-mode-map "d," 'calc-group-char) + (define-key calc-mode-map "d\"" 'calc-display-strings) + (define-key calc-mode-map "d<" 'calc-left-justify) + (define-key calc-mode-map "d=" 'calc-center-justify) + (define-key calc-mode-map "d>" 'calc-right-justify) + (define-key calc-mode-map "d{" 'calc-left-label) + (define-key calc-mode-map "d}" 'calc-right-label) + (define-key calc-mode-map "d'" 'calc-display-raw) + (define-key calc-mode-map "d " 'calc-refresh) + (define-key calc-mode-map "d\r" 'calc-refresh-top) + + (define-key calc-mode-map "f" nil) + (define-key calc-mode-map "f?" 'calc-f-prefix-help) + (define-key calc-mode-map "fb" 'calc-beta) + (define-key calc-mode-map "fe" 'calc-erf) + (define-key calc-mode-map "fg" 'calc-gamma) + (define-key calc-mode-map "fh" 'calc-hypot) + (define-key calc-mode-map "fi" 'calc-im) + (define-key calc-mode-map "fj" 'calc-bessel-J) + (define-key calc-mode-map "fn" 'calc-min) + (define-key calc-mode-map "fr" 'calc-re) + (define-key calc-mode-map "fs" 'calc-sign) + (define-key calc-mode-map "fx" 'calc-max) + (define-key calc-mode-map "fy" 'calc-bessel-Y) + (define-key calc-mode-map "fA" 'calc-abssqr) + (define-key calc-mode-map "fB" 'calc-inc-beta) + (define-key calc-mode-map "fE" 'calc-expm1) + (define-key calc-mode-map "fF" 'calc-floor) + (define-key calc-mode-map "fG" 'calc-inc-gamma) + (define-key calc-mode-map "fI" 'calc-ilog) + (define-key calc-mode-map "fL" 'calc-lnp1) + (define-key calc-mode-map "fM" 'calc-mant-part) + (define-key calc-mode-map "fQ" 'calc-isqrt) + (define-key calc-mode-map "fS" 'calc-scale-float) + (define-key calc-mode-map "fT" 'calc-arctan2) + (define-key calc-mode-map "fX" 'calc-xpon-part) + (define-key calc-mode-map "f[" 'calc-decrement) + (define-key calc-mode-map "f]" 'calc-increment) + + (define-key calc-mode-map "g" nil) + (define-key calc-mode-map "g?" 'calc-g-prefix-help) + (define-key calc-mode-map "ga" 'calc-graph-add) + (define-key calc-mode-map "gb" 'calc-graph-border) + (define-key calc-mode-map "gc" 'calc-graph-clear) + (define-key calc-mode-map "gd" 'calc-graph-delete) + (define-key calc-mode-map "gf" 'calc-graph-fast) + (define-key calc-mode-map "gg" 'calc-graph-grid) + (define-key calc-mode-map "gh" 'calc-graph-header) + (define-key calc-mode-map "gk" 'calc-graph-key) + (define-key calc-mode-map "gj" 'calc-graph-juggle) + (define-key calc-mode-map "gl" 'calc-graph-log-x) + (define-key calc-mode-map "gn" 'calc-graph-name) + (define-key calc-mode-map "gp" 'calc-graph-plot) + (define-key calc-mode-map "gq" 'calc-graph-quit) + (define-key calc-mode-map "gr" 'calc-graph-range-x) + (define-key calc-mode-map "gs" 'calc-graph-line-style) + (define-key calc-mode-map "gt" 'calc-graph-title-x) + (define-key calc-mode-map "gv" 'calc-graph-view-commands) + (define-key calc-mode-map "gx" 'calc-graph-display) + (define-key calc-mode-map "gz" 'calc-graph-zero-x) + (define-key calc-mode-map "gA" 'calc-graph-add-3d) + (define-key calc-mode-map "gC" 'calc-graph-command) + (define-key calc-mode-map "gD" 'calc-graph-device) + (define-key calc-mode-map "gF" 'calc-graph-fast-3d) + (define-key calc-mode-map "gG" 'calc-argument) + (define-key calc-mode-map "gH" 'calc-graph-hide) + (define-key calc-mode-map "gK" 'calc-graph-kill) + (define-key calc-mode-map "gL" 'calc-graph-log-y) + (define-key calc-mode-map "gN" 'calc-graph-num-points) + (define-key calc-mode-map "gO" 'calc-graph-output) + (define-key calc-mode-map "gP" 'calc-graph-print) + (define-key calc-mode-map "gR" 'calc-graph-range-y) + (define-key calc-mode-map "gS" 'calc-graph-point-style) + (define-key calc-mode-map "gT" 'calc-graph-title-y) + (define-key calc-mode-map "gV" 'calc-graph-view-trail) + (define-key calc-mode-map "gX" 'calc-graph-geometry) + (define-key calc-mode-map "gZ" 'calc-graph-zero-y) + (define-key calc-mode-map "g\C-l" 'calc-graph-log-z) + (define-key calc-mode-map "g\C-r" 'calc-graph-range-z) + (define-key calc-mode-map "g\C-t" 'calc-graph-title-z) + + (define-key calc-mode-map "h" 'calc-help-prefix) + + (define-key calc-mode-map "j" nil) + (define-key calc-mode-map "j?" 'calc-j-prefix-help) + (define-key calc-mode-map "ja" 'calc-select-additional) + (define-key calc-mode-map "jb" 'calc-break-selections) + (define-key calc-mode-map "jc" 'calc-clear-selections) + (define-key calc-mode-map "jd" 'calc-show-selections) + (define-key calc-mode-map "je" 'calc-enable-selections) + (define-key calc-mode-map "jl" 'calc-select-less) + (define-key calc-mode-map "jm" 'calc-select-more) + (define-key calc-mode-map "jn" 'calc-select-next) + (define-key calc-mode-map "jo" 'calc-select-once) + (define-key calc-mode-map "jp" 'calc-select-previous) + (define-key calc-mode-map "jr" 'calc-rewrite-selection) + (define-key calc-mode-map "js" 'calc-select-here) + (define-key calc-mode-map "jv" 'calc-sel-evaluate) + (define-key calc-mode-map "ju" 'calc-unselect) + (define-key calc-mode-map "jC" 'calc-sel-commute) + (define-key calc-mode-map "jD" 'calc-sel-distribute) + (define-key calc-mode-map "jE" 'calc-sel-jump-equals) + (define-key calc-mode-map "jI" 'calc-sel-isolate) + (define-key calc-mode-map "jJ" 'calc-conj) + (define-key calc-mode-map "jL" 'calc-commute-left) + (define-key calc-mode-map "jM" 'calc-sel-merge) + (define-key calc-mode-map "jN" 'calc-sel-negate) + (define-key calc-mode-map "jO" 'calc-select-once-maybe) + (define-key calc-mode-map "jR" 'calc-commute-right) + (define-key calc-mode-map "jS" 'calc-select-here-maybe) + (define-key calc-mode-map "jU" 'calc-sel-unpack) + (define-key calc-mode-map "j&" 'calc-sel-invert) + (define-key calc-mode-map "j\r" 'calc-copy-selection) + (define-key calc-mode-map "j\n" 'calc-copy-selection) + (define-key calc-mode-map "j\010" 'calc-del-selection) + (define-key calc-mode-map "j\177" 'calc-del-selection) + (define-key calc-mode-map "j'" 'calc-enter-selection) + (define-key calc-mode-map "j`" 'calc-edit-selection) + (define-key calc-mode-map "j+" 'calc-sel-add-both-sides) + (define-key calc-mode-map "j-" 'calc-sel-sub-both-sides) + (define-key calc-mode-map "j*" 'calc-sel-mult-both-sides) + (define-key calc-mode-map "j/" 'calc-sel-div-both-sides) + (define-key calc-mode-map "j\"" 'calc-sel-expand-formula) + + (define-key calc-mode-map "k" nil) + (define-key calc-mode-map "k?" 'calc-k-prefix-help) + (define-key calc-mode-map "ka" 'calc-random-again) + (define-key calc-mode-map "kb" 'calc-bernoulli-number) + (define-key calc-mode-map "kc" 'calc-choose) + (define-key calc-mode-map "kd" 'calc-double-factorial) + (define-key calc-mode-map "ke" 'calc-euler-number) + (define-key calc-mode-map "kf" 'calc-prime-factors) + (define-key calc-mode-map "kg" 'calc-gcd) + (define-key calc-mode-map "kh" 'calc-shuffle) + (define-key calc-mode-map "kl" 'calc-lcm) + (define-key calc-mode-map "km" 'calc-moebius) + (define-key calc-mode-map "kn" 'calc-next-prime) + (define-key calc-mode-map "kp" 'calc-prime-test) + (define-key calc-mode-map "kr" 'calc-random) + (define-key calc-mode-map "ks" 'calc-stirling-number) + (define-key calc-mode-map "kt" 'calc-totient) + (define-key calc-mode-map "kB" 'calc-utpb) + (define-key calc-mode-map "kC" 'calc-utpc) + (define-key calc-mode-map "kE" 'calc-extended-gcd) + (define-key calc-mode-map "kF" 'calc-utpf) + (define-key calc-mode-map "kK" 'calc-keep-args) + (define-key calc-mode-map "kN" 'calc-utpn) + (define-key calc-mode-map "kP" 'calc-utpp) + (define-key calc-mode-map "kT" 'calc-utpt) + + (define-key calc-mode-map "m" nil) + (define-key calc-mode-map "m?" 'calc-m-prefix-help) + (define-key calc-mode-map "ma" 'calc-algebraic-mode) + (define-key calc-mode-map "md" 'calc-degrees-mode) + (define-key calc-mode-map "mf" 'calc-frac-mode) + (define-key calc-mode-map "mg" 'calc-get-modes) + (define-key calc-mode-map "mh" 'calc-hms-mode) + (define-key calc-mode-map "mi" 'calc-infinite-mode) + (define-key calc-mode-map "mm" 'calc-save-modes) + (define-key calc-mode-map "mp" 'calc-polar-mode) + (define-key calc-mode-map "mr" 'calc-radians-mode) + (define-key calc-mode-map "ms" 'calc-symbolic-mode) + (define-key calc-mode-map "mt" 'calc-total-algebraic-mode) + (define-key calc-mode-map "\emt" 'calc-total-algebraic-mode) + (define-key calc-mode-map "\em\et" 'calc-total-algebraic-mode) + (define-key calc-mode-map "mv" 'calc-matrix-mode) + (define-key calc-mode-map "mw" 'calc-working) + (define-key calc-mode-map "mx" 'calc-always-load-extensions) + (define-key calc-mode-map "mA" 'calc-alg-simplify-mode) + (define-key calc-mode-map "mB" 'calc-bin-simplify-mode) + (define-key calc-mode-map "mC" 'calc-auto-recompute) + (define-key calc-mode-map "mD" 'calc-default-simplify-mode) + (define-key calc-mode-map "mE" 'calc-ext-simplify-mode) + (define-key calc-mode-map "mF" 'calc-settings-file-name) + (define-key calc-mode-map "mM" 'calc-more-recursion-depth) + (define-key calc-mode-map "mN" 'calc-num-simplify-mode) + (define-key calc-mode-map "mO" 'calc-no-simplify-mode) + (define-key calc-mode-map "mR" 'calc-mode-record-mode) + (define-key calc-mode-map "mS" 'calc-shift-prefix) + (define-key calc-mode-map "mU" 'calc-units-simplify-mode) + (define-key calc-mode-map "mX" 'calc-load-everything) + + (define-key calc-mode-map "r" nil) + (define-key calc-mode-map "r?" 'calc-r-prefix-help) + + (define-key calc-mode-map "s" nil) + (define-key calc-mode-map "s?" 'calc-s-prefix-help) + (define-key calc-mode-map "sc" 'calc-copy-variable) + (define-key calc-mode-map "sd" 'calc-declare-variable) + (define-key calc-mode-map "se" 'calc-edit-variable) + (define-key calc-mode-map "si" 'calc-insert-variables) + (define-key calc-mode-map "sl" 'calc-let) + (define-key calc-mode-map "sm" 'calc-store-map) + (define-key calc-mode-map "sn" 'calc-store-neg) + (define-key calc-mode-map "sp" 'calc-permanent-variable) + (define-key calc-mode-map "sr" 'calc-recall) + (define-key calc-mode-map "ss" 'calc-store) + (define-key calc-mode-map "st" 'calc-store-into) + (define-key calc-mode-map "su" 'calc-unstore) + (define-key calc-mode-map "sx" 'calc-store-exchange) + (define-key calc-mode-map "sA" 'calc-edit-AlgSimpRules) + (define-key calc-mode-map "sD" 'calc-edit-Decls) + (define-key calc-mode-map "sE" 'calc-edit-EvalRules) + (define-key calc-mode-map "sF" 'calc-edit-FitRules) + (define-key calc-mode-map "sG" 'calc-edit-GenCount) + (define-key calc-mode-map "sH" 'calc-edit-Holidays) + (define-key calc-mode-map "sI" 'calc-edit-IntegLimit) + (define-key calc-mode-map "sL" 'calc-edit-LineStyles) + (define-key calc-mode-map "sP" 'calc-edit-PointStyles) + (define-key calc-mode-map "sR" 'calc-edit-PlotRejects) + (define-key calc-mode-map "sS" 'calc-sin) + (define-key calc-mode-map "sT" 'calc-edit-TimeZone) + (define-key calc-mode-map "sU" 'calc-edit-Units) + (define-key calc-mode-map "sX" 'calc-edit-ExtSimpRules) + (define-key calc-mode-map "s+" 'calc-store-plus) + (define-key calc-mode-map "s-" 'calc-store-minus) + (define-key calc-mode-map "s*" 'calc-store-times) + (define-key calc-mode-map "s/" 'calc-store-div) + (define-key calc-mode-map "s^" 'calc-store-power) + (define-key calc-mode-map "s|" 'calc-store-concat) + (define-key calc-mode-map "s&" 'calc-store-inv) + (define-key calc-mode-map "s[" 'calc-store-decr) + (define-key calc-mode-map "s]" 'calc-store-incr) + (define-key calc-mode-map "s:" 'calc-assign) + (define-key calc-mode-map "s=" 'calc-evalto) + + (define-key calc-mode-map "t" nil) + (define-key calc-mode-map "t?" 'calc-t-prefix-help) + (define-key calc-mode-map "tb" 'calc-trail-backward) + (define-key calc-mode-map "td" 'calc-trail-display) + (define-key calc-mode-map "tf" 'calc-trail-forward) + (define-key calc-mode-map "th" 'calc-trail-here) + (define-key calc-mode-map "ti" 'calc-trail-in) + (define-key calc-mode-map "tk" 'calc-trail-kill) + (define-key calc-mode-map "tm" 'calc-trail-marker) + (define-key calc-mode-map "tn" 'calc-trail-next) + (define-key calc-mode-map "to" 'calc-trail-out) + (define-key calc-mode-map "tp" 'calc-trail-previous) + (define-key calc-mode-map "tr" 'calc-trail-isearch-backward) + (define-key calc-mode-map "ts" 'calc-trail-isearch-forward) + (define-key calc-mode-map "ty" 'calc-trail-yank) + (define-key calc-mode-map "t[" 'calc-trail-first) + (define-key calc-mode-map "t]" 'calc-trail-last) + (define-key calc-mode-map "t<" 'calc-trail-scroll-left) + (define-key calc-mode-map "t>" 'calc-trail-scroll-right) + (define-key calc-mode-map "t{" 'calc-trail-backward) + (define-key calc-mode-map "t}" 'calc-trail-forward) + (define-key calc-mode-map "t." 'calc-full-trail-vectors) + (define-key calc-mode-map "tC" 'calc-convert-time-zones) + (define-key calc-mode-map "tD" 'calc-date) + (define-key calc-mode-map "tI" 'calc-inc-month) + (define-key calc-mode-map "tJ" 'calc-julian) + (define-key calc-mode-map "tM" 'calc-new-month) + (define-key calc-mode-map "tN" 'calc-now) + (define-key calc-mode-map "tP" 'calc-date-part) + (define-key calc-mode-map "tT" 'calc-tan) + (define-key calc-mode-map "tU" 'calc-unix-time) + (define-key calc-mode-map "tW" 'calc-new-week) + (define-key calc-mode-map "tY" 'calc-new-year) + (define-key calc-mode-map "tZ" 'calc-time-zone) + (define-key calc-mode-map "t+" 'calc-business-days-plus) + (define-key calc-mode-map "t-" 'calc-business-days-minus) + + (define-key calc-mode-map "u" 'nil) + (define-key calc-mode-map "u?" 'calc-u-prefix-help) + (define-key calc-mode-map "ua" 'calc-autorange-units) + (define-key calc-mode-map "ub" 'calc-base-units) + (define-key calc-mode-map "uc" 'calc-convert-units) + (define-key calc-mode-map "ud" 'calc-define-unit) + (define-key calc-mode-map "ue" 'calc-explain-units) + (define-key calc-mode-map "ug" 'calc-get-unit-definition) + (define-key calc-mode-map "up" 'calc-permanent-units) + (define-key calc-mode-map "ur" 'calc-remove-units) + (define-key calc-mode-map "us" 'calc-simplify-units) + (define-key calc-mode-map "ut" 'calc-convert-temperature) + (define-key calc-mode-map "uu" 'calc-undefine-unit) + (define-key calc-mode-map "uv" 'calc-enter-units-table) + (define-key calc-mode-map "ux" 'calc-extract-units) + (define-key calc-mode-map "uV" 'calc-view-units-table) + (define-key calc-mode-map "uC" 'calc-vector-covariance) + (define-key calc-mode-map "uG" 'calc-vector-geometric-mean) + (define-key calc-mode-map "uM" 'calc-vector-mean) + (define-key calc-mode-map "uN" 'calc-vector-min) + (define-key calc-mode-map "uS" 'calc-vector-sdev) + (define-key calc-mode-map "uU" 'calc-undo) + (define-key calc-mode-map "uX" 'calc-vector-max) + (define-key calc-mode-map "u#" 'calc-vector-count) + (define-key calc-mode-map "u+" 'calc-vector-sum) + (define-key calc-mode-map "u*" 'calc-vector-product) + + (define-key calc-mode-map "v" 'nil) + (define-key calc-mode-map "v?" 'calc-v-prefix-help) + (define-key calc-mode-map "va" 'calc-arrange-vector) + (define-key calc-mode-map "vb" 'calc-build-vector) + (define-key calc-mode-map "vc" 'calc-mcol) + (define-key calc-mode-map "vd" 'calc-diag) + (define-key calc-mode-map "ve" 'calc-expand-vector) + (define-key calc-mode-map "vf" 'calc-vector-find) + (define-key calc-mode-map "vh" 'calc-head) + (define-key calc-mode-map "vi" 'calc-ident) + (define-key calc-mode-map "vk" 'calc-cons) + (define-key calc-mode-map "vl" 'calc-vlength) + (define-key calc-mode-map "vm" 'calc-mask-vector) + (define-key calc-mode-map "vn" 'calc-rnorm) + (define-key calc-mode-map "vp" 'calc-pack) + (define-key calc-mode-map "vr" 'calc-mrow) + (define-key calc-mode-map "vs" 'calc-subvector) + (define-key calc-mode-map "vt" 'calc-transpose) + (define-key calc-mode-map "vu" 'calc-unpack) + (define-key calc-mode-map "vv" 'calc-reverse-vector) + (define-key calc-mode-map "vx" 'calc-index) + (define-key calc-mode-map "vA" 'calc-apply) + (define-key calc-mode-map "vC" 'calc-cross) + (define-key calc-mode-map "vD" 'calc-mdet) + (define-key calc-mode-map "vE" 'calc-set-enumerate) + (define-key calc-mode-map "vF" 'calc-set-floor) + (define-key calc-mode-map "vG" 'calc-grade) + (define-key calc-mode-map "vH" 'calc-histogram) + (define-key calc-mode-map "vI" 'calc-inner-product) + (define-key calc-mode-map "vJ" 'calc-conj-transpose) + (define-key calc-mode-map "vL" 'calc-mlud) + (define-key calc-mode-map "vM" 'calc-map) + (define-key calc-mode-map "vN" 'calc-cnorm) + (define-key calc-mode-map "vO" 'calc-outer-product) + (define-key calc-mode-map "vR" 'calc-reduce) + (define-key calc-mode-map "vS" 'calc-sort) + (define-key calc-mode-map "vT" 'calc-mtrace) + (define-key calc-mode-map "vU" 'calc-accumulate) + (define-key calc-mode-map "vV" 'calc-set-union) + (define-key calc-mode-map "vX" 'calc-set-xor) + (define-key calc-mode-map "v^" 'calc-set-intersect) + (define-key calc-mode-map "v-" 'calc-set-difference) + (define-key calc-mode-map "v~" 'calc-set-complement) + (define-key calc-mode-map "v:" 'calc-set-span) + (define-key calc-mode-map "v#" 'calc-set-cardinality) + (define-key calc-mode-map "v+" 'calc-remove-duplicates) + (define-key calc-mode-map "v&" 'calc-inv) + (define-key calc-mode-map "v<" 'calc-matrix-left-justify) + (define-key calc-mode-map "v=" 'calc-matrix-center-justify) + (define-key calc-mode-map "v>" 'calc-matrix-right-justify) + (define-key calc-mode-map "v." 'calc-full-vectors) + (define-key calc-mode-map "v/" 'calc-break-vectors) + (define-key calc-mode-map "v," 'calc-vector-commas) + (define-key calc-mode-map "v[" 'calc-vector-brackets) + (define-key calc-mode-map "v]" 'calc-matrix-brackets) + (define-key calc-mode-map "v{" 'calc-vector-braces) + (define-key calc-mode-map "v}" 'calc-matrix-brackets) + (define-key calc-mode-map "v(" 'calc-vector-parens) + (define-key calc-mode-map "v)" 'calc-matrix-brackets) + (define-key calc-mode-map "V" (lookup-key calc-mode-map "v")) + + (define-key calc-mode-map "z" 'nil) + (define-key calc-mode-map "z?" 'calc-z-prefix-help) + + (define-key calc-mode-map "Z" 'nil) + (define-key calc-mode-map "Z?" 'calc-shift-Z-prefix-help) + (define-key calc-mode-map "ZC" 'calc-user-define-composition) + (define-key calc-mode-map "ZD" 'calc-user-define) + (define-key calc-mode-map "ZE" 'calc-user-define-edit) + (define-key calc-mode-map "ZF" 'calc-user-define-formula) + (define-key calc-mode-map "ZG" 'calc-get-user-defn) + (define-key calc-mode-map "ZI" 'calc-user-define-invocation) + (define-key calc-mode-map "ZK" 'calc-user-define-kbd-macro) + (define-key calc-mode-map "ZP" 'calc-user-define-permanent) + (define-key calc-mode-map "ZS" 'calc-edit-user-syntax) + (define-key calc-mode-map "ZT" 'calc-timing) + (define-key calc-mode-map "ZU" 'calc-user-undefine) + (define-key calc-mode-map "Z[" 'calc-kbd-if) + (define-key calc-mode-map "Z:" 'calc-kbd-else) + (define-key calc-mode-map "Z|" 'calc-kbd-else-if) + (define-key calc-mode-map "Z]" 'calc-kbd-end-if) + (define-key calc-mode-map "Z<" 'calc-kbd-repeat) + (define-key calc-mode-map "Z>" 'calc-kbd-end-repeat) + (define-key calc-mode-map "Z(" 'calc-kbd-for) + (define-key calc-mode-map "Z)" 'calc-kbd-end-for) + (define-key calc-mode-map "Z{" 'calc-kbd-loop) + (define-key calc-mode-map "Z}" 'calc-kbd-end-loop) + (define-key calc-mode-map "Z/" 'calc-kbd-break) + (define-key calc-mode-map "Z`" 'calc-kbd-push) + (define-key calc-mode-map "Z'" 'calc-kbd-pop) + (define-key calc-mode-map "Z=" 'calc-kbd-report) + (define-key calc-mode-map "Z#" 'calc-kbd-query) + + (calc-init-prefixes) + + (mapcar (function + (lambda (x) + (define-key calc-mode-map (format "c%c" x) 'calc-clean-num) + (define-key calc-mode-map (format "j%c" x) 'calc-select-part) + (define-key calc-mode-map (format "r%c" x) 'calc-recall-quick) + (define-key calc-mode-map (format "s%c" x) 'calc-store-quick) + (define-key calc-mode-map (format "t%c" x) 'calc-store-into-quick) + (define-key calc-mode-map (format "u%c" x) 'calc-quick-units))) + "0123456789") + + (or calc-emacs-type-19 (progn + (let ((i ?A)) + (while (and (<= i ?z) (vectorp calc-mode-map)) + (if (eq (car-safe (aref calc-mode-map i)) 'keymap) + (aset calc-mode-map i + (cons 'keymap (cons (cons ?\e (aref calc-mode-map i)) + (cdr (aref calc-mode-map i)))))) + (setq i (1+ i)))) + + (setq calc-alg-map (copy-sequence calc-mode-map) + calc-alg-esc-map (copy-sequence esc-map)) + (let ((i 32)) + (while (< i 127) + (or (memq i '(?' ?` ?= ??)) + (aset calc-alg-map i 'calc-auto-algebraic-entry)) + (or (memq i '(?# ?x ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9)) + (aset calc-alg-esc-map i (aref calc-mode-map i))) + (setq i (1+ i)))) + (define-key calc-alg-map "\e" calc-alg-esc-map) + (define-key calc-alg-map "\e\t" 'calc-roll-up) + (define-key calc-alg-map "\e\C-m" 'calc-last-args-stub) + (define-key calc-alg-map "\e\177" 'calc-pop-above) + )) + + ;; The following is a relic for backward compatability only. + ;; The calc-define property list is now the recommended method. + (if (and (boundp 'calc-ext-defs) + calc-ext-defs) + (progn + (calc-need-macros) + (message "Evaluating calc-ext-defs...") + (eval (cons 'progn calc-ext-defs)) + (setq calc-ext-defs nil))) + +;;;; (Autoloads here) + (mapcar (function (lambda (x) + (mapcar (function (lambda (func) + (autoload func (car x)))) (cdr x)))) + '( + + ("calc-alg" calc-Need-calc-alg calc-has-rules +calc-modify-simplify-mode calcFunc-collect calcFunc-esimplify +calcFunc-islin calcFunc-islinnt calcFunc-lin calcFunc-linnt +calcFunc-simplify calcFunc-subst math-beforep +math-build-polynomial-expr math-expand-formula math-expr-contains +math-expr-contains-count math-expr-depends math-expr-height +math-expr-subst math-expr-weight math-integer-plus math-is-linear +math-is-multiple math-is-polynomial math-linear-in math-multiple-of +math-need-std-simps math-poly-depends math-poly-mix math-poly-mul +math-poly-simplify math-poly-zerop math-polynomial-base +math-polynomial-p math-recompile-eval-rules math-simplify +math-simplify-exp math-simplify-extended math-simplify-sqrt +math-to-simple-fraction) + + ("calc-alg-2" calc-Need-calc-alg-2 calcFunc-asum calcFunc-deriv +calcFunc-ffinv calcFunc-finv calcFunc-fsolve calcFunc-gpoly +calcFunc-integ calcFunc-poly calcFunc-prod calcFunc-roots +calcFunc-solve calcFunc-sum calcFunc-table calcFunc-taylor +calcFunc-tderiv math-expr-calls math-integral-q02 math-integral-q12 +math-integral-rational-funcs math-lcm-denoms math-looks-evenp +math-poly-all-roots math-prod-rec math-reject-solution math-solve-eqn +math-solve-for math-sum-rec math-try-integral) + + ("calc-alg-3" calc-Need-calc-alg-3 calcFunc-efit calcFunc-fit +calcFunc-fitdummy calcFunc-fitparam calcFunc-fitvar +calcFunc-hasfitparams calcFunc-hasfitvars calcFunc-maximize +calcFunc-minimize calcFunc-ninteg calcFunc-polint calcFunc-ratint +calcFunc-root calcFunc-wmaximize calcFunc-wminimize calcFunc-wroot +calcFunc-xfit math-find-minimum math-find-root math-ninteg-evaluate +math-ninteg-midpoint math-ninteg-romberg math-poly-interp) + + ("calc-arith" calc-Need-calc-arith calcFunc-abs calcFunc-abssqr +calcFunc-add calcFunc-ceil calcFunc-decr calcFunc-deven calcFunc-dimag +calcFunc-dint calcFunc-div calcFunc-dnatnum calcFunc-dneg +calcFunc-dnonneg calcFunc-dnonzero calcFunc-dnumint calcFunc-dodd +calcFunc-dpos calcFunc-drange calcFunc-drat calcFunc-dreal +calcFunc-dscalar calcFunc-fceil calcFunc-ffloor calcFunc-float +calcFunc-fround calcFunc-frounde calcFunc-froundu calcFunc-ftrunc +calcFunc-idiv calcFunc-incr calcFunc-mant calcFunc-max calcFunc-min +calcFunc-mod calcFunc-mul calcFunc-neg calcFunc-percent calcFunc-pow +calcFunc-relch calcFunc-round calcFunc-rounde calcFunc-roundu +calcFunc-scf calcFunc-sub calcFunc-xpon math-abs math-abs-approx +math-add-objects-fancy math-add-or-sub math-add-symb-fancy +math-ceiling math-combine-prod math-combine-sum math-div-by-zero +math-div-objects-fancy math-div-symb-fancy math-div-zero +math-float-fancy math-floor-fancy math-floor-special math-guess-if-neg +math-intv-constp math-known-evenp math-known-imagp math-known-integerp +math-known-matrixp math-known-negp math-known-nonnegp +math-known-nonposp math-known-nonzerop math-known-num-integerp +math-known-oddp math-known-posp math-known-realp math-known-scalarp +math-max math-min math-mod-fancy math-mul-float math-mul-objects-fancy +math-mul-or-div math-mul-symb-fancy math-mul-zero math-neg-fancy +math-neg-float math-okay-neg math-possible-signs math-possible-types +math-pow-fancy math-pow-mod math-pow-of-zero math-pow-zero +math-quarter-integer math-round math-setup-declarations math-sqr +math-sqr-float math-trunc-fancy math-trunc-special) + + ("calc-bin" calc-Need-calc-bin calcFunc-and calcFunc-ash +calcFunc-clip calcFunc-diff calcFunc-lsh calcFunc-not calcFunc-or +calcFunc-rash calcFunc-rot calcFunc-rsh calcFunc-xor math-clip +math-compute-max-digits math-convert-radix-digits math-float-parts +math-format-bignum-binary math-format-bignum-hex +math-format-bignum-octal math-format-bignum-radix math-format-binary +math-format-radix math-format-radix-float math-integer-log2 +math-power-of-2 math-radix-float-power) + + ("calc-comb" calc-Need-calc-comb calc-report-prime-test +calcFunc-choose calcFunc-dfact calcFunc-egcd calcFunc-fact +calcFunc-gcd calcFunc-lcm calcFunc-moebius calcFunc-nextprime +calcFunc-perm calcFunc-prevprime calcFunc-prfac calcFunc-prime +calcFunc-random calcFunc-shuffle calcFunc-stir1 calcFunc-stir2 +calcFunc-totient math-init-random-base math-member math-prime-test +math-random-base) + + ("calc-comp" calc-Need-calc-comp calcFunc-cascent calcFunc-cdescent +calcFunc-cheight calcFunc-cwidth math-comp-ascent math-comp-descent +math-comp-height math-comp-width math-compose-expr +math-composition-to-string math-stack-value-offset-fancy +math-vector-is-string math-vector-to-string) + + ("calc-cplx" calc-Need-calc-cplx calcFunc-arg calcFunc-conj +calcFunc-im calcFunc-polar calcFunc-re calcFunc-rect math-complex +math-fix-circular math-imaginary math-imaginary-i math-normalize-polar +math-polar math-want-polar) + + ("calc-embed" calc-Need-calc-embed calc-do-embedded +calc-do-embedded-activate calc-embedded-evaluate-expr +calc-embedded-modes-change calc-embedded-var-change) + + ("calc-fin" calc-Need-calc-fin calc-to-percentage calcFunc-ddb +calcFunc-fv calcFunc-fvb calcFunc-fvl calcFunc-irr calcFunc-irrb +calcFunc-nper calcFunc-nperb calcFunc-nperl calcFunc-npv calcFunc-npvb +calcFunc-pmt calcFunc-pmtb calcFunc-pv calcFunc-pvb calcFunc-pvl +calcFunc-rate calcFunc-rateb calcFunc-ratel calcFunc-sln calcFunc-syd) + + ("calc-forms" calc-Need-calc-forms calcFunc-badd calcFunc-bsub +calcFunc-date calcFunc-day calcFunc-dsadj calcFunc-hms +calcFunc-holiday calcFunc-hour calcFunc-incmonth calcFunc-incyear +calcFunc-intv calcFunc-julian calcFunc-makemod calcFunc-minute +calcFunc-month calcFunc-newmonth calcFunc-newweek calcFunc-newyear +calcFunc-now calcFunc-pwday calcFunc-sdev calcFunc-second +calcFunc-time calcFunc-tzconv calcFunc-tzone calcFunc-unixtime +calcFunc-weekday calcFunc-year calcFunc-yearday math-combine-intervals +math-date-parts math-date-to-dt math-div-mod math-dt-to-date +math-format-date math-from-business-day math-from-hms math-make-intv +math-make-mod math-make-sdev math-mod-intv math-normalize-hms +math-normalize-mod math-parse-date math-read-angle-brackets +math-setup-add-holidays math-setup-holidays math-setup-year-holidays +math-sort-intv math-to-business-day math-to-hms) + + ("calc-frac" calc-Need-calc-frac calc-add-fractions +calc-div-fractions calc-mul-fractions calcFunc-fdiv calcFunc-frac +math-make-frac) + + ("calc-funcs" calc-Need-calc-funcs calc-prob-dist calcFunc-bern +calcFunc-besJ calcFunc-besY calcFunc-beta calcFunc-betaB +calcFunc-betaI calcFunc-erf calcFunc-erfc calcFunc-euler +calcFunc-gamma calcFunc-gammaG calcFunc-gammaP calcFunc-gammaQ +calcFunc-gammag calcFunc-ltpb calcFunc-ltpc calcFunc-ltpf +calcFunc-ltpn calcFunc-ltpp calcFunc-ltpt calcFunc-utpb calcFunc-utpc +calcFunc-utpf calcFunc-utpn calcFunc-utpp calcFunc-utpt +math-bernoulli-number math-gammap1-raw) + + ("calc-graph" calc-Need-calc-graph calc-graph-show-tty) + + ("calc-help" calc-Need-calc-help) + + ("calc-incom" calc-Need-calc-incom calc-digit-dots) + + ("calc-keypd" calc-Need-calc-keypd calc-do-keypad +calc-keypad-x-left-click calc-keypad-x-middle-click +calc-keypad-x-right-click) + + ("calc-lang" calc-Need-calc-lang calc-set-language +math-read-big-balance math-read-big-rec) + + ("calc-map" calc-Need-calc-map calc-get-operator calcFunc-accum +calcFunc-afixp calcFunc-anest calcFunc-apply calcFunc-call +calcFunc-fixp calcFunc-inner calcFunc-map calcFunc-mapa calcFunc-mapc +calcFunc-mapd calcFunc-mapeq calcFunc-mapeqp calcFunc-mapeqr +calcFunc-mapr calcFunc-nest calcFunc-outer calcFunc-raccum +calcFunc-reduce calcFunc-reducea calcFunc-reducec calcFunc-reduced +calcFunc-reducer calcFunc-rreduce calcFunc-rreducea calcFunc-rreducec +calcFunc-rreduced calcFunc-rreducer math-build-call +math-calcFunc-to-var math-multi-subst math-multi-subst-rec +math-var-to-calcFunc) + + ("calc-mat" calc-Need-calc-mat calcFunc-det calcFunc-lud calcFunc-tr +math-col-matrix math-lud-solve math-matrix-inv-raw math-matrix-lud +math-mul-mat-vec math-mul-mats math-row-matrix) + + ("calc-math" calc-Need-calc-math calcFunc-alog calcFunc-arccos +calcFunc-arccosh calcFunc-arcsin calcFunc-arcsincos calcFunc-arcsinh +calcFunc-arctan calcFunc-arctan2 calcFunc-arctanh calcFunc-cos +calcFunc-cosh calcFunc-deg calcFunc-exp calcFunc-exp10 calcFunc-expm1 +calcFunc-hypot calcFunc-ilog calcFunc-isqrt calcFunc-ln calcFunc-lnp1 +calcFunc-log calcFunc-log10 calcFunc-nroot calcFunc-rad calcFunc-sin +calcFunc-sincos calcFunc-sinh calcFunc-sqr calcFunc-sqrt calcFunc-tan +calcFunc-tanh math-arccos-raw math-arcsin-raw math-arctan-raw +math-arctan2-raw math-cos-raw math-exp-minus-1-raw math-exp-raw +math-from-radians math-from-radians-2 math-hypot math-infinite-dir +math-isqrt-small math-ln-raw math-nearly-equal math-nearly-equal-float +math-nearly-zerop math-nearly-zerop-float math-nth-root +math-sin-cos-raw math-sin-raw math-sqrt math-sqrt-float math-sqrt-raw +math-tan-raw math-to-radians math-to-radians-2) + + ("calc-mode" calc-Need-calc-mode math-get-modes-vec) + + ("calc-poly" calc-Need-calc-poly calcFunc-apart calcFunc-expand +calcFunc-expandpow calcFunc-factor calcFunc-factors calcFunc-nrat +calcFunc-pcont calcFunc-pdeg calcFunc-pdiv calcFunc-pdivide +calcFunc-pdivrem calcFunc-pgcd calcFunc-plead calcFunc-pprim +calcFunc-prem math-accum-factors math-atomic-factorp +math-div-poly-const math-div-thru math-expand-power math-expand-term +math-factor-contains math-factor-expr math-factor-expr-part +math-factor-expr-try math-factor-finish math-factor-poly-coefs +math-factor-protect math-mul-thru math-padded-polynomial +math-partial-fractions math-poly-degree math-poly-deriv-coefs +math-poly-gcd-frac-list math-poly-modulus-rec math-ratpoly-p +math-to-ratpoly math-to-ratpoly-rec) + + ("calc-prog" calc-Need-calc-prog calc-default-formula-arglist +calc-execute-kbd-macro calc-finish-user-syntax-edit +calc-fix-token-name calc-fix-user-formula calc-read-parse-table +calc-read-parse-table-part calc-subsetp calc-write-parse-table +calc-write-parse-table-part calcFunc-constant calcFunc-eq calcFunc-geq +calcFunc-gt calcFunc-if calcFunc-in calcFunc-integer calcFunc-istrue +calcFunc-land calcFunc-leq calcFunc-lnot calcFunc-lor calcFunc-lt +calcFunc-negative calcFunc-neq calcFunc-nonvar calcFunc-real +calcFunc-refers calcFunc-rmeq calcFunc-typeof calcFunc-variable +math-body-refers-to math-break math-composite-inequalities +math-do-defmath math-handle-for math-handle-foreach +math-normalize-logical-op math-return) + + ("calc-rewr" calc-Need-calc-rewr calcFunc-match calcFunc-matches +calcFunc-matchnot calcFunc-rewrite calcFunc-vmatches +math-apply-rewrites math-compile-patterns math-compile-rewrites +math-flatten-lands math-match-patterns math-rewrite +math-rewrite-heads) + + ("calc-rules" calc-CommuteRules calc-DistribRules calc-FactorRules +calc-FitRules calc-IntegAfterRules calc-InvertRules calc-JumpRules +calc-MergeRules calc-Need-calc-rules calc-NegateRules +calc-compile-rule-set) + + ("calc-sel" calc-Need-calc-sel calc-auto-selection +calc-delete-selection calc-encase-atoms calc-find-assoc-parent-formula +calc-find-parent-formula calc-find-sub-formula calc-prepare-selection +calc-preserve-point calc-replace-selections calc-replace-sub-formula +calc-roll-down-with-selections calc-roll-up-with-selections +calc-sel-error) + + ("calc-sel-2" calc-Need-calc-sel-2) + + ("calc-stat" calc-Need-calc-stat calc-vector-op calcFunc-agmean +calcFunc-vcorr calcFunc-vcount calcFunc-vcov calcFunc-vflat +calcFunc-vgmean calcFunc-vhmean calcFunc-vmax calcFunc-vmean +calcFunc-vmeane calcFunc-vmedian calcFunc-vmin calcFunc-vpcov +calcFunc-vprod calcFunc-vpsdev calcFunc-vpvar calcFunc-vsdev +calcFunc-vsum calcFunc-vvar math-flatten-many-vecs) + + ("calc-store" calc-Need-calc-store calc-read-var-name +calc-store-value calc-var-name) + + ("calc-stuff" calc-Need-calc-stuff calc-explain-why calcFunc-clean +calcFunc-pclean calcFunc-pfloat calcFunc-pfrac) + + ("calc-trail" calc-Need-calc-trail) + + ("calc-undo" calc-Need-calc-undo) + + ("calc-units" calc-Need-calc-units calcFunc-usimplify +math-build-units-table math-build-units-table-buffer +math-check-unit-name math-convert-temperature math-convert-units +math-extract-units math-remove-units math-simplify-units +math-single-units-in-expr-p math-to-standard-units +math-units-in-expr-p) + + ("calc-vec" calc-Need-calc-vec calcFunc-append calcFunc-appendrev +calcFunc-arrange calcFunc-cnorm calcFunc-cons calcFunc-cross +calcFunc-ctrn calcFunc-cvec calcFunc-diag calcFunc-find +calcFunc-getdiag calcFunc-grade calcFunc-head calcFunc-histogram +calcFunc-idn calcFunc-index calcFunc-mcol calcFunc-mdims +calcFunc-mrcol calcFunc-mrow calcFunc-mrrow calcFunc-pack +calcFunc-rcons calcFunc-rdup calcFunc-rev calcFunc-rgrade +calcFunc-rhead calcFunc-rnorm calcFunc-rsort calcFunc-rsubvec +calcFunc-rtail calcFunc-sort calcFunc-subscr calcFunc-subvec +calcFunc-tail calcFunc-trn calcFunc-unpack calcFunc-unpackt +calcFunc-vcard calcFunc-vcompl calcFunc-vconcat calcFunc-vconcatrev +calcFunc-vdiff calcFunc-vec calcFunc-venum calcFunc-vexp +calcFunc-vfloor calcFunc-vint calcFunc-vlen calcFunc-vmask +calcFunc-vpack calcFunc-vspan calcFunc-vunion calcFunc-vunpack +calcFunc-vxor math-check-for-commas math-clean-set math-copy-matrix +math-dimension-error math-dot-product math-flatten-vector math-map-vec +math-map-vec-2 math-mat-col math-mimic-ident math-prepare-set +math-read-brackets math-reduce-cols math-reduce-vec math-transpose) + + ("calc-yank" calc-Need-calc-yank calc-alg-edit calc-clean-newlines +calc-do-grab-rectangle calc-do-grab-region calc-finish-stack-edit +calc-force-refresh calc-locate-cursor-element calc-show-edit-buffer) + +)) + + (mapcar (function (lambda (x) + (mapcar (function (lambda (cmd) + (autoload cmd (car x) nil t))) (cdr x)))) + '( + + ("calc-alg" calc-alg-evaluate calc-apart calc-collect calc-expand +calc-expand-formula calc-factor calc-normalize-rat calc-poly-div +calc-poly-div-rem calc-poly-gcd calc-poly-rem calc-simplify +calc-simplify-extended calc-substitute) + + ("calc-alg-2" calc-alt-summation calc-derivative +calc-dump-integral-cache calc-integral calc-num-integral +calc-poly-roots calc-product calc-solve-for calc-summation +calc-tabulate calc-taylor) + + ("calc-alg-3" calc-curve-fit calc-find-maximum calc-find-minimum +calc-find-root calc-poly-interp) + + ("calc-arith" calc-abs calc-abssqr calc-ceiling calc-decrement +calc-floor calc-idiv calc-increment calc-mant-part calc-max calc-min +calc-round calc-scale-float calc-sign calc-trunc calc-xpon-part) + + ("calc-bin" calc-and calc-binary-radix calc-clip calc-decimal-radix +calc-diff calc-hex-radix calc-leading-zeros calc-lshift-arith +calc-lshift-binary calc-not calc-octal-radix calc-or calc-radix +calc-rotate-binary calc-rshift-arith calc-rshift-binary calc-word-size +calc-xor) + + ("calc-comb" calc-choose calc-double-factorial calc-extended-gcd +calc-factorial calc-gamma calc-gcd calc-lcm calc-moebius +calc-next-prime calc-perm calc-prev-prime calc-prime-factors +calc-prime-test calc-random calc-random-again calc-rrandom +calc-shuffle calc-totient) + + ("calc-cplx" calc-argument calc-complex-notation calc-i-notation +calc-im calc-j-notation calc-polar calc-polar-mode calc-re) + + ("calc-embed" calc-embedded-copy-formula-as-kill +calc-embedded-duplicate calc-embedded-edit calc-embedded-forget +calc-embedded-kill-formula calc-embedded-mark-formula +calc-embedded-new-formula calc-embedded-next calc-embedded-previous +calc-embedded-select calc-embedded-update-formula calc-embedded-word +calc-find-globals calc-show-plain) + + ("calc-fin" calc-convert-percent calc-fin-ddb calc-fin-fv +calc-fin-irr calc-fin-nper calc-fin-npv calc-fin-pmt calc-fin-pv +calc-fin-rate calc-fin-sln calc-fin-syd calc-percent-change) + + ("calc-forms" calc-business-days-minus calc-business-days-plus +calc-convert-time-zones calc-date calc-date-notation calc-date-part +calc-from-hms calc-hms-mode calc-hms-notation calc-inc-month +calc-julian calc-new-month calc-new-week calc-new-year calc-now +calc-time calc-time-zone calc-to-hms calc-unix-time) + + ("calc-frac" calc-fdiv calc-frac-mode calc-fraction +calc-over-notation calc-slash-notation) + + ("calc-funcs" calc-bernoulli-number calc-bessel-J calc-bessel-Y +calc-beta calc-erf calc-erfc calc-euler-number calc-inc-beta +calc-inc-gamma calc-stirling-number calc-utpb calc-utpc calc-utpf +calc-utpn calc-utpp calc-utpt) + + ("calc-graph" calc-graph-add calc-graph-add-3d calc-graph-border +calc-graph-clear calc-graph-command calc-graph-delete +calc-graph-device calc-graph-display calc-graph-fast +calc-graph-fast-3d calc-graph-geometry calc-graph-grid +calc-graph-header calc-graph-hide calc-graph-juggle calc-graph-key +calc-graph-kill calc-graph-line-style calc-graph-log-x +calc-graph-log-y calc-graph-log-z calc-graph-name +calc-graph-num-points calc-graph-output calc-graph-plot +calc-graph-point-style calc-graph-print calc-graph-quit +calc-graph-range-x calc-graph-range-y calc-graph-range-z +calc-graph-show-dumb calc-graph-title-x calc-graph-title-y +calc-graph-title-z calc-graph-view-commands calc-graph-view-trail +calc-graph-zero-x calc-graph-zero-y) + + ("calc-help" calc-a-prefix-help calc-b-prefix-help calc-c-prefix-help +calc-d-prefix-help calc-describe-function calc-describe-key +calc-describe-key-briefly calc-describe-variable calc-f-prefix-help +calc-full-help calc-g-prefix-help calc-help-prefix +calc-hyperbolic-prefix-help calc-inv-hyp-prefix-help +calc-inverse-prefix-help calc-j-prefix-help calc-k-prefix-help +calc-m-prefix-help calc-r-prefix-help calc-s-prefix-help +calc-t-prefix-help calc-u-prefix-help calc-v-prefix-help) + + ("calc-incom" calc-begin-complex calc-begin-vector calc-comma +calc-dots calc-end-complex calc-end-vector calc-semi) + + ("calc-keypd" calc-keypad-menu calc-keypad-menu-back +calc-keypad-press) + + ("calc-lang" calc-big-language calc-c-language calc-eqn-language +calc-flat-language calc-fortran-language calc-maple-language +calc-mathematica-language calc-normal-language calc-pascal-language +calc-tex-language calc-unformatted-language) + + ("calc-map" calc-accumulate calc-apply calc-inner-product calc-map +calc-map-equation calc-map-stack calc-outer-product calc-reduce) + + ("calc-mat" calc-mdet calc-mlud calc-mtrace) + + ("calc-math" calc-arccos calc-arccosh calc-arcsin calc-arcsinh +calc-arctan calc-arctan2 calc-arctanh calc-conj calc-cos calc-cosh +calc-degrees-mode calc-exp calc-expm1 calc-hypot calc-ilog +calc-imaginary calc-isqrt calc-ln calc-lnp1 calc-log calc-log10 +calc-pi calc-radians-mode calc-sin calc-sincos calc-sinh calc-sqrt +calc-tan calc-tanh calc-to-degrees calc-to-radians) + + ("calc-mode" calc-alg-simplify-mode calc-algebraic-mode +calc-always-load-extensions calc-auto-recompute calc-auto-why +calc-bin-simplify-mode calc-break-vectors calc-center-justify +calc-default-simplify-mode calc-display-raw calc-eng-notation +calc-ext-simplify-mode calc-fix-notation calc-full-trail-vectors +calc-full-vectors calc-get-modes calc-group-char calc-group-digits +calc-infinite-mode calc-left-justify calc-left-label +calc-line-breaking calc-line-numbering calc-matrix-brackets +calc-matrix-center-justify calc-matrix-left-justify calc-matrix-mode +calc-matrix-right-justify calc-mode-record-mode calc-no-simplify-mode +calc-normal-notation calc-num-simplify-mode calc-point-char +calc-right-justify calc-right-label calc-save-modes calc-sci-notation +calc-settings-file-name calc-shift-prefix calc-symbolic-mode +calc-total-algebraic-mode calc-truncate-down calc-truncate-stack +calc-truncate-up calc-units-simplify-mode calc-vector-braces +calc-vector-brackets calc-vector-commas calc-vector-parens +calc-working) + + ("calc-prog" calc-call-last-kbd-macro calc-edit-user-syntax +calc-equal-to calc-get-user-defn calc-greater-equal calc-greater-than +calc-in-set calc-kbd-break calc-kbd-else calc-kbd-else-if +calc-kbd-end-for calc-kbd-end-if calc-kbd-end-loop calc-kbd-end-repeat +calc-kbd-for calc-kbd-if calc-kbd-loop calc-kbd-pop calc-kbd-push +calc-kbd-query calc-kbd-repeat calc-kbd-report calc-less-equal +calc-less-than calc-logical-and calc-logical-if calc-logical-not +calc-logical-or calc-not-equal-to calc-pass-errors calc-remove-equal +calc-timing calc-user-define calc-user-define-composition +calc-user-define-edit calc-user-define-formula +calc-user-define-invocation calc-user-define-kbd-macro +calc-user-define-permanent calc-user-undefine) + + ("calc-rewr" calc-match calc-rewrite calc-rewrite-selection) + + ("calc-sel" calc-break-selections calc-clear-selections +calc-copy-selection calc-del-selection calc-edit-selection +calc-enable-selections calc-enter-selection calc-sel-add-both-sides +calc-sel-div-both-sides calc-sel-evaluate calc-sel-expand-formula +calc-sel-mult-both-sides calc-sel-sub-both-sides +calc-select-additional calc-select-here calc-select-here-maybe +calc-select-less calc-select-more calc-select-next calc-select-once +calc-select-once-maybe calc-select-part calc-select-previous +calc-show-selections calc-unselect) + + ("calc-sel-2" calc-commute-left calc-commute-right calc-sel-commute +calc-sel-distribute calc-sel-invert calc-sel-isolate +calc-sel-jump-equals calc-sel-merge calc-sel-negate calc-sel-unpack) + + ("calc-stat" calc-vector-correlation calc-vector-count +calc-vector-covariance calc-vector-geometric-mean +calc-vector-harmonic-mean calc-vector-max calc-vector-mean +calc-vector-mean-error calc-vector-median calc-vector-min +calc-vector-pop-covariance calc-vector-pop-sdev +calc-vector-pop-variance calc-vector-product calc-vector-sdev +calc-vector-sum calc-vector-variance) + + ("calc-store" calc-assign calc-copy-variable calc-declare-variable +calc-edit-AlgSimpRules calc-edit-Decls calc-edit-EvalRules +calc-edit-ExtSimpRules calc-edit-FitRules calc-edit-GenCount +calc-edit-Holidays calc-edit-IntegLimit calc-edit-LineStyles +calc-edit-PlotRejects calc-edit-PointStyles calc-edit-TimeZone +calc-edit-Units calc-edit-variable calc-evalto calc-insert-variables +calc-let calc-permanent-variable calc-recall calc-recall-quick +calc-store calc-store-concat calc-store-decr calc-store-div +calc-store-exchange calc-store-incr calc-store-into +calc-store-into-quick calc-store-inv calc-store-map calc-store-minus +calc-store-neg calc-store-plus calc-store-power calc-store-quick +calc-store-times calc-subscript calc-unstore) + + ("calc-stuff" calc-clean calc-clean-num calc-flush-caches +calc-less-recursion-depth calc-more-recursion-depth calc-num-prefix +calc-version calc-why) + + ("calc-trail" calc-trail-backward calc-trail-first calc-trail-forward +calc-trail-in calc-trail-isearch-backward calc-trail-isearch-forward +calc-trail-kill calc-trail-last calc-trail-marker calc-trail-next +calc-trail-out calc-trail-previous calc-trail-scroll-left +calc-trail-scroll-right calc-trail-yank) + + ("calc-undo" calc-last-args calc-redo calc-undo) + + ("calc-units" calc-autorange-units calc-base-units +calc-convert-temperature calc-convert-units calc-define-unit +calc-enter-units-table calc-explain-units calc-extract-units +calc-get-unit-definition calc-permanent-units calc-quick-units +calc-remove-units calc-simplify-units calc-undefine-unit +calc-view-units-table) + + ("calc-vec" calc-arrange-vector calc-build-vector calc-cnorm +calc-conj-transpose calc-cons calc-cross calc-diag +calc-display-strings calc-expand-vector calc-grade calc-head +calc-histogram calc-ident calc-index calc-mask-vector calc-mcol +calc-mrow calc-pack calc-pack-bits calc-remove-duplicates +calc-reverse-vector calc-rnorm calc-set-cardinality +calc-set-complement calc-set-difference calc-set-enumerate +calc-set-floor calc-set-intersect calc-set-span calc-set-union +calc-set-xor calc-sort calc-subvector calc-tail calc-transpose +calc-unpack calc-unpack-bits calc-vector-find calc-vlength) + + ("calc-yank" calc-copy-as-kill calc-copy-region-as-kill +calc-copy-to-buffer calc-edit calc-edit-cancel calc-edit-mode +calc-kill calc-kill-region calc-yank) + +)) + +) + +(defun calc-init-prefixes () + (if calc-shift-prefix + (progn + (define-key calc-mode-map "A" (lookup-key calc-mode-map "a")) + (define-key calc-mode-map "B" (lookup-key calc-mode-map "b")) + (define-key calc-mode-map "C" (lookup-key calc-mode-map "c")) + (define-key calc-mode-map "D" (lookup-key calc-mode-map "d")) + (define-key calc-mode-map "F" (lookup-key calc-mode-map "f")) + (define-key calc-mode-map "G" (lookup-key calc-mode-map "g")) + (define-key calc-mode-map "J" (lookup-key calc-mode-map "j")) + (define-key calc-mode-map "K" (lookup-key calc-mode-map "k")) + (define-key calc-mode-map "M" (lookup-key calc-mode-map "m")) + (define-key calc-mode-map "S" (lookup-key calc-mode-map "s")) + (define-key calc-mode-map "T" (lookup-key calc-mode-map "t")) + (define-key calc-mode-map "U" (lookup-key calc-mode-map "u"))) + (define-key calc-mode-map "A" 'calc-abs) + (define-key calc-mode-map "B" 'calc-log) + (define-key calc-mode-map "C" 'calc-cos) + (define-key calc-mode-map "D" 'calc-redo) + (define-key calc-mode-map "F" 'calc-floor) + (define-key calc-mode-map "G" 'calc-argument) + (define-key calc-mode-map "J" 'calc-conj) + (define-key calc-mode-map "K" 'calc-keep-args) + (define-key calc-mode-map "M" 'calc-more-recursion-depth) + (define-key calc-mode-map "S" 'calc-sin) + (define-key calc-mode-map "T" 'calc-tan) + (define-key calc-mode-map "U" 'calc-undo)) +) + +(calc-init-extensions) + + + + +;;;; Miscellaneous. + +(defun calc-clear-command-flag (f) + (setq calc-command-flags (delq f calc-command-flags)) +) + + +(defun calc-record-message (tag &rest args) + (let ((msg (apply 'format args))) + (message "%s" msg) + (calc-record msg tag)) + (calc-clear-command-flag 'clear-message) +) + + +(defun calc-normalize-fancy (val) + (let ((simp (if (consp calc-simplify-mode) + (car calc-simplify-mode) + calc-simplify-mode))) + (cond ((eq simp 'binary) + (let ((s (math-normalize val))) + (if (math-realp s) + (math-clip (math-round s)) + s))) + ((eq simp 'alg) + (math-simplify val)) + ((eq simp 'ext) + (math-simplify-extended val)) + ((eq simp 'units) + (math-simplify-units val)) + (t ; nil, none, num + (math-normalize val)))) +) + + + +(if (boundp 'calc-help-map) + nil + (setq calc-help-map (make-keymap)) + (define-key calc-help-map "b" 'calc-describe-bindings) + (define-key calc-help-map "c" 'calc-describe-key-briefly) + (define-key calc-help-map "f" 'calc-describe-function) + (define-key calc-help-map "h" 'calc-full-help) + (define-key calc-help-map "i" 'calc-info) + (define-key calc-help-map "k" 'calc-describe-key) + (define-key calc-help-map "n" 'calc-view-news) + (define-key calc-help-map "s" 'calc-info-summary) + (define-key calc-help-map "t" 'calc-tutorial) + (define-key calc-help-map "v" 'calc-describe-variable) + (define-key calc-help-map "\C-c" 'calc-describe-copying) + (define-key calc-help-map "\C-d" 'calc-describe-distribution) + (define-key calc-help-map "\C-n" 'calc-view-news) + (define-key calc-help-map "\C-w" 'calc-describe-no-warranty) + (define-key calc-help-map "?" 'calc-help-for-help) + (define-key calc-help-map "\C-h" 'calc-help-for-help) +) + + +(defun calc-do-prefix-help (msgs group key) + (if calc-full-help-flag + (list msgs group key) + (if (cdr msgs) + (progn + (setq calc-prefix-help-phase + (if (eq this-command last-command) + (% (1+ calc-prefix-help-phase) (1+ (length msgs))) + 0)) + (let ((msg (nth calc-prefix-help-phase msgs))) + (message "%s" (if msg + (concat group ": " msg ":" + (make-string + (- (apply 'max (mapcar 'length msgs)) + (length msg)) 32) + " [MORE]" + (if key + (concat " " (char-to-string key) + "-") + "")) + (if key (format "%c-" key) ""))))) + (setq calc-prefix-help-phase 0) + (if key + (if msgs + (message "%s: %s: %c-" group (car msgs) key) + (message "%s: (none) %c-" group (car msgs) key)) + (message "%s: %s" group (car msgs)))) + (and key (calc-unread-command key))) +) +(defvar calc-prefix-help-phase 0) + + + + +;;;; Commands. + + +;;; General. + +(defun calc-reset (arg) + (interactive "P") + (save-excursion + (or (eq major-mode 'calc-mode) + (calc-create-buffer)) + (if calc-embedded-info + (calc-embedded nil)) + (or arg + (setq calc-stack nil)) + (setq calc-undo-list nil + calc-redo-list nil) + (let (calc-stack calc-user-parse-tables calc-standard-date-formats + calc-invocation-macro) + (mapcar (function (lambda (v) (set v nil))) calc-local-var-list) + (mapcar (function (lambda (v) (set (car v) (nth 1 v)))) + calc-mode-var-list)) + (calc-set-language nil nil t) + (calc-mode) + (let ((executing-kbd-macro "")) ; inhibit message + (calc-flush-caches)) + (run-hooks 'calc-reset-hook)) + (calc-wrapper + (let ((win (get-buffer-window (current-buffer)))) + (calc-realign 0) + (if win + (let ((height (- (window-height win) 2))) + (set-window-point win (point)) + (or (= height calc-window-height) + (let ((swin (selected-window))) + (select-window win) + (enlarge-window (- calc-window-height height)) + (select-window swin))))))) + (message "(Calculator reset)") +) + + +(defun calc-scroll-left (n) + (interactive "P") + (scroll-left (or n (/ (window-width) 2))) +) + +(defun calc-scroll-right (n) + (interactive "P") + (scroll-right (or n (/ (window-width) 2))) +) + +(defun calc-scroll-up (n) + (interactive "P") + (condition-case err + (scroll-up (or n (/ (window-height) 2))) + (error nil)) + (if (pos-visible-in-window-p (max 1 (- (point-max) 2))) + (if (eq major-mode 'calc-mode) + (calc-realign) + (goto-char (point-max)) + (set-window-start (selected-window) + (save-excursion + (forward-line (- (1- (window-height)))) + (point))) + (forward-line -1))) +) + +(defun calc-scroll-down (n) + (interactive "P") + (or (pos-visible-in-window-p 1) + (scroll-down (or n (/ (window-height) 2)))) +) + + +(defun calc-precision (n) + (interactive "NPrecision: ") + (calc-wrapper + (if (< (prefix-numeric-value n) 3) + (error "Precision must be at least 3 digits.") + (calc-change-mode 'calc-internal-prec (prefix-numeric-value n) + (and (memq (car calc-float-format) '(float sci eng)) + (< (nth 1 calc-float-format) + (if (= calc-number-radix 10) 0 1)))) + (calc-record calc-internal-prec "prec")) + (message "Floating-point precision is %d digits." calc-internal-prec)) +) + + +(defun calc-inverse (&optional n) + (interactive "P") + (calc-fancy-prefix 'calc-inverse-flag "Inverse..." n) +) + +(defun calc-fancy-prefix (flag msg n) + (let (prefix) + (calc-wrapper + (calc-set-command-flag 'keep-flags) + (calc-set-command-flag 'no-align) + (setq prefix (set flag (not (symbol-value flag))) + prefix-arg n) + (message (if prefix msg ""))) + (and prefix + nil ; Excise broken code we can live without. -- daveg 12/12/96 + (not calc-is-keypad-press) + (let ((event (calc-read-key t))) + (if (eq (setq last-command-char (car event)) ?\C-u) + (universal-argument) + (if (or (not (integerp last-command-char)) + (and (>= last-command-char 0) (< last-command-char ? ) + (not (memq last-command-char '(?\e))))) + (calc-wrapper)) ; clear flags if not a Calc command. + (if calc-emacs-type-19 + (setq last-command-event (cdr event))) + (if (or (not (integerp last-command-char)) + (eq last-command-char ?-)) + (calc-unread-command) + (digit-argument n)))))) +) +(setq calc-is-keypad-press nil) + +(defun calc-invert-func () + (save-excursion + (calc-select-buffer) + (setq calc-inverse-flag (not (calc-is-inverse)) + calc-hyperbolic-flag (calc-is-hyperbolic) + current-prefix-arg nil)) +) + +(defun calc-is-inverse () + calc-inverse-flag +) + +(defun calc-hyperbolic (&optional n) + (interactive "P") + (calc-fancy-prefix 'calc-hyperbolic-flag "Hyperbolic..." n) +) + +(defun calc-hyperbolic-func () + (save-excursion + (calc-select-buffer) + (setq calc-inverse-flag (calc-is-inverse) + calc-hyperbolic-flag (not (calc-is-hyperbolic)) + current-prefix-arg nil)) +) + +(defun calc-is-hyperbolic () + calc-hyperbolic-flag +) + +(defun calc-keep-args (&optional n) + (interactive "P") + (calc-fancy-prefix 'calc-keep-args-flag "Keep args..." n) +) + + +(defun calc-change-mode (var value &optional refresh option) + (if option + (setq value (if value + (> (prefix-numeric-value value) 0) + (not (symbol-value var))))) + (or (consp var) (setq var (list var) value (list value))) + (if calc-inverse-flag + (let ((old nil)) + (or refresh (error "Not a display-mode command")) + (calc-check-stack 1) + (unwind-protect + (let ((v var)) + (while v + (setq old (cons (symbol-value (car v)) old)) + (set (car v) (car value)) + (setq v (cdr v) + value (cdr value))) + (calc-refresh-top 1) + (calc-refresh-evaltos) + (symbol-value (car var))) + (let ((v var)) + (setq old (nreverse old)) + (while v + (set (car v) (car old)) + (setq v (cdr v) + old (cdr old))) + (if (eq (car var) 'calc-language) + (calc-set-language calc-language calc-language-option t))))) + (let ((chg nil) + (v var)) + (while v + (or (equal (symbol-value (car v)) (car value)) + (progn + (set (car v) (car value)) + (if (eq (car v) 'calc-float-format) + (setq calc-full-float-format + (list (if (eq (car (car value)) 'fix) + 'float + (car (car value))) + 0))) + (setq chg t))) + (setq v (cdr v) + value (cdr value))) + (if chg + (progn + (or (and refresh (calc-do-refresh)) + (calc-refresh-evaltos)) + (and (eq calc-mode-save-mode 'save) + (not (equal var '(calc-mode-save-mode))) + (calc-save-modes t)))) + (if calc-embedded-info (calc-embedded-modes-change var)) + (symbol-value (car var)))) +) + +(defun calc-refresh-top (n) + (interactive "p") + (calc-wrapper + (cond ((< n 0) + (setq n (- n)) + (let ((entry (calc-top n 'entry)) + (calc-undo-list nil) (calc-redo-list nil)) + (calc-pop-stack 1 n t) + (calc-push-list (list (car entry)) n (list (nth 2 entry))))) + ((= n 0) + (calc-refresh)) + (t + (let ((entries (calc-top-list n 1 'entry)) + (calc-undo-list nil) (calc-redo-list nil)) + (calc-pop-stack n 1 t) + (calc-push-list (mapcar 'car entries) + 1 + (mapcar (function (lambda (x) (nth 2 x))) + entries)))))) +) + +(defun calc-refresh-evaltos (&optional which-var) + (and calc-any-evaltos calc-auto-recompute (not calc-no-refresh-evaltos) + (let ((calc-refreshing-evaltos t) + (num (calc-stack-size)) + (calc-undo-list nil) (calc-redo-list nil) + value new-val) + (while (> num 0) + (setq value (calc-top num 'entry)) + (if (and (not (nth 2 value)) + (setq value (car value)) + (or (eq (car-safe value) 'calcFunc-evalto) + (and (eq (car-safe value) 'vec) + (eq (car-safe (nth 1 value)) 'calcFunc-evalto)))) + (progn + (setq new-val (math-normalize value)) + (or (equal new-val value) + (progn + (calc-push-list (list new-val) num) + (calc-pop-stack 1 (1+ num) t))))) + (setq num (1- num))))) + (and calc-embedded-active which-var + (calc-embedded-var-change which-var)) +) +(setq calc-refreshing-evaltos nil) +(setq calc-no-refresh-evaltos nil) + + +(defun calc-push (&rest vals) + (calc-push-list vals) +) + +(defun calc-pop-push (n &rest vals) + (calc-pop-push-list n vals) +) + +(defun calc-pop-push-record (n prefix &rest vals) + (calc-pop-push-record-list n prefix vals) +) + + +(defun calc-evaluate (n) + (interactive "p") + (calc-slow-wrapper + (if (= n 0) + (setq n (calc-stack-size))) + (calc-with-default-simplification + (if (< n 0) + (calc-pop-push-record-list 1 "eval" + (math-evaluate-expr (calc-top (- n))) + (- n)) + (calc-pop-push-record-list n "eval" (mapcar 'math-evaluate-expr + (calc-top-list n))))) + (calc-handle-whys)) +) + + +(defun calc-eval-num (n) + (interactive "P") + (calc-slow-wrapper + (let* ((nn (prefix-numeric-value n)) + (calc-internal-prec (cond ((>= nn 3) nn) + ((< nn 0) (max (+ calc-internal-prec nn) + 3)) + (t calc-internal-prec))) + (calc-symbolic-mode nil)) + (calc-with-default-simplification + (calc-pop-push-record 1 "num" (math-evaluate-expr (calc-top 1))))) + (calc-handle-whys)) +) + + +(defun calc-execute-extended-command (n) + (interactive "P") + (let* ((prompt (concat (calc-num-prefix-name n) "M-x ")) + (cmd (intern (completing-read prompt obarray 'commandp t "calc-")))) + (setq prefix-arg n) + (command-execute cmd)) +) + + +(defun calc-realign (&optional num) + (interactive "P") + (if (and num (eq major-mode 'calc-mode)) + (progn + (calc-check-stack num) + (calc-cursor-stack-index num) + (and calc-line-numbering + (forward-char 4))) + (if (and calc-embedded-info + (eq (current-buffer) (aref calc-embedded-info 0))) + (progn + (goto-char (aref calc-embedded-info 2)) + (if (save-excursion (set-buffer (aref calc-embedded-info 1)) + calc-show-plain) + (forward-line 1))) + (calc-wrapper + (if (get-buffer-window (current-buffer)) + (set-window-hscroll (get-buffer-window (current-buffer)) 0))))) +) + + + +(setq math-cache-list nil) + + + + +(defun calc-var-value (v) + (and (symbolp v) + (boundp v) + (symbol-value v) + (if (symbolp (symbol-value v)) + (set v (funcall (symbol-value v))) + (if (stringp (symbol-value v)) + (let ((val (math-read-expr (symbol-value v)))) + (if (eq (car-safe val) 'error) + (error "Bad format in variable contents: %s" (nth 2 val)) + (set v val))) + (symbol-value v)))) +) + + + + + +;;; In the following table, ( OP LOPS ROPS ) means that if an OP +;;; term appears as the first argument to any LOPS term, or as the +;;; second argument to any ROPS term, then they should be treated +;;; as one large term for purposes of associative selection. +(defconst calc-assoc-ops '( ( + ( + - ) ( + ) ) + ( - ( + - ) ( + ) ) + ( * ( * ) ( * ) ) + ( / ( / ) ( ) ) + ( | ( | ) ( | ) ) + ( calcFunc-land ( calcFunc-land ) + ( calcFunc-land ) ) + ( calcFunc-lor ( calcFunc-lor ) + ( calcFunc-lor ) ) )) + + +(defvar var-CommuteRules 'calc-CommuteRules) +(defvar var-JumpRules 'calc-JumpRules) +(defvar var-DistribRules 'calc-DistribRules) +(defvar var-MergeRules 'calc-MergeRules) +(defvar var-NegateRules 'calc-NegateRules) +(defvar var-InvertRules 'calc-InvertRules) + + +(defconst calc-tweak-eqn-table '( ( calcFunc-eq calcFunc-eq calcFunc-neq ) + ( calcFunc-neq calcFunc-neq calcFunc-eq ) + ( calcFunc-lt calcFunc-gt calcFunc-geq ) + ( calcFunc-gt calcFunc-lt calcFunc-leq ) + ( calcFunc-leq calcFunc-geq calcFunc-gt ) + ( calcFunc-geq calcFunc-leq calcFunc-lt ) )) + + + + +(defun calc-float (arg) + (interactive "P") + (calc-slow-wrapper + (calc-unary-op "flt" + (if (calc-is-hyperbolic) 'calcFunc-float 'calcFunc-pfloat) + arg)) +) + + +(defvar calc-gnuplot-process nil) + + +(defun calc-gnuplot-alive () + (and calc-gnuplot-process + calc-gnuplot-buffer + (buffer-name calc-gnuplot-buffer) + calc-gnuplot-input + (buffer-name calc-gnuplot-input) + (memq (process-status calc-gnuplot-process) '(run stop))) +) + + + + + +(defun calc-load-everything () + (interactive) + (calc-need-macros) ; calc-macs.el + (calc-record-list nil) ; calc-misc.el + (math-read-exprs "0") ; calc-aent.el + +;;;; (Loads here) + (calc-Need-calc-alg-2) + (calc-Need-calc-alg-3) + (calc-Need-calc-alg) + (calc-Need-calc-arith) + (calc-Need-calc-bin) + (calc-Need-calc-comb) + (calc-Need-calc-comp) + (calc-Need-calc-cplx) + (calc-Need-calc-embed) + (calc-Need-calc-fin) + (calc-Need-calc-forms) + (calc-Need-calc-frac) + (calc-Need-calc-funcs) + (calc-Need-calc-graph) + (calc-Need-calc-help) + (calc-Need-calc-incom) + (calc-Need-calc-keypd) + (calc-Need-calc-lang) + (calc-Need-calc-map) + (calc-Need-calc-mat) + (calc-Need-calc-math) + (calc-Need-calc-mode) + (calc-Need-calc-poly) + (calc-Need-calc-prog) + (calc-Need-calc-rewr) + (calc-Need-calc-rules) + (calc-Need-calc-sel-2) + (calc-Need-calc-sel) + (calc-Need-calc-stat) + (calc-Need-calc-store) + (calc-Need-calc-stuff) + (calc-Need-calc-trail) + (calc-Need-calc-undo) + (calc-Need-calc-units) + (calc-Need-calc-vec) + (calc-Need-calc-yank) + + (message "All parts of Calc are now loaded.") +) + + +;;; Vector commands. + +(defun calc-concat (arg) + (interactive "P") + (calc-wrapper + (if (calc-is-inverse) + (if (calc-is-hyperbolic) + (calc-enter-result 2 "apnd" (list 'calcFunc-append + (calc-top 1) (calc-top 2))) + (calc-enter-result 2 "|" (list 'calcFunc-vconcat + (calc-top 1) (calc-top 2)))) + (if (calc-is-hyperbolic) + (calc-binary-op "apnd" 'calcFunc-append arg '(vec)) + (calc-binary-op "|" 'calcFunc-vconcat arg '(vec) nil '|)))) +) + +(defun calc-append (arg) + (interactive "P") + (calc-hyperbolic-func) + (calc-concat arg) +) + + +(defconst calc-arg-values '( ( var ArgA var-ArgA ) ( var ArgB var-ArgB ) + ( var ArgC var-ArgC ) ( var ArgD var-ArgD ) + ( var ArgE var-ArgE ) ( var ArgF var-ArgF ) + ( var ArgG var-ArgG ) ( var ArgH var-ArgH ) + ( var ArgI var-ArgI ) ( var ArgJ var-ArgJ ) +)) + +(defun calc-invent-args (n) + (nreverse (nthcdr (- (length calc-arg-values) n) (reverse calc-arg-values))) +) + + + + +;;; User menu. + +(defun calc-user-key-map () + (if calc-emacs-type-lucid + (error "User-defined keys are not supported in Lucid Emacs")) + (let ((res (cdr (lookup-key calc-mode-map "z")))) + (if (eq (car (car res)) 27) + (cdr res) + res)) +) + +(defun calc-z-prefix-help () + (interactive) + (let* ((msgs nil) + (buf "") + (kmap (sort (copy-sequence (calc-user-key-map)) + (function (lambda (x y) (< (car x) (car y)))))) + (flags (apply 'logior + (mapcar (function + (lambda (k) + (calc-user-function-classify (car k)))) + kmap)))) + (if (= (logand flags 8) 0) + (calc-user-function-list kmap 7) + (calc-user-function-list kmap 1) + (setq msgs (cons buf msgs) + buf "") + (calc-user-function-list kmap 6)) + (if (/= flags 0) + (setq msgs (cons buf msgs))) + (calc-do-prefix-help (nreverse msgs) "user" ?z)) +) + +(defun calc-user-function-classify (key) + (cond ((/= key (downcase key)) ; upper-case + (if (assq (downcase key) (calc-user-key-map)) 9 1)) + ((/= key (upcase key)) 2) ; lower-case + ((= key ??) 0) + (t 4)) ; other +) + +(defun calc-user-function-list (map flags) + (and map + (let* ((key (car (car map))) + (kind (calc-user-function-classify key)) + (func (cdr (car map)))) + (if (or (= (logand kind flags) 0) + (not (symbolp func))) + () + (let* ((name (symbol-name func)) + (name (if (string-match "\\`calc-" name) + (substring name 5) name)) + (pos (string-match (char-to-string key) name)) + (desc + (if (symbolp func) + (if (= (logand kind 3) 0) + (format "`%c' = %s" key name) + (if pos + (format "%s%c%s" + (downcase (substring name 0 pos)) + (upcase key) + (downcase (substring name (1+ pos)))) + (format "%c = %s" + (upcase key) + (downcase name)))) + (char-to-string (upcase key))))) + (if (= (length buf) 0) + (setq buf (concat (if (= flags 1) "SHIFT + " "") + desc)) + (if (> (+ (length buf) (length desc)) 58) + (setq msgs (cons buf msgs) + buf (concat (if (= flags 1) "SHIFT + " "") + desc)) + (setq buf (concat buf ", " desc)))))) + (calc-user-function-list (cdr map) flags))) +) + + + +(defun calc-shift-Z-prefix-help () + (interactive) + (calc-do-prefix-help + '("Define, Undefine, Formula, Kbd-macro, Edit, Get-defn" + "Composition, Syntax; Invocation; Permanent; Timing" + "kbd-macros: [ (if), : (else), | (else-if), ] (end-if)" + "kbd-macros: < > (repeat), ( ) (for), { } (loop)" + "kbd-macros: / (break)" + "kbd-macros: ` (save), ' (restore)") + "user" ?Z) +) + + +;;;; Caches. + +(defmacro math-defcache (name init form) + (let ((cache-prec (intern (concat (symbol-name name) "-cache-prec"))) + (cache-val (intern (concat (symbol-name name) "-cache"))) + (last-prec (intern (concat (symbol-name name) "-last-prec"))) + (last-val (intern (concat (symbol-name name) "-last")))) + (list 'progn + (list 'setq cache-prec (if init (math-numdigs (nth 1 init)) -100)) + (list 'setq cache-val (list 'quote init)) + (list 'setq last-prec -100) + (list 'setq last-val nil) + (list 'setq 'math-cache-list + (list 'cons + (list 'quote cache-prec) + (list 'cons + (list 'quote last-prec) + 'math-cache-list))) + (list 'defun + name () + (list 'or + (list '= last-prec 'calc-internal-prec) + (list 'setq + last-val + (list 'math-normalize + (list 'progn + (list 'or + (list '>= cache-prec + 'calc-internal-prec) + (list 'setq + cache-val + (list 'let + '((calc-internal-prec + (+ calc-internal-prec + 4))) + form) + cache-prec + '(+ calc-internal-prec 2))) + cache-val)) + last-prec 'calc-internal-prec)) + last-val))) +) +(put 'math-defcache 'lisp-indent-hook 2) + +;;; Betcha didn't know that pi = 16 atan(1/5) - 4 atan(1/239). [F] [Public] +(math-defcache math-pi (float (bigpos 463 238 793 589 653 592 141 3) -21) + (math-add-float (math-mul-float '(float 16 0) + (math-arctan-raw '(float 2 -1))) + (math-mul-float '(float -4 0) + (math-arctan-raw + (math-float '(frac 1 239)))))) + +(math-defcache math-two-pi nil + (math-mul-float (math-pi) '(float 2 0))) + +(math-defcache math-pi-over-2 nil + (math-mul-float (math-pi) '(float 5 -1))) + +(math-defcache math-pi-over-4 nil + (math-mul-float (math-pi) '(float 25 -2))) + +(math-defcache math-pi-over-180 nil + (math-div-float (math-pi) '(float 18 1))) + +(math-defcache math-sqrt-pi nil + (math-sqrt-float (math-pi))) + +(math-defcache math-sqrt-2 nil + (math-sqrt-float '(float 2 0))) + +(math-defcache math-sqrt-12 nil + (math-sqrt-float '(float 12 0))) + +(math-defcache math-sqrt-two-pi nil + (math-sqrt-float (math-two-pi))) + +(math-defcache math-sqrt-e (float (bigpos 849 146 128 700 270 721 648 1) -21) + (math-add-float '(float 1 0) (math-exp-minus-1-raw '(float 5 -1)))) + +(math-defcache math-e nil + (math-pow (math-sqrt-e) 2)) + +(math-defcache math-phi nil + (math-mul-float (math-add-float (math-sqrt-raw '(float 5 0)) '(float 1 0)) + '(float 5 -1))) + +(math-defcache math-gamma-const nil + '(float (bigpos 495 467 917 632 470 369 709 646 776 267 677 848 348 672 + 057 988 235 399 359 593 421 310 024 824 900 120 065 606 + 328 015 649 156 772 5) -100)) + +(defun math-half-circle (symb) + (if (eq calc-angle-mode 'rad) + (if symb + '(var pi var-pi) + (math-pi)) + 180) +) + +(defun math-full-circle (symb) + (math-mul 2 (math-half-circle symb)) +) + +(defun math-quarter-circle (symb) + (math-div (math-half-circle symb) 2) +) + + + + +;;;; Miscellaneous math routines. + +;;; True if A is an odd integer. [P R R] [Public] +(defun math-oddp (a) + (if (consp a) + (and (memq (car a) '(bigpos bigneg)) + (= (% (nth 1 a) 2) 1)) + (/= (% a 2) 0)) +) + +;;; True if A is a small or big integer. [P x] [Public] +(defun math-integerp (a) + (or (integerp a) + (memq (car-safe a) '(bigpos bigneg))) +) + +;;; True if A is (numerically) a non-negative integer. [P N] [Public] +(defun math-natnump (a) + (or (natnump a) + (eq (car-safe a) 'bigpos)) +) + +;;; True if A is a rational (or integer). [P x] [Public] +(defun math-ratp (a) + (or (integerp a) + (memq (car-safe a) '(bigpos bigneg frac))) +) + +;;; True if A is a real (or rational). [P x] [Public] +(defun math-realp (a) + (or (integerp a) + (memq (car-safe a) '(bigpos bigneg frac float))) +) + +;;; True if A is a real or HMS form. [P x] [Public] +(defun math-anglep (a) + (or (integerp a) + (memq (car-safe a) '(bigpos bigneg frac float hms))) +) + +;;; True if A is a number of any kind. [P x] [Public] +(defun math-numberp (a) + (or (integerp a) + (memq (car-safe a) '(bigpos bigneg frac float cplx polar))) +) + +;;; True if A is a complex number or angle. [P x] [Public] +(defun math-scalarp (a) + (or (integerp a) + (memq (car-safe a) '(bigpos bigneg frac float cplx polar hms))) +) + +;;; True if A is a vector. [P x] [Public] +(defun math-vectorp (a) + (eq (car-safe a) 'vec) +) + +;;; True if A is any vector or scalar data object. [P x] +(defun math-objvecp (a) ; [Public] + (or (integerp a) + (memq (car-safe a) '(bigpos bigneg frac float cplx polar + hms date sdev intv mod vec incomplete))) +) + +;;; True if A is an object not composed of sub-formulas . [P x] [Public] +(defun math-primp (a) + (or (integerp a) + (memq (car-safe a) '(bigpos bigneg frac float cplx polar + hms date mod var))) +) + +;;; True if A is numerically (but not literally) an integer. [P x] [Public] +(defun math-messy-integerp (a) + (cond + ((eq (car-safe a) 'float) (>= (nth 2 a) 0)) + ((eq (car-safe a) 'frac) (Math-integerp (math-normalize a)))) +) + +;;; True if A is numerically an integer. [P x] [Public] +(defun math-num-integerp (a) + (or (Math-integerp a) + (Math-messy-integerp a)) +) + +;;; True if A is (numerically) a non-negative integer. [P N] [Public] +(defun math-num-natnump (a) + (or (natnump a) + (eq (car-safe a) 'bigpos) + (and (eq (car-safe a) 'float) + (Math-natnump (nth 1 a)) + (>= (nth 2 a) 0))) +) + +;;; True if A is an integer or will evaluate to an integer. [P x] [Public] +(defun math-provably-integerp (a) + (or (Math-integerp a) + (and (memq (car-safe a) '(calcFunc-trunc + calcFunc-round + calcFunc-rounde + calcFunc-roundu + calcFunc-floor + calcFunc-ceil)) + (= (length a) 2))) +) + +;;; 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) + (memq (car-safe a) '(abs arg))) +) + +;;; True if A is a non-real, complex number. [P x] [Public] +(defun math-complexp (a) + (memq (car-safe a) '(cplx polar)) +) + +;;; True if A is a non-real, rectangular complex number. [P x] [Public] +(defun math-rect-complexp (a) + (eq (car-safe a) 'cplx) +) + +;;; True if A is a non-real, polar complex number. [P x] [Public] +(defun math-polar-complexp (a) + (eq (car-safe a) 'polar) +) + +;;; True if A is a matrix. [P x] [Public] +(defun math-matrixp (a) + (and (Math-vectorp a) + (Math-vectorp (nth 1 a)) + (cdr (nth 1 a)) + (let ((len (length (nth 1 a)))) + (setq a (cdr a)) + (while (and (setq a (cdr a)) + (Math-vectorp (car a)) + (= (length (car a)) len))) + (null a))) +) + +(defun math-matrixp-step (a len) ; [P L] + (or (null a) + (and (Math-vectorp (car a)) + (= (length (car a)) len) + (math-matrixp-step (cdr a) len))) +) + +;;; True if A is a square matrix. [P V] [Public] +(defun math-square-matrixp (a) + (let ((dims (math-mat-dimens a))) + (and (cdr dims) + (= (car dims) (nth 1 dims)))) +) + +;;; True if A is any scalar data object. [P x] +(defun math-objectp (a) ; [Public] + (or (integerp a) + (memq (car-safe a) '(bigpos bigneg frac float cplx + polar hms date sdev intv mod))) +) + +;;; Verify that A is an integer and return A in integer form. [I N; - x] +(defun math-check-integer (a) ; [Public] + (cond ((integerp a) a) ; for speed + ((math-integerp a) a) + ((math-messy-integerp a) + (math-trunc a)) + (t (math-reject-arg a 'integerp))) +) + +;;; Verify that A is a small integer and return A in integer form. [S N; - x] +(defun math-check-fixnum (a &optional allow-inf) ; [Public] + (cond ((integerp a) a) ; for speed + ((Math-num-integerp a) + (let ((a (math-trunc a))) + (if (integerp a) + a + (if (or (Math-lessp (lsh -1 -1) a) + (Math-lessp a (- (lsh -1 -1)))) + (math-reject-arg a 'fixnump) + (math-fixnum a))))) + ((and allow-inf (equal a '(var inf var-inf))) + (lsh -1 -1)) + ((and allow-inf (equal a '(neg (var inf var-inf)))) + (- (lsh -1 -1))) + (t (math-reject-arg a 'fixnump))) +) + +;;; Verify that A is an integer >= 0 and return A in integer form. [I N; - x] +(defun math-check-natnum (a) ; [Public] + (cond ((natnump a) a) + ((and (not (math-negp a)) + (Math-num-integerp a)) + (math-trunc a)) + (t (math-reject-arg a 'natnump))) +) + +;;; Verify that A is in floating-point form, or force it to be a float. [F N] +(defun math-check-float (a) ; [Public] + (cond ((eq (car-safe a) 'float) a) + ((Math-vectorp a) (math-map-vec 'math-check-float a)) + ((Math-objectp a) (math-float a)) + (t a)) +) + +;;; Verify that A is a constant. +(defun math-check-const (a &optional exp-ok) + (if (or (math-constp a) + (and exp-ok math-expand-formulas)) + a + (math-reject-arg a 'constp)) +) + + +;;; Coerce integer A to be a small integer. [S I] +(defun math-fixnum (a) + (if (consp a) + (if (cdr a) + (if (eq (car a) 'bigneg) + (- (math-fixnum-big (cdr a))) + (math-fixnum-big (cdr a))) + 0) + a) +) + +(defun math-fixnum-big (a) + (if (cdr a) + (+ (car a) (* (math-fixnum-big (cdr a)) 1000)) + (car a)) +) + + +(defun math-normalize-fancy (a) + (cond ((eq (car a) 'frac) + (math-make-frac (math-normalize (nth 1 a)) + (math-normalize (nth 2 a)))) + ((eq (car a) 'cplx) + (let ((real (math-normalize (nth 1 a))) + (imag (math-normalize (nth 2 a)))) + (if (and (math-zerop imag) + (not math-simplify-only)) ; oh, what a kludge! + real + (list 'cplx real imag)))) + ((eq (car a) 'polar) + (math-normalize-polar a)) + ((eq (car a) 'hms) + (math-normalize-hms a)) + ((eq (car a) 'date) + (list 'date (math-normalize (nth 1 a)))) + ((eq (car a) 'mod) + (math-normalize-mod a)) + ((eq (car a) 'sdev) + (let ((x (math-normalize (nth 1 a))) + (s (math-normalize (nth 2 a)))) + (if (or (and (Math-objectp x) (not (Math-scalarp x))) + (and (Math-objectp s) (not (Math-scalarp s)))) + (list 'calcFunc-sdev x s) + (math-make-sdev x s)))) + ((eq (car a) 'intv) + (let ((mask (math-normalize (nth 1 a))) + (lo (math-normalize (nth 2 a))) + (hi (math-normalize (nth 3 a)))) + (if (if (eq (car-safe lo) 'date) + (not (eq (car-safe hi) 'date)) + (or (and (Math-objectp lo) (not (Math-anglep lo))) + (and (Math-objectp hi) (not (Math-anglep hi))))) + (list 'calcFunc-intv mask lo hi) + (math-make-intv mask lo hi)))) + ((eq (car a) 'vec) + (cons 'vec (mapcar 'math-normalize (cdr a)))) + ((eq (car a) 'quote) + (math-normalize (nth 1 a))) + ((eq (car a) 'special-const) + (calc-with-default-simplification + (math-normalize (nth 1 a)))) + ((eq (car a) 'var) + (cons 'var (cdr a))) ; need to re-cons for selection routines + ((eq (car a) 'calcFunc-if) + (math-normalize-logical-op a)) + ((memq (car a) '(calcFunc-lambda calcFunc-quote calcFunc-condition)) + (let ((calc-simplify-mode 'none)) + (cons (car a) (mapcar 'math-normalize (cdr a))))) + ((eq (car a) 'calcFunc-evalto) + (setq a (or (nth 1 a) 0)) + (or calc-refreshing-evaltos + (setq a (let ((calc-simplify-mode 'none)) (math-normalize a)))) + (let ((b (if (and (eq (car-safe a) 'calcFunc-assign) + (= (length a) 3)) + (nth 2 a) + a))) + (list 'calcFunc-evalto + a + (if (eq calc-simplify-mode 'none) + (math-normalize b) + (calc-with-default-simplification + (math-evaluate-expr b)))))) + ((or (integerp (car a)) (consp (car a))) + (if (null (cdr a)) + (math-normalize (car a)) + (error "Can't use multi-valued function in an expression")))) +) + +(defun math-normalize-nonstandard () ; uses "a" + (if (consp calc-simplify-mode) + (progn + (setq calc-simplify-mode 'none + math-simplify-only (car-safe (cdr-safe a))) + nil) + (and (symbolp (car a)) + (or (eq calc-simplify-mode 'none) + (and (eq calc-simplify-mode 'num) + (let ((aptr (setq a (cons + (car a) + (mapcar 'math-normalize (cdr a)))))) + (while (and aptr (math-constp (car aptr))) + (setq aptr (cdr aptr))) + aptr))) + (cons (car a) (mapcar 'math-normalize (cdr a))))) +) + + + +(setq math-expand-formulas nil) + + +;;; Normalize a bignum digit list by trimming high-end zeros. [L l] +(defun math-norm-bignum (a) + (let ((digs a) (last nil)) + (while digs + (or (eq (car digs) 0) (setq last digs)) + (setq digs (cdr digs))) + (and last + (progn + (setcdr last nil) + a))) +) + +(defun math-bignum-test (a) ; [B N; B s; b b] + (if (consp a) + a + (math-bignum a)) +) + + +;;; Return 0 for zero, -1 for negative, 1 for positive. [S n] [Public] +(defun calcFunc-sign (a &optional x) + (let ((signs (math-possible-signs a))) + (cond ((eq signs 4) (or x 1)) + ((eq signs 2) 0) + ((eq signs 1) (if x (math-neg x) -1)) + ((math-looks-negp a) (math-neg (calcFunc-sign (math-neg a)))) + (t (calc-record-why 'realp a) + (if x + (list 'calcFunc-sign a x) + (list 'calcFunc-sign a))))) +) + +;;; Return 0 if A is numerically equal to B, <0 if less, >0 if more. +;;; Arguments must be normalized! [S N N] +(defun math-compare (a b) + (cond ((equal a b) + (if (and (consp a) + (memq (car a) '(var neg * /)) + (math-infinitep a)) + 2 + 0)) + ((and (integerp a) (Math-integerp b)) + (if (consp b) + (if (eq (car b) 'bigpos) -1 1) + (if (< a b) -1 1))) + ((and (eq (car-safe a) 'bigpos) (Math-integerp b)) + (if (eq (car-safe b) 'bigpos) + (math-compare-bignum (cdr a) (cdr b)) + 1)) + ((and (eq (car-safe a) 'bigneg) (Math-integerp b)) + (if (eq (car-safe b) 'bigneg) + (math-compare-bignum (cdr b) (cdr a)) + -1)) + ((eq (car-safe a) 'frac) + (if (eq (car-safe b) 'frac) + (math-compare (math-mul (nth 1 a) (nth 2 b)) + (math-mul (nth 1 b) (nth 2 a))) + (math-compare (nth 1 a) (math-mul b (nth 2 a))))) + ((eq (car-safe b) 'frac) + (math-compare (math-mul a (nth 2 b)) (nth 1 b))) + ((and (eq (car-safe a) 'float) (eq (car-safe b) 'float)) + (if (math-lessp-float a b) -1 1)) + ((and (eq (car-safe a) 'date) (eq (car-safe b) 'date)) + (math-compare (nth 1 a) (nth 1 b))) + ((and (or (Math-anglep a) + (and (eq (car a) 'cplx) (eq (nth 2 a) 0))) + (or (Math-anglep b) + (and (eq (car b) 'cplx) (eq (nth 2 b) 0)))) + (calcFunc-sign (math-add a (math-neg b)))) + ((and (eq (car-safe a) 'intv) + (or (Math-anglep b) (eq (car-safe b) 'date))) + (let ((res (math-compare (nth 2 a) b))) + (cond ((eq res 1) 1) + ((and (eq res 0) (memq (nth 1 a) '(0 1))) 1) + ((eq (setq res (math-compare (nth 3 a) b)) -1) -1) + ((and (eq res 0) (memq (nth 1 a) '(0 2))) -1) + (t 2)))) + ((and (eq (car-safe b) 'intv) + (or (Math-anglep a) (eq (car-safe a) 'date))) + (let ((res (math-compare a (nth 2 b)))) + (cond ((eq res -1) -1) + ((and (eq res 0) (memq (nth 1 b) '(0 1))) -1) + ((eq (setq res (math-compare a (nth 3 b))) 1) 1) + ((and (eq res 0) (memq (nth 1 b) '(0 2))) 1) + (t 2)))) + ((and (eq (car-safe a) 'intv) (eq (car-safe b) 'intv)) + (let ((res (math-compare (nth 3 a) (nth 2 b)))) + (cond ((eq res -1) -1) + ((and (eq res 0) (or (memq (nth 1 a) '(0 2)) + (memq (nth 1 b) '(0 1)))) -1) + ((eq (setq res (math-compare (nth 2 a) (nth 3 b))) 1) 1) + ((and (eq res 0) (or (memq (nth 1 a) '(0 1)) + (memq (nth 1 b) '(0 2)))) 1) + (t 2)))) + ((math-infinitep a) + (if (or (equal a '(var uinf var-uinf)) + (equal a '(var nan var-nan))) + 2 + (let ((dira (math-infinite-dir a))) + (if (math-infinitep b) + (if (or (equal b '(var uinf var-uinf)) + (equal b '(var nan var-nan))) + 2 + (let ((dirb (math-infinite-dir b))) + (cond ((and (eq dira 1) (eq dirb -1)) 1) + ((and (eq dira -1) (eq dirb 1)) -1) + (t 2)))) + (cond ((eq dira 1) 1) + ((eq dira -1) -1) + (t 2)))))) + ((math-infinitep b) + (if (or (equal b '(var uinf var-uinf)) + (equal b '(var nan var-nan))) + 2 + (let ((dirb (math-infinite-dir b))) + (cond ((eq dirb 1) -1) + ((eq dirb -1) 1) + (t 2))))) + ((and (eq (car-safe a) 'calcFunc-exp) + (eq (car-safe b) '^) + (equal (nth 1 b) '(var e var-e))) + (math-compare (nth 1 a) (nth 2 b))) + ((and (eq (car-safe b) 'calcFunc-exp) + (eq (car-safe a) '^) + (equal (nth 1 a) '(var e var-e))) + (math-compare (nth 2 a) (nth 1 b))) + ((or (and (eq (car-safe a) 'calcFunc-sqrt) + (eq (car-safe b) '^) + (or (equal (nth 2 b) '(frac 1 2)) + (equal (nth 2 b) '(float 5 -1)))) + (and (eq (car-safe b) 'calcFunc-sqrt) + (eq (car-safe a) '^) + (or (equal (nth 2 a) '(frac 1 2)) + (equal (nth 2 a) '(float 5 -1))))) + (math-compare (nth 1 a) (nth 1 b))) + ((eq (car-safe a) 'var) + 2) + (t + (if (and (consp a) (consp b) + (eq (car a) (car b)) + (math-compare-lists (cdr a) (cdr b))) + 0 + 2))) +) + +;;; Compare two bignum digit lists, return -1 for A<B, 0 for A=B, 1 for A>B. +(defun math-compare-bignum (a b) ; [S l l] + (let ((res 0)) + (while (and a b) + (if (< (car a) (car b)) + (setq res -1) + (if (> (car a) (car b)) + (setq res 1))) + (setq a (cdr a) + b (cdr b))) + (if a + (progn + (while (eq (car a) 0) (setq a (cdr a))) + (if a 1 res)) + (while (eq (car b) 0) (setq b (cdr b))) + (if b -1 res))) +) + +(defun math-compare-lists (a b) + (cond ((null a) (null b)) + ((null b) nil) + (t (and (Math-equal (car a) (car b)) + (math-compare-lists (cdr a) (cdr b))))) +) + +(defun math-lessp-float (a b) ; [P F F] + (let ((ediff (- (nth 2 a) (nth 2 b)))) + (if (>= ediff 0) + (if (>= ediff (+ calc-internal-prec calc-internal-prec)) + (if (eq (nth 1 a) 0) + (Math-integer-posp (nth 1 b)) + (Math-integer-negp (nth 1 a))) + (Math-lessp (math-scale-int (nth 1 a) ediff) + (nth 1 b))) + (if (>= (setq ediff (- ediff)) + (+ calc-internal-prec calc-internal-prec)) + (if (eq (nth 1 b) 0) + (Math-integer-negp (nth 1 a)) + (Math-integer-posp (nth 1 b))) + (Math-lessp (nth 1 a) + (math-scale-int (nth 1 b) ediff))))) +) + +;;; True if A is numerically equal to B. [P N N] [Public] +(defun math-equal (a b) + (= (math-compare a b) 0) +) + +;;; True if A is numerically less than B. [P R R] [Public] +(defun math-lessp (a b) + (= (math-compare a b) -1) +) + +;;; True if A is numerically equal to the integer B. [P N S] [Public] +;;; B must not be a multiple of 10. +(defun math-equal-int (a b) + (or (eq a b) + (and (eq (car-safe a) 'float) + (eq (nth 1 a) b) + (= (nth 2 a) 0))) +) + + + + +;;; Return the dimensions of a matrix as a list. [l x] [Public] +(defun math-mat-dimens (m) + (if (math-vectorp m) + (if (math-matrixp m) + (cons (1- (length m)) + (math-mat-dimens (nth 1 m))) + (list (1- (length m)))) + nil) +) + + + +(defun calc-binary-op-fancy (name func arg ident unary) + (let ((n (prefix-numeric-value arg))) + (cond ((> n 1) + (calc-enter-result n + name + (list 'calcFunc-reduce + (math-calcFunc-to-var func) + (cons 'vec (calc-top-list-n n))))) + ((= n 1) + (if unary + (calc-enter-result 1 name (list unary (calc-top-n 1))))) + ((= n 0) + (if ident + (calc-enter-result 0 name ident) + (error "Argument must be nonzero"))) + (t + (let ((rhs (calc-top-n 1))) + (calc-enter-result (- 1 n) + name + (mapcar (function + (lambda (x) + (list func x rhs))) + (calc-top-list-n (- n) 2))))))) +) + +(defun calc-unary-op-fancy (name func arg) + (let ((n (prefix-numeric-value arg))) + (if (= n 0) (setq n (calc-stack-size))) + (cond ((> n 0) + (calc-enter-result n + name + (mapcar (function + (lambda (x) + (list func x))) + (calc-top-list-n n)))) + ((< n 0) + (calc-enter-result 1 + name + (list func (calc-top-n (- n))) + (- n))))) +) + + + +(defvar var-Holidays '(vec (var sat var-sat) (var sun var-sun))) + + + +(defvar var-Decls (list 'vec)) + + + +(setq math-simplify-only nil) + +(defun math-inexact-result () + (and calc-symbolic-mode + (signal 'inexact-result nil)) +) + +(defun math-overflow (&optional exp) + (if (and exp (math-negp exp)) + (math-underflow) + (signal 'math-overflow nil)) +) + +(defun math-underflow () + (signal 'math-underflow nil) +) + + + +;;; Compute the greatest common divisor of A and B. [I I I] [Public] +(defun math-gcd (a b) + (cond ((not (or (consp a) (consp b))) + (if (< a 0) (setq a (- a))) + (if (< b 0) (setq b (- b))) + (let (c) + (if (< a b) + (setq c b b a a c)) + (while (> b 0) + (setq c b + b (% a b) + a c)) + a)) + ((eq a 0) b) + ((eq b 0) a) + (t + (if (Math-integer-negp a) (setq a (math-neg a))) + (if (Math-integer-negp b) (setq b (math-neg b))) + (let (c) + (if (Math-natnum-lessp a b) + (setq c b b a a c)) + (while (and (consp a) (not (eq b 0))) + (setq c b + b (math-imod a b) + a c)) + (while (> b 0) + (setq c b + b (% a b) + a c)) + a))) +) + + +;;;; Algebra. + +;;; Evaluate variables in an expression. +(defun math-evaluate-expr (x) ; [Public] + (if calc-embedded-info + (calc-embedded-evaluate-expr x) + (calc-normalize (math-evaluate-expr-rec x))) +) +(fset 'calcFunc-evalv (symbol-function 'math-evaluate-expr)) + +(defun calcFunc-evalvn (x &optional prec) + (if prec + (progn + (or (math-num-integerp prec) + (if (and (math-vectorp prec) + (= (length prec) 2) + (math-num-integerp (nth 1 prec))) + (setq prec (math-add (nth 1 prec) calc-internal-prec)) + (math-reject-arg prec 'integerp))) + (setq prec (math-trunc prec)) + (if (< prec 3) (setq prec 3)) + (if (> prec calc-internal-prec) + (math-normalize + (let ((calc-internal-prec prec)) + (calcFunc-evalvn x))) + (let ((calc-internal-prec prec)) + (calcFunc-evalvn x)))) + (let ((calc-symbolic-mode nil)) + (math-evaluate-expr x))) +) + +(defun math-evaluate-expr-rec (x) + (if (consp x) + (if (memq (car x) '(calcFunc-quote calcFunc-condition + calcFunc-evalto calcFunc-assign)) + (if (and (eq (car x) 'calcFunc-assign) + (= (length x) 3)) + (list (car x) (nth 1 x) (math-evaluate-expr-rec (nth 2 x))) + x) + (if (eq (car x) 'var) + (if (and (calc-var-value (nth 2 x)) + (not (eq (car-safe (symbol-value (nth 2 x))) + 'incomplete))) + (let ((val (symbol-value (nth 2 x)))) + (if (eq (car-safe val) 'special-const) + (if calc-symbolic-mode + x + val) + val)) + x) + (if (Math-primp x) + x + (cons (car x) (mapcar 'math-evaluate-expr-rec (cdr x)))))) + x) +) + + + +(setq math-simplifying nil) +(setq math-living-dangerously nil) ; true if unsafe simplifications are okay. +(setq math-integrating nil) + + + + +(defmacro math-defsimplify (funcs &rest code) + (append '(progn (math-need-std-simps)) + (mapcar (function + (lambda (func) + (list 'put (list 'quote func) ''math-simplify + (list 'nconc + (list 'get (list 'quote func) ''math-simplify) + (list 'list + (list 'function + (append '(lambda (expr)) + code))))))) + (if (symbolp funcs) (list funcs) funcs))) +) +(put 'math-defsimplify 'lisp-indent-hook 1) + + +(defun math-any-floats (expr) + (if (Math-primp expr) + (math-floatp expr) + (while (and (setq expr (cdr expr)) (not (math-any-floats (car expr))))) + expr) +) + +(defvar var-FactorRules 'calc-FactorRules) + + + +(defun math-map-tree (mmt-func mmt-expr &optional mmt-many) + (or mmt-many (setq mmt-many 1000000)) + (math-map-tree-rec mmt-expr) +) + +(defun math-map-tree-rec (mmt-expr) + (or (= mmt-many 0) + (let ((mmt-done nil) + mmt-nextval) + (while (not mmt-done) + (while (and (/= mmt-many 0) + (setq mmt-nextval (funcall mmt-func mmt-expr)) + (not (equal mmt-expr mmt-nextval))) + (setq mmt-expr mmt-nextval + mmt-many (if (> mmt-many 0) (1- mmt-many) (1+ mmt-many)))) + (if (or (Math-primp mmt-expr) + (<= mmt-many 0)) + (setq mmt-done t) + (setq mmt-nextval (cons (car mmt-expr) + (mapcar 'math-map-tree-rec + (cdr mmt-expr)))) + (if (equal mmt-nextval mmt-expr) + (setq mmt-done t) + (setq mmt-expr mmt-nextval)))))) + mmt-expr +) + + + + +(setq math-rewrite-selections nil) + +(defun math-is-true (expr) + (if (Math-numberp expr) + (not (Math-zerop expr)) + (math-known-nonzerop expr)) +) + +(defun math-const-var (expr) + (and (consp expr) + (eq (car expr) 'var) + (or (and (symbolp (nth 2 expr)) + (boundp (nth 2 expr)) + (eq (car-safe (symbol-value (nth 2 expr))) 'special-const)) + (memq (nth 2 expr) '(var-inf var-uinf var-nan)))) +) + + + + +(defmacro math-defintegral (funcs &rest code) + (setq math-integral-cache nil) + (append '(progn) + (mapcar (function + (lambda (func) + (list 'put (list 'quote func) ''math-integral + (list 'nconc + (list 'get (list 'quote func) ''math-integral) + (list 'list + (list 'function + (append '(lambda (u)) + code))))))) + (if (symbolp funcs) (list funcs) funcs))) +) +(put 'math-defintegral 'lisp-indent-hook 1) + +(defmacro math-defintegral-2 (funcs &rest code) + (setq math-integral-cache nil) + (append '(progn) + (mapcar (function + (lambda (func) + (list 'put (list 'quote func) ''math-integral-2 + (list 'nconc + (list 'get (list 'quote func) + ''math-integral-2) + (list 'list + (list 'function + (append '(lambda (u v)) + code))))))) + (if (symbolp funcs) (list funcs) funcs))) +) +(put 'math-defintegral-2 'lisp-indent-hook 1) + + +(defvar var-IntegAfterRules 'calc-IntegAfterRules) + + +(defvar var-FitRules 'calc-FitRules) + + +(setq math-poly-base-variable nil) +(setq math-poly-neg-powers nil) +(setq math-poly-mult-powers 1) +(setq math-poly-frac-powers nil) +(setq math-poly-exp-base nil) + + + + +(defun math-build-var-name (name) + (if (stringp name) + (setq name (intern name))) + (if (string-match "\\`var-." (symbol-name name)) + (list 'var (intern (substring (symbol-name name) 4)) name) + (list 'var name (intern (concat "var-" (symbol-name name))))) +) + +(setq math-simplifying-units nil) +(setq math-combining-units t) + + +(put 'math-while 'lisp-indent-hook 1) +(put 'math-for 'lisp-indent-hook 1) +(put 'math-foreach 'lisp-indent-hook 1) + + +;;; Nontrivial number parsing. + +(defun math-read-number-fancy (s) + (cond + + ;; Integer+fractions + ((string-match "^\\([0-9]*\\)[:/]\\([0-9]*\\)[:/]\\([0-9]*\\)$" s) + (let ((int (math-match-substring s 1)) + (num (math-match-substring s 2)) + (den (math-match-substring s 3))) + (let ((int (if (> (length int) 0) (math-read-number int) 0)) + (num (if (> (length num) 0) (math-read-number num) 1)) + (den (if (> (length num) 0) (math-read-number den) 1))) + (and int num den + (math-integerp int) (math-integerp num) (math-integerp den) + (not (math-zerop den)) + (list 'frac (math-add num (math-mul int den)) den))))) + + ;; Fractions + ((string-match "^\\([0-9]*\\)[:/]\\([0-9]*\\)$" s) + (let ((num (math-match-substring s 1)) + (den (math-match-substring s 2))) + (let ((num (if (> (length num) 0) (math-read-number num) 1)) + (den (if (> (length num) 0) (math-read-number den) 1))) + (and num den (math-integerp num) (math-integerp den) + (not (math-zerop den)) + (list 'frac num den))))) + + ;; Modulo forms + ((string-match "^\\(.*\\) *mod *\\(.*\\)$" s) + (let* ((n (math-match-substring s 1)) + (m (math-match-substring s 2)) + (n (math-read-number n)) + (m (math-read-number m))) + (and n m (math-anglep n) (math-anglep m) + (list 'mod n m)))) + + ;; Error forms + ((string-match "^\\(.*\\) *\\+/- *\\(.*\\)$" s) + (let* ((x (math-match-substring s 1)) + (sigma (math-match-substring s 2)) + (x (math-read-number x)) + (sigma (math-read-number sigma))) + (and x sigma (math-scalarp x) (math-anglep sigma) + (list 'sdev x sigma)))) + + ;; Hours (or degrees) + ((or (string-match "^\\([^#^]+\\)[@oOhH]\\(.*\\)$" s) + (string-match "^\\([^#^]+\\)[dD][eE]?[gG]?\\(.*\\)$" s)) + (let* ((hours (math-match-substring s 1)) + (minsec (math-match-substring s 2)) + (hours (math-read-number hours)) + (minsec (if (> (length minsec) 0) (math-read-number minsec) 0))) + (and hours minsec + (math-num-integerp hours) + (not (math-negp hours)) (not (math-negp minsec)) + (cond ((math-num-integerp minsec) + (and (Math-lessp minsec 60) + (list 'hms hours minsec 0))) + ((and (eq (car-safe minsec) 'hms) + (math-zerop (nth 1 minsec))) + (math-add (list 'hms hours 0 0) minsec)) + (t nil))))) + + ;; Minutes + ((string-match "^\\([^'#^]+\\)[mM']\\(.*\\)$" s) + (let* ((minutes (math-match-substring s 1)) + (seconds (math-match-substring s 2)) + (minutes (math-read-number minutes)) + (seconds (if (> (length seconds) 0) (math-read-number seconds) 0))) + (and minutes seconds + (math-num-integerp minutes) + (not (math-negp minutes)) (not (math-negp seconds)) + (cond ((math-realp seconds) + (and (Math-lessp minutes 60) + (list 'hms 0 minutes seconds))) + ((and (eq (car-safe seconds) 'hms) + (math-zerop (nth 1 seconds)) + (math-zerop (nth 2 seconds))) + (math-add (list 'hms 0 minutes 0) seconds)) + (t nil))))) + + ;; Seconds + ((string-match "^\\([^\"#^]+\\)[sS\"]$" s) + (let ((seconds (math-read-number (math-match-substring s 1)))) + (and seconds (math-realp seconds) + (not (math-negp seconds)) + (Math-lessp seconds 60) + (list 'hms 0 0 seconds)))) + + ;; Integer+fraction with explicit radix + ((string-match "^\\([0-9]+\\)\\(#\\|\\^\\^\\)\\([0-9a-zA-Z]*\\)[:/]\\([0-9a-zA-Z]*\\)[:/]\\([0-9a-zA-Z]\\)$" s) + (let ((radix (string-to-int (math-match-substring s 1))) + (int (math-match-substring s 3)) + (num (math-match-substring s 4)) + (den (math-match-substring s 5))) + (let ((int (if (> (length int) 0) (math-read-radix int radix) 0)) + (num (if (> (length num) 0) (math-read-radix num radix) 1)) + (den (if (> (length den) 0) (math-read-radix den radix) 1))) + (and int num den (not (math-zerop den)) + (list 'frac + (math-add num (math-mul int den)) + den))))) + + ;; Fraction with explicit radix + ((string-match "^\\([0-9]+\\)\\(#\\|\\^\\^\\)\\([0-9a-zA-Z]*\\)[:/]\\([0-9a-zA-Z]*\\)$" s) + (let ((radix (string-to-int (math-match-substring s 1))) + (num (math-match-substring s 3)) + (den (math-match-substring s 4))) + (let ((num (if (> (length num) 0) (math-read-radix num radix) 1)) + (den (if (> (length den) 0) (math-read-radix den radix) 1))) + (and num den (not (math-zerop den)) (list 'frac num den))))) + + ;; Float with explicit radix and exponent + ((or (string-match "^0*\\(\\([2-9]\\|1[0-4]\\)\\(#\\|\\^\\^\\)[0-9a-dA-D.]+\\)[eE]\\([-+]?[0-9]+\\)$" s) + (string-match "^\\(\\([0-9]+\\)\\(#\\|\\^\\^\\)[0-9a-zA-Z.]+\\) *\\* *\\2\\.? *\\^ *\\([-+]?[0-9]+\\)$" s)) + (let ((radix (string-to-int (math-match-substring s 2))) + (mant (math-match-substring s 1)) + (exp (math-match-substring s 4))) + (let ((mant (math-read-number mant)) + (exp (math-read-number exp))) + (and mant exp + (math-mul mant (math-pow (math-float radix) exp)))))) + + ;; Float with explicit radix, no exponent + ((string-match "^\\([0-9]+\\)\\(#\\|\\^\\^\\)\\([0-9a-zA-Z]*\\)\\.\\([0-9a-zA-Z]*\\)$" s) + (let ((radix (string-to-int (math-match-substring s 1))) + (int (math-match-substring s 3)) + (fracs (math-match-substring s 4))) + (let ((int (if (> (length int) 0) (math-read-radix int radix) 0)) + (frac (if (> (length fracs) 0) (math-read-radix fracs radix) 0)) + (calc-prefer-frac nil)) + (and int frac + (math-add int (math-div frac (math-pow radix (length fracs)))))))) + + ;; Integer with explicit radix + ((string-match "^\\([0-9]+\\)\\(#\\|\\^\\^\\)\\([0-9a-zA-Z]+\\)$" s) + (math-read-radix (math-match-substring s 3) + (string-to-int (math-match-substring s 1)))) + + ;; C language hexadecimal notation + ((and (eq calc-language 'c) + (string-match "^0[xX]\\([0-9a-fA-F]+\\)$" s)) + (let ((digs (math-match-substring s 1))) + (math-read-radix digs 16))) + + ;; Pascal language hexadecimal notation + ((and (eq calc-language 'pascal) + (string-match "^\\$\\([0-9a-fA-F]+\\)$" s)) + (let ((digs (math-match-substring s 1))) + (math-read-radix digs 16))) + + ;; Fraction using "/" instead of ":" + ((string-match "^\\([0-9]+\\)/\\([0-9/]+\\)$" s) + (math-read-number (concat (math-match-substring s 1) ":" + (math-match-substring s 2)))) + + ;; Syntax error! + (t nil)) +) + +(defun math-read-radix (s r) ; [I X D] + (setq s (upcase s)) + (let ((i 0) + (res 0) + dig) + (while (and (< i (length s)) + (setq dig (math-read-radix-digit (elt s i))) + (< dig r)) + (setq res (math-add (math-mul res r) dig) + i (1+ i))) + (and (= i (length s)) + res)) +) + + + +;;; Expression parsing. + +(defun math-read-expr (exp-str) + (let ((exp-pos 0) + (exp-old-pos 0) + (exp-keep-spaces nil) + exp-token exp-data) + (while (setq exp-token (string-match "\\.\\.\\([^.]\\|.[^.]\\)" exp-str)) + (setq exp-str (concat (substring exp-str 0 exp-token) "\\dots" + (substring exp-str (+ exp-token 2))))) + (math-build-parse-table) + (math-read-token) + (let ((val (catch 'syntax (math-read-expr-level 0)))) + (if (stringp val) + (list 'error exp-old-pos val) + (if (equal exp-token 'end) + val + (list 'error exp-old-pos "Syntax error"))))) +) + +(defun math-read-plain-expr (exp-str &optional error-check) + (let* ((calc-language nil) + (math-expr-opers math-standard-opers) + (val (math-read-expr exp-str))) + (and error-check + (eq (car-safe val) 'error) + (error "%s: %s" (nth 2 val) exp-str)) + val) +) + + +(defun math-read-string () + (let ((str (read-from-string (concat exp-data "\"")))) + (or (and (= (cdr str) (1+ (length exp-data))) + (stringp (car str))) + (throw 'syntax "Error in string constant")) + (math-read-token) + (append '(vec) (car str) nil)) +) + + + +;;; They said it couldn't be done... + +(defun math-read-big-expr (str) + (and (> (length calc-left-label) 0) + (string-match (concat "^" (regexp-quote calc-left-label)) str) + (setq str (concat (substring str 0 (match-beginning 0)) + (substring str (match-end 0))))) + (and (> (length calc-right-label) 0) + (string-match (concat (regexp-quote calc-right-label) " *$") str) + (setq str (concat (substring str 0 (match-beginning 0)) + (substring str (match-end 0))))) + (if (string-match "\\\\[^ \n|]" str) + (if (eq calc-language 'tex) + (math-read-expr str) + (let ((calc-language 'tex) + (calc-language-option nil) + (math-expr-opers (get 'tex 'math-oper-table)) + (math-expr-function-mapping (get 'tex 'math-function-table)) + (math-expr-variable-mapping (get 'tex 'math-variable-table))) + (math-read-expr str))) + (let ((lines nil) + (pos 0) + (width 0) + (err-msg nil) + the-baseline the-h2 + new-pos p) + (while (setq new-pos (string-match "\n" str pos)) + (setq lines (cons (substring str pos new-pos) lines) + pos (1+ new-pos))) + (setq lines (nreverse (cons (substring str pos) lines)) + p lines) + (while p + (setq width (max width (length (car p))) + p (cdr p))) + (if (math-read-big-bigp lines) + (or (catch 'syntax + (math-read-big-rec 0 0 width (length lines))) + err-msg + '(error 0 "Syntax error")) + (math-read-expr str)))) +) + +(defun math-read-big-bigp (lines) + (and (cdr lines) + (let ((matrix nil) + (v 0) + (height (if (> (length (car lines)) 0) 1 0))) + (while (and (cdr lines) + (let* ((i 0) + j + (l1 (car lines)) + (l2 (nth 1 lines)) + (len (min (length l1) (length l2)))) + (if (> (length l2) 0) + (setq height (1+ height))) + (while (and (< i len) + (or (memq (aref l1 i) '(?\ ?\- ?\_)) + (memq (aref l2 i) '(?\ ?\-)) + (and (memq (aref l1 i) '(?\| ?\,)) + (= (aref l2 i) (aref l1 i))) + (and (eq (aref l1 i) ?\[) + (eq (aref l2 i) ?\[) + (let ((h2 (length l1))) + (setq j (math-read-big-balance + (1+ i) v "["))) + (setq i (1- j))))) + (setq i (1+ i))) + (or (= i len) + (and (eq (aref l1 i) ?\[) + (eq (aref l2 i) ?\[) + (setq matrix t) + nil)))) + (setq lines (cdr lines) + v (1+ v))) + (or (and (> height 1) + (not (cdr lines))) + matrix))) +) + + + +;;; Nontrivial "flat" formatting. + +(defun math-format-flat-expr-fancy (a prec) + (cond + ((eq (car a) 'incomplete) + (format "<incomplete %s>" (nth 1 a))) + ((eq (car a) 'vec) + (if (or calc-full-trail-vectors (not calc-can-abbrev-vectors) + (< (length a) 7)) + (concat "[" (math-format-flat-vector (cdr a) ", " + (if (cdr (cdr a)) 0 1000)) "]") + (concat "[" + (math-format-flat-expr (nth 1 a) 0) ", " + (math-format-flat-expr (nth 2 a) 0) ", " + (math-format-flat-expr (nth 3 a) 0) ", ..., " + (math-format-flat-expr (nth (1- (length a)) a) 0) "]"))) + ((eq (car a) 'intv) + (concat (if (memq (nth 1 a) '(0 1)) "(" "[") + (math-format-flat-expr (nth 2 a) 1000) + " .. " + (math-format-flat-expr (nth 3 a) 1000) + (if (memq (nth 1 a) '(0 2)) ")" "]"))) + ((eq (car a) 'date) + (concat "<" (math-format-date a) ">")) + ((and (eq (car a) 'calcFunc-lambda) (> (length a) 2)) + (let ((p (cdr a)) + (ap calc-arg-values) + (math-format-hash-args (if (= (length a) 3) 1 t))) + (while (and (cdr p) (equal (car p) (car ap))) + (setq p (cdr p) ap (cdr ap))) + (concat "<" + (if (cdr p) + (concat (math-format-flat-vector + (nreverse (cdr (reverse (cdr a)))) ", " 0) + " : ") + "") + (math-format-flat-expr (nth (1- (length a)) a) 0) + ">"))) + ((eq (car a) 'var) + (or (and math-format-hash-args + (let ((p calc-arg-values) (v 1)) + (while (and p (not (equal (car p) a))) + (setq p (and (eq math-format-hash-args t) (cdr p)) + v (1+ v))) + (and p + (if (eq math-format-hash-args 1) + "#" + (format "#%d" v))))) + (symbol-name (nth 1 a)))) + ((and (memq (car a) '(calcFunc-string calcFunc-bstring)) + (= (length a) 2) + (math-vectorp (nth 1 a)) + (math-vector-is-string (nth 1 a))) + (concat (substring (symbol-name (car a)) 9) + "(" (math-vector-to-string (nth 1 a) t) ")")) + (t + (let ((op (math-assq2 (car a) math-standard-opers))) + (cond ((and op (= (length a) 3)) + (if (> prec (min (nth 2 op) (nth 3 op))) + (concat "(" (math-format-flat-expr a 0) ")") + (let ((lhs (math-format-flat-expr (nth 1 a) (nth 2 op))) + (rhs (math-format-flat-expr (nth 2 a) (nth 3 op)))) + (setq op (car op)) + (if (or (equal op "^") (equal op "_")) + (if (= (aref lhs 0) ?-) + (setq lhs (concat "(" lhs ")"))) + (setq op (concat " " op " "))) + (concat lhs op rhs)))) + ((eq (car a) 'neg) + (concat "-" (math-format-flat-expr (nth 1 a) 1000))) + (t + (concat (math-remove-dashes + (if (string-match "\\`calcFunc-\\([a-zA-Z0-9']+\\)\\'" + (symbol-name (car a))) + (math-match-substring (symbol-name (car a)) 1) + (symbol-name (car a)))) + "(" + (math-format-flat-vector (cdr a) ", " 0) + ")")))))) +) +(setq math-format-hash-args nil) + +(defun math-format-flat-vector (vec sep prec) + (if vec + (let ((buf (math-format-flat-expr (car vec) prec))) + (while (setq vec (cdr vec)) + (setq buf (concat buf sep (math-format-flat-expr (car vec) prec)))) + buf) + "") +) +(setq calc-can-abbrev-vectors nil) + +(defun math-format-nice-expr (x w) + (cond ((and (eq (car-safe x) 'vec) + (cdr (cdr x)) + (let ((ops '(vec calcFunc-assign calcFunc-condition + calcFunc-schedule calcFunc-iterations + calcFunc-phase))) + (or (memq (car-safe (nth 1 x)) ops) + (memq (car-safe (nth 2 x)) ops) + (memq (car-safe (nth 3 x)) ops) + calc-break-vectors))) + (concat "[ " (math-format-flat-vector (cdr x) ",\n " 0) " ]")) + (t + (let ((str (math-format-flat-expr x 0)) + (pos 0) p) + (or (string-match "\"" str) + (while (<= (setq p (+ pos w)) (length str)) + (while (and (> (setq p (1- p)) pos) + (not (= (aref str p) ? )))) + (if (> p (+ pos 5)) + (setq str (concat (substring str 0 p) + "\n " + (substring str p)) + pos (1+ p)) + (setq pos (+ pos w))))) + str))) +) + +(defun math-assq2 (v a) + (while (and a (not (eq v (nth 1 (car a))))) + (setq a (cdr a))) + (car a) +) + + +(defun math-format-number-fancy (a prec) + (cond + ((eq (car a) 'float) ; non-decimal radix + (if (Math-integer-negp (nth 1 a)) + (concat "-" (math-format-number (math-neg a))) + (let ((str (if (and calc-radix-formatter + (not (memq calc-language '(c pascal)))) + (funcall calc-radix-formatter + calc-number-radix + (math-format-radix-float a prec)) + (format "%d#%s" calc-number-radix + (math-format-radix-float a prec))))) + (if (and prec (> prec 191) (string-match "\\*" str)) + (concat "(" str ")") + str)))) + ((eq (car a) 'frac) + (setq a (math-adjust-fraction a)) + (if (> (length (car calc-frac-format)) 1) + (if (Math-integer-negp (nth 1 a)) + (concat "-" (math-format-number (math-neg a))) + (let ((q (math-idivmod (nth 1 a) (nth 2 a)))) + (concat (let ((calc-frac-format nil)) + (math-format-number (car q))) + (substring (car calc-frac-format) 0 1) + (let ((math-radix-explicit-format nil) + (calc-frac-format nil)) + (math-format-number (cdr q))) + (substring (car calc-frac-format) 1 2) + (let ((math-radix-explicit-format nil) + (calc-frac-format nil)) + (math-format-number (nth 2 a)))))) + (concat (let ((calc-frac-format nil)) + (math-format-number (nth 1 a))) + (car calc-frac-format) + (let ((math-radix-explicit-format nil) + (calc-frac-format nil)) + (math-format-number (nth 2 a)))))) + ((eq (car a) 'cplx) + (if (math-zerop (nth 2 a)) + (math-format-number (nth 1 a)) + (if (null calc-complex-format) + (concat "(" (math-format-number (nth 1 a)) + ", " (math-format-number (nth 2 a)) ")") + (if (math-zerop (nth 1 a)) + (if (math-equal-int (nth 2 a) 1) + (symbol-name calc-complex-format) + (if (math-equal-int (nth 2 a) -1) + (concat "-" (symbol-name calc-complex-format)) + (if prec + (math-compose-expr (list '* (nth 2 a) '(cplx 0 1)) prec) + (concat (math-format-number (nth 2 a)) " " + (symbol-name calc-complex-format))))) + (if prec + (math-compose-expr (list (if (math-negp (nth 2 a)) '- '+) + (nth 1 a) + (list 'cplx 0 (math-abs (nth 2 a)))) + prec) + (concat (math-format-number (nth 1 a)) + (if (math-negp (nth 2 a)) " - " " + ") + (math-format-number + (list 'cplx 0 (math-abs (nth 2 a)))))))))) + ((eq (car a) 'polar) + (concat "(" (math-format-number (nth 1 a)) + "; " (math-format-number (nth 2 a)) ")")) + ((eq (car a) 'hms) + (if (math-negp a) + (concat "-" (math-format-number (math-neg a))) + (let ((calc-number-radix 10) + (calc-leading-zeros nil) + (calc-group-digits nil)) + (format calc-hms-format + (let ((calc-frac-format '(":" nil))) + (math-format-number (nth 1 a))) + (let ((calc-frac-format '(":" nil))) + (math-format-number (nth 2 a))) + (math-format-number (nth 3 a)))))) + ((eq (car a) 'intv) + (concat (if (memq (nth 1 a) '(0 1)) "(" "[") + (math-format-number (nth 2 a)) + " .. " + (math-format-number (nth 3 a)) + (if (memq (nth 1 a) '(0 2)) ")" "]"))) + ((eq (car a) 'sdev) + (concat (math-format-number (nth 1 a)) + " +/- " + (math-format-number (nth 2 a)))) + ((eq (car a) 'vec) + (math-format-flat-expr a 0)) + (t (format "%s" a))) +) + +(defun math-adjust-fraction (a) + (if (nth 1 calc-frac-format) + (progn + (if (Math-integerp a) (setq a (list 'frac a 1))) + (let ((g (math-quotient (nth 1 calc-frac-format) + (math-gcd (nth 2 a) + (nth 1 calc-frac-format))))) + (list 'frac (math-mul (nth 1 a) g) (math-mul (nth 2 a) g)))) + a) +) + +(defun math-format-bignum-fancy (a) ; [X L] + (let ((str (cond ((= calc-number-radix 10) + (math-format-bignum-decimal a)) + ((= calc-number-radix 2) + (math-format-bignum-binary a)) + ((= calc-number-radix 8) + (math-format-bignum-octal a)) + ((= calc-number-radix 16) + (math-format-bignum-hex a)) + (t (math-format-bignum-radix a))))) + (if calc-leading-zeros + (let* ((calc-internal-prec 6) + (digs (math-compute-max-digits (math-abs calc-word-size) + calc-number-radix)) + (len (length str))) + (if (< len digs) + (setq str (concat (make-string (- digs len) ?0) str))))) + (if calc-group-digits + (let ((i (length str)) + (g (if (integerp calc-group-digits) + (math-abs calc-group-digits) + (if (memq calc-number-radix '(2 16)) 4 3)))) + (while (> i g) + (setq i (- i g) + str (concat (substring str 0 i) + calc-group-char + (substring str i)))) + str)) + (if (and (/= calc-number-radix 10) + math-radix-explicit-format) + (if calc-radix-formatter + (funcall calc-radix-formatter calc-number-radix str) + (format "%d#%s" calc-number-radix str)) + str)) +) + + +(defun math-group-float (str) ; [X X] + (let* ((pt (or (string-match "[^0-9a-zA-Z]" str) (length str))) + (g (if (integerp calc-group-digits) (math-abs calc-group-digits) 3)) + (i pt)) + (if (and (integerp calc-group-digits) (< calc-group-digits 0)) + (while (< (setq i (+ (1+ i) g)) (length str)) + (setq str (concat (substring str 0 i) + calc-group-char + (substring str i)) + i (+ i (1- (length calc-group-char)))))) + (setq i pt) + (while (> i g) + (setq i (- i g) + str (concat (substring str 0 i) + calc-group-char + (substring str i)))) + str) +) + + + + + + + + +(setq math-compose-level 0) +(setq math-comp-selected nil) +(setq math-comp-tagged nil) +(setq math-comp-sel-hpos nil) +(setq math-comp-sel-vpos nil) +(setq math-comp-sel-cpos nil) +(setq math-compose-hash-args nil) + + +;;; Users can redefine this in their .emacs files. +(defvar calc-keypad-user-menu nil + "If not NIL, this describes an additional menu for calc-keypad. +It should contain a list of three rows. +Each row should be a list of six keys. +Each key should be a list of a label string, plus a Calc command name spec. +A command spec is a command name symbol, a keyboard macro string, a +list containing a numeric entry string, or nil. +A key may contain additional specs for Inverse, Hyperbolic, and Inv+Hyp.") + + + + + +(run-hooks 'calc-ext-load-hook) + +