1;;; calc-ext.el --- various extension functions for Calc 2 3;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, 4;; 2005, 2006, 2007 Free Software Foundation, Inc. 5 6;; Author: David Gillespie <daveg@synaptics.com> 7;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> 8 9;; This file is part of GNU Emacs. 10 11;; GNU Emacs is free software; you can redistribute it and/or modify 12;; it under the terms of the GNU General Public License as published by 13;; the Free Software Foundation; either version 2, or (at your option) 14;; any later version. 15 16;; GNU Emacs is distributed in the hope that it will be useful, 17;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19;; GNU General Public License for more details. 20 21;; You should have received a copy of the GNU General Public License 22;; along with GNU Emacs; see the file COPYING. If not, write to the 23;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 24;; Boston, MA 02110-1301, USA. 25 26;;; Commentary: 27 28;;; Code: 29 30(require 'calc) 31(require 'calc-macs) 32 33(defvar math-simplifying nil) 34(defvar math-living-dangerously nil) ; true if unsafe simplifications are okay. 35(defvar math-integrating nil) 36 37(defvar math-rewrite-selections nil) 38 39(defvar math-compose-level 0) 40(defvar math-comp-selected nil) 41(defvar math-comp-tagged nil) 42(defvar math-comp-sel-hpos nil) 43(defvar math-comp-sel-vpos nil) 44(defvar math-comp-sel-cpos nil) 45(defvar math-compose-hash-args nil) 46 47(defvar calc-alg-map) 48(defvar calc-alg-esc-map) 49 50;;; The following was made a function so that it could be byte-compiled. 51(defun calc-init-extensions () 52 53 (define-key calc-mode-map ":" 'calc-fdiv) 54 (define-key calc-mode-map "\\" 'calc-idiv) 55 (define-key calc-mode-map "|" 'calc-concat) 56 (define-key calc-mode-map "!" 'calc-factorial) 57 (define-key calc-mode-map "C" 'calc-cos) 58 (define-key calc-mode-map "E" 'calc-exp) 59 (define-key calc-mode-map "H" 'calc-hyperbolic) 60 (define-key calc-mode-map "I" 'calc-inverse) 61 (define-key calc-mode-map "J" 'calc-conj) 62 (define-key calc-mode-map "L" 'calc-ln) 63 (define-key calc-mode-map "N" 'calc-eval-num) 64 (define-key calc-mode-map "P" 'calc-pi) 65 (define-key calc-mode-map "Q" 'calc-sqrt) 66 (define-key calc-mode-map "R" 'calc-round) 67 (define-key calc-mode-map "S" 'calc-sin) 68 (define-key calc-mode-map "T" 'calc-tan) 69 (define-key calc-mode-map "U" 'calc-undo) 70 (define-key calc-mode-map "X" 'calc-call-last-kbd-macro) 71 (define-key calc-mode-map "o" 'calc-realign) 72 (define-key calc-mode-map "p" 'calc-precision) 73 (define-key calc-mode-map "w" 'calc-why) 74 (define-key calc-mode-map "x" 'calc-execute-extended-command) 75 (define-key calc-mode-map "y" 'calc-copy-to-buffer) 76 77 (define-key calc-mode-map "(" 'calc-begin-complex) 78 (define-key calc-mode-map ")" 'calc-end-complex) 79 (define-key calc-mode-map "[" 'calc-begin-vector) 80 (define-key calc-mode-map "]" 'calc-end-vector) 81 (define-key calc-mode-map "," 'calc-comma) 82 (define-key calc-mode-map ";" 'calc-semi) 83 (define-key calc-mode-map "`" 'calc-edit) 84 (define-key calc-mode-map "=" 'calc-evaluate) 85 (define-key calc-mode-map "~" 'calc-num-prefix) 86 (define-key calc-mode-map "<" 'calc-scroll-left) 87 (define-key calc-mode-map ">" 'calc-scroll-right) 88 (define-key calc-mode-map "{" 'calc-scroll-down) 89 (define-key calc-mode-map "}" 'calc-scroll-up) 90 (define-key calc-mode-map "\C-k" 'calc-kill) 91 (define-key calc-mode-map "\M-k" 'calc-copy-as-kill) 92 (define-key calc-mode-map "\C-w" 'calc-kill-region) 93 (define-key calc-mode-map "\M-w" 'calc-copy-region-as-kill) 94 (define-key calc-mode-map "\C-y" 'calc-yank) 95 (define-key calc-mode-map [mouse-2] 'calc-yank) 96 (define-key calc-mode-map "\C-_" 'calc-undo) 97 (define-key calc-mode-map "\C-xu" 'calc-undo) 98 (define-key calc-mode-map "\M-\C-m" 'calc-last-args) 99 100 (define-key calc-mode-map "a" nil) 101 (define-key calc-mode-map "a?" 'calc-a-prefix-help) 102 (define-key calc-mode-map "aa" 'calc-apart) 103 (define-key calc-mode-map "ab" 'calc-substitute) 104 (define-key calc-mode-map "ac" 'calc-collect) 105 (define-key calc-mode-map "ad" 'calc-derivative) 106 (define-key calc-mode-map "ae" 'calc-simplify-extended) 107 (define-key calc-mode-map "af" 'calc-factor) 108 (define-key calc-mode-map "ag" 'calc-poly-gcd) 109 (define-key calc-mode-map "ai" 'calc-integral) 110 (define-key calc-mode-map "am" 'calc-match) 111 (define-key calc-mode-map "an" 'calc-normalize-rat) 112 (define-key calc-mode-map "ap" 'calc-poly-interp) 113 (define-key calc-mode-map "ar" 'calc-rewrite) 114 (define-key calc-mode-map "as" 'calc-simplify) 115 (define-key calc-mode-map "at" 'calc-taylor) 116 (define-key calc-mode-map "av" 'calc-alg-evaluate) 117 (define-key calc-mode-map "ax" 'calc-expand) 118 (define-key calc-mode-map "aA" 'calc-abs) 119 (define-key calc-mode-map "aF" 'calc-curve-fit) 120 (define-key calc-mode-map "aI" 'calc-num-integral) 121 (define-key calc-mode-map "aM" 'calc-map-equation) 122 (define-key calc-mode-map "aN" 'calc-find-minimum) 123 (define-key calc-mode-map "aP" 'calc-poly-roots) 124 (define-key calc-mode-map "aS" 'calc-solve-for) 125 (define-key calc-mode-map "aR" 'calc-find-root) 126 (define-key calc-mode-map "aT" 'calc-tabulate) 127 (define-key calc-mode-map "aX" 'calc-find-maximum) 128 (define-key calc-mode-map "a+" 'calc-summation) 129 (define-key calc-mode-map "a-" 'calc-alt-summation) 130 (define-key calc-mode-map "a*" 'calc-product) 131 (define-key calc-mode-map "a\\" 'calc-poly-div) 132 (define-key calc-mode-map "a%" 'calc-poly-rem) 133 (define-key calc-mode-map "a/" 'calc-poly-div-rem) 134 (define-key calc-mode-map "a=" 'calc-equal-to) 135 (define-key calc-mode-map "a#" 'calc-not-equal-to) 136 (define-key calc-mode-map "a<" 'calc-less-than) 137 (define-key calc-mode-map "a>" 'calc-greater-than) 138 (define-key calc-mode-map "a[" 'calc-less-equal) 139 (define-key calc-mode-map "a]" 'calc-greater-equal) 140 (define-key calc-mode-map "a." 'calc-remove-equal) 141 (define-key calc-mode-map "a{" 'calc-in-set) 142 (define-key calc-mode-map "a&" 'calc-logical-and) 143 (define-key calc-mode-map "a|" 'calc-logical-or) 144 (define-key calc-mode-map "a!" 'calc-logical-not) 145 (define-key calc-mode-map "a:" 'calc-logical-if) 146 (define-key calc-mode-map "a_" 'calc-subscript) 147 (define-key calc-mode-map "a\"" 'calc-expand-formula) 148 149 (define-key calc-mode-map "b" nil) 150 (define-key calc-mode-map "b?" 'calc-b-prefix-help) 151 (define-key calc-mode-map "ba" 'calc-and) 152 (define-key calc-mode-map "bc" 'calc-clip) 153 (define-key calc-mode-map "bd" 'calc-diff) 154 (define-key calc-mode-map "bl" 'calc-lshift-binary) 155 (define-key calc-mode-map "bn" 'calc-not) 156 (define-key calc-mode-map "bo" 'calc-or) 157 (define-key calc-mode-map "bp" 'calc-pack-bits) 158 (define-key calc-mode-map "br" 'calc-rshift-binary) 159 (define-key calc-mode-map "bt" 'calc-rotate-binary) 160 (define-key calc-mode-map "bu" 'calc-unpack-bits) 161 (define-key calc-mode-map "bw" 'calc-word-size) 162 (define-key calc-mode-map "bx" 'calc-xor) 163 (define-key calc-mode-map "bB" 'calc-log) 164 (define-key calc-mode-map "bD" 'calc-fin-ddb) 165 (define-key calc-mode-map "bF" 'calc-fin-fv) 166 (define-key calc-mode-map "bI" 'calc-fin-irr) 167 (define-key calc-mode-map "bL" 'calc-lshift-arith) 168 (define-key calc-mode-map "bM" 'calc-fin-pmt) 169 (define-key calc-mode-map "bN" 'calc-fin-npv) 170 (define-key calc-mode-map "bP" 'calc-fin-pv) 171 (define-key calc-mode-map "bR" 'calc-rshift-arith) 172 (define-key calc-mode-map "bS" 'calc-fin-sln) 173 (define-key calc-mode-map "bT" 'calc-fin-rate) 174 (define-key calc-mode-map "bY" 'calc-fin-syd) 175 (define-key calc-mode-map "b#" 'calc-fin-nper) 176 (define-key calc-mode-map "b%" 'calc-percent-change) 177 178 (define-key calc-mode-map "c" nil) 179 (define-key calc-mode-map "c?" 'calc-c-prefix-help) 180 (define-key calc-mode-map "cc" 'calc-clean) 181 (define-key calc-mode-map "cd" 'calc-to-degrees) 182 (define-key calc-mode-map "cf" 'calc-float) 183 (define-key calc-mode-map "ch" 'calc-to-hms) 184 (define-key calc-mode-map "cp" 'calc-polar) 185 (define-key calc-mode-map "cr" 'calc-to-radians) 186 (define-key calc-mode-map "cC" 'calc-cos) 187 (define-key calc-mode-map "cF" 'calc-fraction) 188 (define-key calc-mode-map "c%" 'calc-convert-percent) 189 190 (define-key calc-mode-map "d" nil) 191 (define-key calc-mode-map "d?" 'calc-d-prefix-help) 192 (define-key calc-mode-map "d0" 'calc-decimal-radix) 193 (define-key calc-mode-map "d2" 'calc-binary-radix) 194 (define-key calc-mode-map "d6" 'calc-hex-radix) 195 (define-key calc-mode-map "d8" 'calc-octal-radix) 196 (define-key calc-mode-map "db" 'calc-line-breaking) 197 (define-key calc-mode-map "dc" 'calc-complex-notation) 198 (define-key calc-mode-map "dd" 'calc-date-notation) 199 (define-key calc-mode-map "de" 'calc-eng-notation) 200 (define-key calc-mode-map "df" 'calc-fix-notation) 201 (define-key calc-mode-map "dg" 'calc-group-digits) 202 (define-key calc-mode-map "dh" 'calc-hms-notation) 203 (define-key calc-mode-map "di" 'calc-i-notation) 204 (define-key calc-mode-map "dj" 'calc-j-notation) 205 (define-key calc-mode-map "dl" 'calc-line-numbering) 206 (define-key calc-mode-map "dn" 'calc-normal-notation) 207 (define-key calc-mode-map "do" 'calc-over-notation) 208 (define-key calc-mode-map "dp" 'calc-show-plain) 209 (define-key calc-mode-map "dr" 'calc-radix) 210 (define-key calc-mode-map "ds" 'calc-sci-notation) 211 (define-key calc-mode-map "dt" 'calc-truncate-stack) 212 (define-key calc-mode-map "dw" 'calc-auto-why) 213 (define-key calc-mode-map "dz" 'calc-leading-zeros) 214 (define-key calc-mode-map "dB" 'calc-big-language) 215 (define-key calc-mode-map "dD" 'calc-redo) 216 (define-key calc-mode-map "dC" 'calc-c-language) 217 (define-key calc-mode-map "dE" 'calc-eqn-language) 218 (define-key calc-mode-map "dF" 'calc-fortran-language) 219 (define-key calc-mode-map "dM" 'calc-mathematica-language) 220 (define-key calc-mode-map "dN" 'calc-normal-language) 221 (define-key calc-mode-map "dO" 'calc-flat-language) 222 (define-key calc-mode-map "dP" 'calc-pascal-language) 223 (define-key calc-mode-map "dT" 'calc-tex-language) 224 (define-key calc-mode-map "dL" 'calc-latex-language) 225 (define-key calc-mode-map "dU" 'calc-unformatted-language) 226 (define-key calc-mode-map "dW" 'calc-maple-language) 227 (define-key calc-mode-map "d[" 'calc-truncate-up) 228 (define-key calc-mode-map "d]" 'calc-truncate-down) 229 (define-key calc-mode-map "d." 'calc-point-char) 230 (define-key calc-mode-map "d," 'calc-group-char) 231 (define-key calc-mode-map "d\"" 'calc-display-strings) 232 (define-key calc-mode-map "d<" 'calc-left-justify) 233 (define-key calc-mode-map "d=" 'calc-center-justify) 234 (define-key calc-mode-map "d>" 'calc-right-justify) 235 (define-key calc-mode-map "d{" 'calc-left-label) 236 (define-key calc-mode-map "d}" 'calc-right-label) 237 (define-key calc-mode-map "d'" 'calc-display-raw) 238 (define-key calc-mode-map "d " 'calc-refresh) 239 (define-key calc-mode-map "d\r" 'calc-refresh-top) 240 (define-key calc-mode-map "d@" 'calc-toggle-banner) 241 242 (define-key calc-mode-map "f" nil) 243 (define-key calc-mode-map "f?" 'calc-f-prefix-help) 244 (define-key calc-mode-map "fb" 'calc-beta) 245 (define-key calc-mode-map "fe" 'calc-erf) 246 (define-key calc-mode-map "fg" 'calc-gamma) 247 (define-key calc-mode-map "fh" 'calc-hypot) 248 (define-key calc-mode-map "fi" 'calc-im) 249 (define-key calc-mode-map "fj" 'calc-bessel-J) 250 (define-key calc-mode-map "fn" 'calc-min) 251 (define-key calc-mode-map "fr" 'calc-re) 252 (define-key calc-mode-map "fs" 'calc-sign) 253 (define-key calc-mode-map "fx" 'calc-max) 254 (define-key calc-mode-map "fy" 'calc-bessel-Y) 255 (define-key calc-mode-map "fA" 'calc-abssqr) 256 (define-key calc-mode-map "fB" 'calc-inc-beta) 257 (define-key calc-mode-map "fE" 'calc-expm1) 258 (define-key calc-mode-map "fF" 'calc-floor) 259 (define-key calc-mode-map "fG" 'calc-inc-gamma) 260 (define-key calc-mode-map "fI" 'calc-ilog) 261 (define-key calc-mode-map "fL" 'calc-lnp1) 262 (define-key calc-mode-map "fM" 'calc-mant-part) 263 (define-key calc-mode-map "fQ" 'calc-isqrt) 264 (define-key calc-mode-map "fS" 'calc-scale-float) 265 (define-key calc-mode-map "fT" 'calc-arctan2) 266 (define-key calc-mode-map "fX" 'calc-xpon-part) 267 (define-key calc-mode-map "f[" 'calc-decrement) 268 (define-key calc-mode-map "f]" 'calc-increment) 269 270 (define-key calc-mode-map "g" nil) 271 (define-key calc-mode-map "g?" 'calc-g-prefix-help) 272 (define-key calc-mode-map "ga" 'calc-graph-add) 273 (define-key calc-mode-map "gb" 'calc-graph-border) 274 (define-key calc-mode-map "gc" 'calc-graph-clear) 275 (define-key calc-mode-map "gd" 'calc-graph-delete) 276 (define-key calc-mode-map "gf" 'calc-graph-fast) 277 (define-key calc-mode-map "gg" 'calc-graph-grid) 278 (define-key calc-mode-map "gh" 'calc-graph-header) 279 (define-key calc-mode-map "gk" 'calc-graph-key) 280 (define-key calc-mode-map "gj" 'calc-graph-juggle) 281 (define-key calc-mode-map "gl" 'calc-graph-log-x) 282 (define-key calc-mode-map "gn" 'calc-graph-name) 283 (define-key calc-mode-map "gp" 'calc-graph-plot) 284 (define-key calc-mode-map "gq" 'calc-graph-quit) 285 (define-key calc-mode-map "gr" 'calc-graph-range-x) 286 (define-key calc-mode-map "gs" 'calc-graph-line-style) 287 (define-key calc-mode-map "gt" 'calc-graph-title-x) 288 (define-key calc-mode-map "gv" 'calc-graph-view-commands) 289 (define-key calc-mode-map "gx" 'calc-graph-display) 290 (define-key calc-mode-map "gz" 'calc-graph-zero-x) 291 (define-key calc-mode-map "gA" 'calc-graph-add-3d) 292 (define-key calc-mode-map "gC" 'calc-graph-command) 293 (define-key calc-mode-map "gD" 'calc-graph-device) 294 (define-key calc-mode-map "gF" 'calc-graph-fast-3d) 295 (define-key calc-mode-map "gG" 'calc-argument) 296 (define-key calc-mode-map "gH" 'calc-graph-hide) 297 (define-key calc-mode-map "gK" 'calc-graph-kill) 298 (define-key calc-mode-map "gL" 'calc-graph-log-y) 299 (define-key calc-mode-map "gN" 'calc-graph-num-points) 300 (define-key calc-mode-map "gO" 'calc-graph-output) 301 (define-key calc-mode-map "gP" 'calc-graph-print) 302 (define-key calc-mode-map "gR" 'calc-graph-range-y) 303 (define-key calc-mode-map "gS" 'calc-graph-point-style) 304 (define-key calc-mode-map "gT" 'calc-graph-title-y) 305 (define-key calc-mode-map "gV" 'calc-graph-view-trail) 306 (define-key calc-mode-map "gX" 'calc-graph-geometry) 307 (define-key calc-mode-map "gZ" 'calc-graph-zero-y) 308 (define-key calc-mode-map "g\C-l" 'calc-graph-log-z) 309 (define-key calc-mode-map "g\C-r" 'calc-graph-range-z) 310 (define-key calc-mode-map "g\C-t" 'calc-graph-title-z) 311 312 (define-key calc-mode-map "h" 'calc-help-prefix) 313 314 (define-key calc-mode-map "j" nil) 315 (define-key calc-mode-map "j?" 'calc-j-prefix-help) 316 (define-key calc-mode-map "ja" 'calc-select-additional) 317 (define-key calc-mode-map "jb" 'calc-break-selections) 318 (define-key calc-mode-map "jc" 'calc-clear-selections) 319 (define-key calc-mode-map "jd" 'calc-show-selections) 320 (define-key calc-mode-map "je" 'calc-enable-selections) 321 (define-key calc-mode-map "jl" 'calc-select-less) 322 (define-key calc-mode-map "jm" 'calc-select-more) 323 (define-key calc-mode-map "jn" 'calc-select-next) 324 (define-key calc-mode-map "jo" 'calc-select-once) 325 (define-key calc-mode-map "jp" 'calc-select-previous) 326 (define-key calc-mode-map "jr" 'calc-rewrite-selection) 327 (define-key calc-mode-map "js" 'calc-select-here) 328 (define-key calc-mode-map "jv" 'calc-sel-evaluate) 329 (define-key calc-mode-map "ju" 'calc-unselect) 330 (define-key calc-mode-map "jC" 'calc-sel-commute) 331 (define-key calc-mode-map "jD" 'calc-sel-distribute) 332 (define-key calc-mode-map "jE" 'calc-sel-jump-equals) 333 (define-key calc-mode-map "jI" 'calc-sel-isolate) 334 (define-key calc-mode-map "jJ" 'calc-conj) 335 (define-key calc-mode-map "jL" 'calc-commute-left) 336 (define-key calc-mode-map "jM" 'calc-sel-merge) 337 (define-key calc-mode-map "jN" 'calc-sel-negate) 338 (define-key calc-mode-map "jO" 'calc-select-once-maybe) 339 (define-key calc-mode-map "jR" 'calc-commute-right) 340 (define-key calc-mode-map "jS" 'calc-select-here-maybe) 341 (define-key calc-mode-map "jU" 'calc-sel-unpack) 342 (define-key calc-mode-map "j&" 'calc-sel-invert) 343 (define-key calc-mode-map "j\r" 'calc-copy-selection) 344 (define-key calc-mode-map "j\n" 'calc-copy-selection) 345 (define-key calc-mode-map "j\010" 'calc-del-selection) 346 (define-key calc-mode-map "j\177" 'calc-del-selection) 347 (define-key calc-mode-map "j'" 'calc-enter-selection) 348 (define-key calc-mode-map "j`" 'calc-edit-selection) 349 (define-key calc-mode-map "j+" 'calc-sel-add-both-sides) 350 (define-key calc-mode-map "j-" 'calc-sel-sub-both-sides) 351 (define-key calc-mode-map "j*" 'calc-sel-mult-both-sides) 352 (define-key calc-mode-map "j/" 'calc-sel-div-both-sides) 353 (define-key calc-mode-map "j\"" 'calc-sel-expand-formula) 354 355 (define-key calc-mode-map "k" nil) 356 (define-key calc-mode-map "k?" 'calc-k-prefix-help) 357 (define-key calc-mode-map "ka" 'calc-random-again) 358 (define-key calc-mode-map "kb" 'calc-bernoulli-number) 359 (define-key calc-mode-map "kc" 'calc-choose) 360 (define-key calc-mode-map "kd" 'calc-double-factorial) 361 (define-key calc-mode-map "ke" 'calc-euler-number) 362 (define-key calc-mode-map "kf" 'calc-prime-factors) 363 (define-key calc-mode-map "kg" 'calc-gcd) 364 (define-key calc-mode-map "kh" 'calc-shuffle) 365 (define-key calc-mode-map "kl" 'calc-lcm) 366 (define-key calc-mode-map "km" 'calc-moebius) 367 (define-key calc-mode-map "kn" 'calc-next-prime) 368 (define-key calc-mode-map "kp" 'calc-prime-test) 369 (define-key calc-mode-map "kr" 'calc-random) 370 (define-key calc-mode-map "ks" 'calc-stirling-number) 371 (define-key calc-mode-map "kt" 'calc-totient) 372 (define-key calc-mode-map "kB" 'calc-utpb) 373 (define-key calc-mode-map "kC" 'calc-utpc) 374 (define-key calc-mode-map "kE" 'calc-extended-gcd) 375 (define-key calc-mode-map "kF" 'calc-utpf) 376 (define-key calc-mode-map "kK" 'calc-keep-args) 377 (define-key calc-mode-map "kN" 'calc-utpn) 378 (define-key calc-mode-map "kP" 'calc-utpp) 379 (define-key calc-mode-map "kT" 'calc-utpt) 380 381 (define-key calc-mode-map "m" nil) 382 (define-key calc-mode-map "m?" 'calc-m-prefix-help) 383 (define-key calc-mode-map "ma" 'calc-algebraic-mode) 384 (define-key calc-mode-map "md" 'calc-degrees-mode) 385 (define-key calc-mode-map "me" 'calc-embedded-preserve-modes) 386 (define-key calc-mode-map "mf" 'calc-frac-mode) 387 (define-key calc-mode-map "mg" 'calc-get-modes) 388 (define-key calc-mode-map "mh" 'calc-hms-mode) 389 (define-key calc-mode-map "mi" 'calc-infinite-mode) 390 (define-key calc-mode-map "mm" 'calc-save-modes) 391 (define-key calc-mode-map "mp" 'calc-polar-mode) 392 (define-key calc-mode-map "mr" 'calc-radians-mode) 393 (define-key calc-mode-map "ms" 'calc-symbolic-mode) 394 (define-key calc-mode-map "mt" 'calc-total-algebraic-mode) 395 (define-key calc-mode-map "\emt" 'calc-total-algebraic-mode) 396 (define-key calc-mode-map "\em\et" 'calc-total-algebraic-mode) 397 (define-key calc-mode-map "mv" 'calc-matrix-mode) 398 (define-key calc-mode-map "mw" 'calc-working) 399 (define-key calc-mode-map "mx" 'calc-always-load-extensions) 400 (define-key calc-mode-map "mA" 'calc-alg-simplify-mode) 401 (define-key calc-mode-map "mB" 'calc-bin-simplify-mode) 402 (define-key calc-mode-map "mC" 'calc-auto-recompute) 403 (define-key calc-mode-map "mD" 'calc-default-simplify-mode) 404 (define-key calc-mode-map "mE" 'calc-ext-simplify-mode) 405 (define-key calc-mode-map "mF" 'calc-settings-file-name) 406 (define-key calc-mode-map "mM" 'calc-more-recursion-depth) 407 (define-key calc-mode-map "mN" 'calc-num-simplify-mode) 408 (define-key calc-mode-map "mO" 'calc-no-simplify-mode) 409 (define-key calc-mode-map "mR" 'calc-mode-record-mode) 410 (define-key calc-mode-map "mS" 'calc-shift-prefix) 411 (define-key calc-mode-map "mU" 'calc-units-simplify-mode) 412 (define-key calc-mode-map "mX" 'calc-load-everything) 413 414 (define-key calc-mode-map "r" nil) 415 (define-key calc-mode-map "r?" 'calc-r-prefix-help) 416 417 (define-key calc-mode-map "s" nil) 418 (define-key calc-mode-map "s?" 'calc-s-prefix-help) 419 (define-key calc-mode-map "sc" 'calc-copy-variable) 420 (define-key calc-mode-map "sd" 'calc-declare-variable) 421 (define-key calc-mode-map "se" 'calc-edit-variable) 422 (define-key calc-mode-map "si" 'calc-insert-variables) 423 (define-key calc-mode-map "sk" 'calc-copy-special-constant) 424 (define-key calc-mode-map "sl" 'calc-let) 425 (define-key calc-mode-map "sm" 'calc-store-map) 426 (define-key calc-mode-map "sn" 'calc-store-neg) 427 (define-key calc-mode-map "sp" 'calc-permanent-variable) 428 (define-key calc-mode-map "sr" 'calc-recall) 429 (define-key calc-mode-map "ss" 'calc-store) 430 (define-key calc-mode-map "st" 'calc-store-into) 431 (define-key calc-mode-map "su" 'calc-unstore) 432 (define-key calc-mode-map "sx" 'calc-store-exchange) 433 (define-key calc-mode-map "sA" 'calc-edit-AlgSimpRules) 434 (define-key calc-mode-map "sD" 'calc-edit-Decls) 435 (define-key calc-mode-map "sE" 'calc-edit-EvalRules) 436 (define-key calc-mode-map "sF" 'calc-edit-FitRules) 437 (define-key calc-mode-map "sG" 'calc-edit-GenCount) 438 (define-key calc-mode-map "sH" 'calc-edit-Holidays) 439 (define-key calc-mode-map "sI" 'calc-edit-IntegLimit) 440 (define-key calc-mode-map "sL" 'calc-edit-LineStyles) 441 (define-key calc-mode-map "sP" 'calc-edit-PointStyles) 442 (define-key calc-mode-map "sR" 'calc-edit-PlotRejects) 443 (define-key calc-mode-map "sS" 'calc-sin) 444 (define-key calc-mode-map "sT" 'calc-edit-TimeZone) 445 (define-key calc-mode-map "sU" 'calc-edit-Units) 446 (define-key calc-mode-map "sX" 'calc-edit-ExtSimpRules) 447 (define-key calc-mode-map "s+" 'calc-store-plus) 448 (define-key calc-mode-map "s-" 'calc-store-minus) 449 (define-key calc-mode-map "s*" 'calc-store-times) 450 (define-key calc-mode-map "s/" 'calc-store-div) 451 (define-key calc-mode-map "s^" 'calc-store-power) 452 (define-key calc-mode-map "s|" 'calc-store-concat) 453 (define-key calc-mode-map "s&" 'calc-store-inv) 454 (define-key calc-mode-map "s[" 'calc-store-decr) 455 (define-key calc-mode-map "s]" 'calc-store-incr) 456 (define-key calc-mode-map "s:" 'calc-assign) 457 (define-key calc-mode-map "s=" 'calc-evalto) 458 459 (define-key calc-mode-map "t" nil) 460 (define-key calc-mode-map "t?" 'calc-t-prefix-help) 461 (define-key calc-mode-map "tb" 'calc-trail-backward) 462 (define-key calc-mode-map "td" 'calc-trail-display) 463 (define-key calc-mode-map "tf" 'calc-trail-forward) 464 (define-key calc-mode-map "th" 'calc-trail-here) 465 (define-key calc-mode-map "ti" 'calc-trail-in) 466 (define-key calc-mode-map "tk" 'calc-trail-kill) 467 (define-key calc-mode-map "tm" 'calc-trail-marker) 468 (define-key calc-mode-map "tn" 'calc-trail-next) 469 (define-key calc-mode-map "to" 'calc-trail-out) 470 (define-key calc-mode-map "tp" 'calc-trail-previous) 471 (define-key calc-mode-map "tr" 'calc-trail-isearch-backward) 472 (define-key calc-mode-map "ts" 'calc-trail-isearch-forward) 473 (define-key calc-mode-map "ty" 'calc-trail-yank) 474 (define-key calc-mode-map "t[" 'calc-trail-first) 475 (define-key calc-mode-map "t]" 'calc-trail-last) 476 (define-key calc-mode-map "t<" 'calc-trail-scroll-left) 477 (define-key calc-mode-map "t>" 'calc-trail-scroll-right) 478 (define-key calc-mode-map "t{" 'calc-trail-backward) 479 (define-key calc-mode-map "t}" 'calc-trail-forward) 480 (define-key calc-mode-map "t." 'calc-full-trail-vectors) 481 (define-key calc-mode-map "tC" 'calc-convert-time-zones) 482 (define-key calc-mode-map "tD" 'calc-date) 483 (define-key calc-mode-map "tI" 'calc-inc-month) 484 (define-key calc-mode-map "tJ" 'calc-julian) 485 (define-key calc-mode-map "tM" 'calc-new-month) 486 (define-key calc-mode-map "tN" 'calc-now) 487 (define-key calc-mode-map "tP" 'calc-date-part) 488 (define-key calc-mode-map "tT" 'calc-tan) 489 (define-key calc-mode-map "tU" 'calc-unix-time) 490 (define-key calc-mode-map "tW" 'calc-new-week) 491 (define-key calc-mode-map "tY" 'calc-new-year) 492 (define-key calc-mode-map "tZ" 'calc-time-zone) 493 (define-key calc-mode-map "t+" 'calc-business-days-plus) 494 (define-key calc-mode-map "t-" 'calc-business-days-minus) 495 496 (define-key calc-mode-map "u" 'nil) 497 (define-key calc-mode-map "u?" 'calc-u-prefix-help) 498 (define-key calc-mode-map "ua" 'calc-autorange-units) 499 (define-key calc-mode-map "ub" 'calc-base-units) 500 (define-key calc-mode-map "uc" 'calc-convert-units) 501 (define-key calc-mode-map "ud" 'calc-define-unit) 502 (define-key calc-mode-map "ue" 'calc-explain-units) 503 (define-key calc-mode-map "ug" 'calc-get-unit-definition) 504 (define-key calc-mode-map "up" 'calc-permanent-units) 505 (define-key calc-mode-map "ur" 'calc-remove-units) 506 (define-key calc-mode-map "us" 'calc-simplify-units) 507 (define-key calc-mode-map "ut" 'calc-convert-temperature) 508 (define-key calc-mode-map "uu" 'calc-undefine-unit) 509 (define-key calc-mode-map "uv" 'calc-enter-units-table) 510 (define-key calc-mode-map "ux" 'calc-extract-units) 511 (define-key calc-mode-map "uV" 'calc-view-units-table) 512 (define-key calc-mode-map "uC" 'calc-vector-covariance) 513 (define-key calc-mode-map "uG" 'calc-vector-geometric-mean) 514 (define-key calc-mode-map "uM" 'calc-vector-mean) 515 (define-key calc-mode-map "uN" 'calc-vector-min) 516 (define-key calc-mode-map "uS" 'calc-vector-sdev) 517 (define-key calc-mode-map "uU" 'calc-undo) 518 (define-key calc-mode-map "uX" 'calc-vector-max) 519 (define-key calc-mode-map "u#" 'calc-vector-count) 520 (define-key calc-mode-map "u+" 'calc-vector-sum) 521 (define-key calc-mode-map "u*" 'calc-vector-product) 522 523 (define-key calc-mode-map "v" 'nil) 524 (define-key calc-mode-map "v?" 'calc-v-prefix-help) 525 (define-key calc-mode-map "va" 'calc-arrange-vector) 526 (define-key calc-mode-map "vb" 'calc-build-vector) 527 (define-key calc-mode-map "vc" 'calc-mcol) 528 (define-key calc-mode-map "vd" 'calc-diag) 529 (define-key calc-mode-map "ve" 'calc-expand-vector) 530 (define-key calc-mode-map "vf" 'calc-vector-find) 531 (define-key calc-mode-map "vh" 'calc-head) 532 (define-key calc-mode-map "vi" 'calc-ident) 533 (define-key calc-mode-map "vk" 'calc-cons) 534 (define-key calc-mode-map "vl" 'calc-vlength) 535 (define-key calc-mode-map "vm" 'calc-mask-vector) 536 (define-key calc-mode-map "vn" 'calc-rnorm) 537 (define-key calc-mode-map "vp" 'calc-pack) 538 (define-key calc-mode-map "vr" 'calc-mrow) 539 (define-key calc-mode-map "vs" 'calc-subvector) 540 (define-key calc-mode-map "vt" 'calc-transpose) 541 (define-key calc-mode-map "vu" 'calc-unpack) 542 (define-key calc-mode-map "vv" 'calc-reverse-vector) 543 (define-key calc-mode-map "vx" 'calc-index) 544 (define-key calc-mode-map "vA" 'calc-apply) 545 (define-key calc-mode-map "vC" 'calc-cross) 546 (define-key calc-mode-map "vD" 'calc-mdet) 547 (define-key calc-mode-map "vE" 'calc-set-enumerate) 548 (define-key calc-mode-map "vF" 'calc-set-floor) 549 (define-key calc-mode-map "vG" 'calc-grade) 550 (define-key calc-mode-map "vH" 'calc-histogram) 551 (define-key calc-mode-map "vI" 'calc-inner-product) 552 (define-key calc-mode-map "vJ" 'calc-conj-transpose) 553 (define-key calc-mode-map "vL" 'calc-mlud) 554 (define-key calc-mode-map "vM" 'calc-map) 555 (define-key calc-mode-map "vN" 'calc-cnorm) 556 (define-key calc-mode-map "vO" 'calc-outer-product) 557 (define-key calc-mode-map "vR" 'calc-reduce) 558 (define-key calc-mode-map "vS" 'calc-sort) 559 (define-key calc-mode-map "vT" 'calc-mtrace) 560 (define-key calc-mode-map "vU" 'calc-accumulate) 561 (define-key calc-mode-map "vV" 'calc-set-union) 562 (define-key calc-mode-map "vX" 'calc-set-xor) 563 (define-key calc-mode-map "v^" 'calc-set-intersect) 564 (define-key calc-mode-map "v-" 'calc-set-difference) 565 (define-key calc-mode-map "v~" 'calc-set-complement) 566 (define-key calc-mode-map "v:" 'calc-set-span) 567 (define-key calc-mode-map "v#" 'calc-set-cardinality) 568 (define-key calc-mode-map "v+" 'calc-remove-duplicates) 569 (define-key calc-mode-map "v&" 'calc-inv) 570 (define-key calc-mode-map "v<" 'calc-matrix-left-justify) 571 (define-key calc-mode-map "v=" 'calc-matrix-center-justify) 572 (define-key calc-mode-map "v>" 'calc-matrix-right-justify) 573 (define-key calc-mode-map "v." 'calc-full-vectors) 574 (define-key calc-mode-map "v/" 'calc-break-vectors) 575 (define-key calc-mode-map "v," 'calc-vector-commas) 576 (define-key calc-mode-map "v[" 'calc-vector-brackets) 577 (define-key calc-mode-map "v]" 'calc-matrix-brackets) 578 (define-key calc-mode-map "v{" 'calc-vector-braces) 579 (define-key calc-mode-map "v}" 'calc-matrix-brackets) 580 (define-key calc-mode-map "v(" 'calc-vector-parens) 581 (define-key calc-mode-map "v)" 'calc-matrix-brackets) 582 ;; We can't rely on the automatic upper->lower conversion because 583 ;; in the global map V is explicitly bound, so we need to bind it 584 ;; explicitly as well :-( --stef 585 (define-key calc-mode-map "V" (lookup-key calc-mode-map "v")) 586 587 (define-key calc-mode-map "z" 'nil) 588 (define-key calc-mode-map "z?" 'calc-z-prefix-help) 589 590 (define-key calc-mode-map "Z" 'nil) 591 (define-key calc-mode-map "Z?" 'calc-shift-Z-prefix-help) 592 (define-key calc-mode-map "ZC" 'calc-user-define-composition) 593 (define-key calc-mode-map "ZD" 'calc-user-define) 594 (define-key calc-mode-map "ZE" 'calc-user-define-edit) 595 (define-key calc-mode-map "ZF" 'calc-user-define-formula) 596 (define-key calc-mode-map "ZG" 'calc-get-user-defn) 597 (define-key calc-mode-map "ZI" 'calc-user-define-invocation) 598 (define-key calc-mode-map "ZK" 'calc-user-define-kbd-macro) 599 (define-key calc-mode-map "ZP" 'calc-user-define-permanent) 600 (define-key calc-mode-map "ZS" 'calc-edit-user-syntax) 601 (define-key calc-mode-map "ZT" 'calc-timing) 602 (define-key calc-mode-map "ZU" 'calc-user-undefine) 603 (define-key calc-mode-map "Z[" 'calc-kbd-if) 604 (define-key calc-mode-map "Z:" 'calc-kbd-else) 605 (define-key calc-mode-map "Z|" 'calc-kbd-else-if) 606 (define-key calc-mode-map "Z]" 'calc-kbd-end-if) 607 (define-key calc-mode-map "Z<" 'calc-kbd-repeat) 608 (define-key calc-mode-map "Z>" 'calc-kbd-end-repeat) 609 (define-key calc-mode-map "Z(" 'calc-kbd-for) 610 (define-key calc-mode-map "Z)" 'calc-kbd-end-for) 611 (define-key calc-mode-map "Z{" 'calc-kbd-loop) 612 (define-key calc-mode-map "Z}" 'calc-kbd-end-loop) 613 (define-key calc-mode-map "Z/" 'calc-kbd-break) 614 (define-key calc-mode-map "Z`" 'calc-kbd-push) 615 (define-key calc-mode-map "Z'" 'calc-kbd-pop) 616 (define-key calc-mode-map "Z=" 'calc-kbd-report) 617 (define-key calc-mode-map "Z#" 'calc-kbd-query) 618 619 (calc-init-prefixes) 620 621 (mapcar (function 622 (lambda (x) 623 (define-key calc-mode-map (format "c%c" x) 'calc-clean-num) 624 (define-key calc-mode-map (format "j%c" x) 'calc-select-part) 625 (define-key calc-mode-map (format "r%c" x) 'calc-recall-quick) 626 (define-key calc-mode-map (format "s%c" x) 'calc-store-quick) 627 (define-key calc-mode-map (format "t%c" x) 'calc-store-into-quick) 628 (define-key calc-mode-map (format "u%c" x) 'calc-quick-units))) 629 "0123456789") 630 631 (let ((i ?A)) 632 (while (<= i ?z) 633 (if (eq (car-safe (aref (nth 1 calc-mode-map) i)) 'keymap) 634 (aset (nth 1 calc-mode-map) i 635 (cons 'keymap (cons (cons ?\e (aref (nth 1 calc-mode-map) i)) 636 (cdr (aref (nth 1 calc-mode-map) i)))))) 637 (setq i (1+ i)))) 638 639 (setq calc-alg-map (copy-keymap calc-mode-map) 640 calc-alg-esc-map (copy-keymap esc-map)) 641 (let ((i 32)) 642 (while (< i 127) 643 (or (memq i '(?' ?` ?= ??)) 644 (aset (nth 1 calc-alg-map) i 'calc-auto-algebraic-entry)) 645 (or (memq i '(?# ?x ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9)) 646 (aset (nth 1 calc-alg-esc-map) i (aref (nth 1 calc-mode-map) i))) 647 (setq i (1+ i)))) 648 (define-key calc-alg-map "\e" calc-alg-esc-map) 649 (define-key calc-alg-map "\e\t" 'calc-roll-up) 650 (define-key calc-alg-map "\e\C-m" 'calc-last-args-stub) 651 (define-key calc-alg-map "\e\177" 'calc-pop-above) 652 653;;;; (Autoloads here) 654 (mapcar (function (lambda (x) 655 (mapcar (function (lambda (func) 656 (autoload func (car x)))) (cdr x)))) 657 '( 658 659 ("calc-alg" calc-has-rules math-defsimplify 660calc-modify-simplify-mode calcFunc-collect calcFunc-esimplify 661calcFunc-islin calcFunc-islinnt calcFunc-lin calcFunc-linnt 662calcFunc-simplify calcFunc-subst calcFunc-powerexpand math-beforep 663math-build-polynomial-expr math-expand-formula math-expr-contains 664math-expr-contains-count math-expr-depends math-expr-height 665math-expr-subst math-expr-weight math-integer-plus math-is-linear 666math-is-multiple math-is-polynomial math-linear-in math-multiple-of 667math-poly-depends math-poly-mix math-poly-mul 668math-poly-simplify math-poly-zerop math-polynomial-base 669math-polynomial-p math-recompile-eval-rules math-simplify 670math-simplify-exp math-simplify-extended math-simplify-sqrt 671math-to-simple-fraction) 672 673 ("calcalg2" calcFunc-asum calcFunc-deriv 674calcFunc-ffinv calcFunc-finv calcFunc-fsolve calcFunc-gpoly 675calcFunc-integ calcFunc-poly calcFunc-prod calcFunc-roots 676calcFunc-solve calcFunc-sum calcFunc-table calcFunc-taylor 677calcFunc-tderiv math-expr-calls math-integral-q02 math-integral-q12 678math-integral-rational-funcs math-lcm-denoms math-looks-evenp 679math-poly-all-roots math-prod-rec math-reject-solution math-solve-eqn 680math-solve-for math-sum-rec math-try-integral) 681 682 ("calcalg3" calcFunc-efit calcFunc-fit 683calcFunc-fitdummy calcFunc-fitparam calcFunc-fitvar 684calcFunc-hasfitparams calcFunc-hasfitvars calcFunc-maximize 685calcFunc-minimize calcFunc-ninteg calcFunc-polint calcFunc-ratint 686calcFunc-root calcFunc-wmaximize calcFunc-wminimize calcFunc-wroot 687calcFunc-xfit math-find-minimum math-find-root math-ninteg-evaluate 688math-ninteg-midpoint math-ninteg-romberg math-poly-interp) 689 690 ("calc-arith" calcFunc-abs calcFunc-abssqr 691calcFunc-add calcFunc-ceil calcFunc-decr calcFunc-deven calcFunc-dimag 692calcFunc-dint calcFunc-div calcFunc-dnatnum calcFunc-dneg 693calcFunc-dnonneg calcFunc-dnonzero calcFunc-dnumint calcFunc-dodd 694calcFunc-dpos calcFunc-drange calcFunc-drat calcFunc-dreal 695calcFunc-dscalar calcFunc-fceil calcFunc-ffloor calcFunc-float 696calcFunc-fround calcFunc-frounde calcFunc-froundu calcFunc-ftrunc 697calcFunc-idiv calcFunc-incr calcFunc-ldiv calcFunc-mant calcFunc-max calcFunc-min 698calcFunc-mod calcFunc-mul calcFunc-neg calcFunc-percent calcFunc-pow 699calcFunc-relch calcFunc-round calcFunc-rounde calcFunc-roundu 700calcFunc-scf calcFunc-sub calcFunc-xpon math-abs math-abs-approx 701math-add-objects-fancy math-add-or-sub math-add-symb-fancy 702math-ceiling math-combine-prod math-combine-sum math-div-by-zero 703math-div-objects-fancy math-div-symb-fancy math-div-zero 704math-float-fancy math-floor-fancy math-floor-special math-guess-if-neg 705math-intv-constp math-known-evenp math-known-imagp math-known-integerp 706math-known-matrixp math-known-negp math-known-nonnegp 707math-known-nonposp math-known-nonzerop math-known-num-integerp 708math-known-oddp math-known-posp math-known-realp math-known-scalarp 709math-max math-min math-mod-fancy math-mul-float math-mul-objects-fancy 710math-mul-or-div math-mul-symb-fancy math-mul-zero math-neg-fancy 711math-neg-float math-okay-neg math-possible-signs math-possible-types 712math-pow-fancy math-pow-mod math-pow-of-zero math-pow-zero 713math-quarter-integer math-round math-setup-declarations math-sqr 714math-sqr-float math-trunc-fancy math-trunc-special) 715 716 ("calc-bin" calcFunc-and calcFunc-ash 717calcFunc-clip calcFunc-diff calcFunc-lsh calcFunc-not calcFunc-or 718calcFunc-rash calcFunc-rot calcFunc-rsh calcFunc-xor math-clip 719math-compute-max-digits math-convert-radix-digits math-float-parts 720math-format-bignum-binary math-format-bignum-hex 721math-format-bignum-octal math-format-bignum-radix math-format-binary 722math-format-radix math-format-radix-float math-integer-log2 723math-power-of-2 math-radix-float-power) 724 725 ("calc-comb" calc-report-prime-test 726calcFunc-choose calcFunc-dfact calcFunc-egcd calcFunc-fact 727calcFunc-gcd calcFunc-lcm calcFunc-moebius calcFunc-nextprime 728calcFunc-perm calcFunc-prevprime calcFunc-prfac calcFunc-prime 729calcFunc-random calcFunc-shuffle calcFunc-stir1 calcFunc-stir2 730calcFunc-totient math-init-random-base math-member math-prime-test 731math-random-base) 732 733 ("calccomp" calcFunc-cascent calcFunc-cdescent 734calcFunc-cheight calcFunc-cwidth math-comp-ascent math-comp-descent 735math-comp-height math-comp-width math-compose-expr 736math-composition-to-string math-stack-value-offset-fancy 737math-vector-is-string math-vector-to-string) 738 739 ("calc-cplx" calcFunc-arg calcFunc-conj 740calcFunc-im calcFunc-polar calcFunc-re calcFunc-rect math-complex 741math-fix-circular math-imaginary math-imaginary-i math-normalize-polar 742math-polar math-want-polar) 743 744 ("calc-embed" calc-do-embedded 745calc-do-embedded-activate calc-embedded-evaluate-expr 746calc-embedded-modes-change calc-embedded-var-change 747calc-embedded-preserve-modes) 748 749 ("calc-fin" calc-to-percentage calcFunc-ddb 750calcFunc-fv calcFunc-fvb calcFunc-fvl calcFunc-irr calcFunc-irrb 751calcFunc-nper calcFunc-nperb calcFunc-nperl calcFunc-npv calcFunc-npvb 752calcFunc-pmt calcFunc-pmtb calcFunc-pv calcFunc-pvb calcFunc-pvl 753calcFunc-rate calcFunc-rateb calcFunc-ratel calcFunc-sln calcFunc-syd) 754 755 ("calc-forms" calcFunc-badd calcFunc-bsub 756calcFunc-date calcFunc-day calcFunc-dsadj calcFunc-hms 757calcFunc-holiday calcFunc-hour calcFunc-incmonth calcFunc-incyear 758calcFunc-intv calcFunc-julian calcFunc-makemod calcFunc-minute 759calcFunc-month calcFunc-newmonth calcFunc-newweek calcFunc-newyear 760calcFunc-now calcFunc-pwday calcFunc-sdev calcFunc-second 761calcFunc-time calcFunc-tzconv calcFunc-tzone calcFunc-unixtime 762calcFunc-weekday calcFunc-year calcFunc-yearday math-combine-intervals 763math-date-parts math-date-to-dt math-div-mod math-dt-to-date 764math-format-date math-from-business-day math-from-hms math-make-intv 765math-make-mod math-make-sdev math-mod-intv math-normalize-hms 766math-normalize-mod math-parse-date math-read-angle-brackets 767math-setup-add-holidays math-setup-holidays math-setup-year-holidays 768math-sort-intv math-to-business-day math-to-hms) 769 770 ("calc-frac" calc-add-fractions 771calc-div-fractions calc-mul-fractions calcFunc-fdiv calcFunc-frac 772math-make-frac) 773 774 ("calc-funcs" calc-prob-dist calcFunc-bern 775calcFunc-besJ calcFunc-besY calcFunc-beta calcFunc-betaB 776calcFunc-betaI calcFunc-erf calcFunc-erfc calcFunc-euler 777calcFunc-gamma calcFunc-gammaG calcFunc-gammaP calcFunc-gammaQ 778calcFunc-gammag calcFunc-ltpb calcFunc-ltpc calcFunc-ltpf 779calcFunc-ltpn calcFunc-ltpp calcFunc-ltpt calcFunc-utpb calcFunc-utpc 780calcFunc-utpf calcFunc-utpn calcFunc-utpp calcFunc-utpt 781math-bernoulli-number math-gammap1-raw) 782 783 ("calc-graph" calc-graph-show-tty) 784 785 ("calc-incom" calc-digit-dots) 786 787 ("calc-keypd" calc-do-keypad 788calc-keypad-x-left-click calc-keypad-x-middle-click 789calc-keypad-x-right-click) 790 791 ("calc-lang" calc-set-language 792math-read-big-balance math-read-big-rec) 793 794 ("calc-map" calc-get-operator calcFunc-accum 795calcFunc-afixp calcFunc-anest calcFunc-apply calcFunc-call 796calcFunc-fixp calcFunc-inner calcFunc-map calcFunc-mapa calcFunc-mapc 797calcFunc-mapd calcFunc-mapeq calcFunc-mapeqp calcFunc-mapeqr 798calcFunc-mapr calcFunc-nest calcFunc-outer calcFunc-raccum 799calcFunc-reduce calcFunc-reducea calcFunc-reducec calcFunc-reduced 800calcFunc-reducer calcFunc-rreduce calcFunc-rreducea calcFunc-rreducec 801calcFunc-rreduced calcFunc-rreducer math-build-call 802math-calcFunc-to-var math-multi-subst math-multi-subst-rec 803math-var-to-calcFunc) 804 805 ("calc-mtx" calcFunc-det calcFunc-lud calcFunc-tr 806math-col-matrix math-lud-solve math-matrix-inv-raw math-matrix-lud 807math-mul-mat-vec math-mul-mats math-row-matrix) 808 809 ("calc-math" calcFunc-alog calcFunc-arccos 810calcFunc-arccosh calcFunc-arcsin calcFunc-arcsincos calcFunc-arcsinh 811calcFunc-arctan calcFunc-arctan2 calcFunc-arctanh calcFunc-csc 812calcFunc-csch calcFunc-cos calcFunc-cosh calcFunc-cot calcFunc-coth 813calcFunc-deg calcFunc-exp calcFunc-exp10 calcFunc-expm1 814calcFunc-hypot calcFunc-ilog calcFunc-isqrt calcFunc-ln calcFunc-lnp1 815calcFunc-log calcFunc-log10 calcFunc-nroot calcFunc-rad calcFunc-sec 816calcFunc-sech calcFunc-sin 817calcFunc-sincos calcFunc-sinh calcFunc-sqr calcFunc-sqrt calcFunc-tan 818calcFunc-tanh math-arccos-raw math-arcsin-raw math-arctan-raw 819math-arctan2-raw math-cos-raw math-cot-raw math-csc-raw 820math-exp-minus-1-raw math-exp-raw 821math-from-radians math-from-radians-2 math-hypot math-infinite-dir 822math-isqrt-small math-ln-raw math-nearly-equal math-nearly-equal-float 823math-nearly-zerop math-nearly-zerop-float math-nth-root 824math-sin-cos-raw math-sin-raw math-sqrt math-sqrt-float math-sqrt-raw 825math-tan-raw math-to-radians math-to-radians-2) 826 827 ("calc-mode" math-get-modes-vec) 828 829 ("calc-poly" calcFunc-apart calcFunc-expand 830calcFunc-expandpow calcFunc-factor calcFunc-factors calcFunc-nrat 831calcFunc-pcont calcFunc-pdeg calcFunc-pdiv calcFunc-pdivide 832calcFunc-pdivrem calcFunc-pgcd calcFunc-plead calcFunc-pprim 833calcFunc-prem math-accum-factors math-atomic-factorp 834math-div-poly-const math-div-thru math-expand-power math-expand-term 835math-factor-contains math-factor-expr math-factor-expr-part 836math-factor-expr-try math-factor-finish math-factor-poly-coefs 837math-factor-protect math-mul-thru math-padded-polynomial 838math-partial-fractions math-poly-degree math-poly-deriv-coefs 839math-poly-gcd-frac-list math-poly-modulus-rec math-ratpoly-p 840math-to-ratpoly math-to-ratpoly-rec) 841 842 ("calc-prog" calc-default-formula-arglist 843calc-execute-kbd-macro calc-finish-user-syntax-edit 844calc-fix-token-name calc-fix-user-formula calc-read-parse-table 845calc-read-parse-table-part calc-subsetp calc-write-parse-table 846calc-write-parse-table-part calcFunc-constant calcFunc-eq calcFunc-geq 847calcFunc-gt calcFunc-if calcFunc-in calcFunc-integer calcFunc-istrue 848calcFunc-land calcFunc-leq calcFunc-lnot calcFunc-lor calcFunc-lt 849calcFunc-negative calcFunc-neq calcFunc-nonvar calcFunc-real 850calcFunc-refers calcFunc-rmeq calcFunc-typeof calcFunc-variable 851math-body-refers-to math-break math-composite-inequalities 852math-do-defmath math-handle-for math-handle-foreach 853math-normalize-logical-op math-return) 854 855 ("calc-rewr" calcFunc-match calcFunc-matches 856calcFunc-matchnot calcFunc-rewrite calcFunc-vmatches 857math-apply-rewrites math-compile-patterns math-compile-rewrites 858math-flatten-lands math-match-patterns math-rewrite 859math-rewrite-heads) 860 861 ("calc-rules" calc-CommuteRules calc-DistribRules calc-FactorRules 862calc-FitRules calc-IntegAfterRules calc-InvertRules calc-JumpRules 863calc-MergeRules calc-NegateRules 864calc-compile-rule-set) 865 866 ("calc-sel" calc-auto-selection 867calc-delete-selection calc-encase-atoms calc-find-assoc-parent-formula 868calc-find-parent-formula calc-find-sub-formula calc-prepare-selection 869calc-preserve-point calc-replace-selections calc-replace-sub-formula 870calc-roll-down-with-selections calc-roll-up-with-selections 871calc-sel-error) 872 873 ("calc-stat" calc-vector-op calcFunc-agmean 874calcFunc-vcorr calcFunc-vcount calcFunc-vcov calcFunc-vflat 875calcFunc-vgmean calcFunc-vhmean calcFunc-vmax calcFunc-vmean 876calcFunc-vmeane calcFunc-vmedian calcFunc-vmin calcFunc-vpcov 877calcFunc-vprod calcFunc-vpsdev calcFunc-vpvar calcFunc-vsdev 878calcFunc-vsum calcFunc-vvar math-flatten-many-vecs) 879 880 ("calc-store" calc-read-var-name 881calc-store-value calc-var-name) 882 883 ("calc-stuff" calc-explain-why calcFunc-clean 884calcFunc-pclean calcFunc-pfloat calcFunc-pfrac) 885 886 ("calc-units" calcFunc-usimplify 887math-build-units-table math-build-units-table-buffer 888math-check-unit-name math-convert-temperature math-convert-units 889math-extract-units math-remove-units math-simplify-units 890math-single-units-in-expr-p math-to-standard-units 891math-units-in-expr-p) 892 893 ("calc-vec" calcFunc-append calcFunc-appendrev 894calcFunc-arrange calcFunc-cnorm calcFunc-cons calcFunc-cross 895calcFunc-ctrn calcFunc-cvec calcFunc-diag calcFunc-find 896calcFunc-getdiag calcFunc-grade calcFunc-head calcFunc-histogram 897calcFunc-idn calcFunc-index calcFunc-mcol calcFunc-mdims 898calcFunc-mrcol calcFunc-mrow calcFunc-mrrow calcFunc-pack 899calcFunc-rcons calcFunc-rdup calcFunc-rev calcFunc-rgrade 900calcFunc-rhead calcFunc-rnorm calcFunc-rsort calcFunc-rsubvec 901calcFunc-rtail calcFunc-sort calcFunc-subscr calcFunc-subvec 902calcFunc-tail calcFunc-trn calcFunc-unpack calcFunc-unpackt 903calcFunc-vcard calcFunc-vcompl calcFunc-vconcat calcFunc-vconcatrev 904calcFunc-vdiff calcFunc-vec calcFunc-venum calcFunc-vexp 905calcFunc-vfloor calcFunc-vint calcFunc-vlen calcFunc-vmask 906calcFunc-vpack calcFunc-vspan calcFunc-vunion calcFunc-vunpack 907calcFunc-vxor math-check-for-commas math-clean-set math-copy-matrix 908math-dimension-error math-dot-product math-flatten-vector math-map-vec 909math-map-vec-2 math-mat-col math-mimic-ident math-prepare-set 910math-read-brackets math-reduce-cols math-reduce-vec math-transpose) 911 912 ("calc-yank" calc-alg-edit calc-clean-newlines 913calc-do-grab-rectangle calc-do-grab-region calc-finish-stack-edit 914calc-force-refresh calc-locate-cursor-element calc-show-edit-buffer) 915 916)) 917 918 (mapcar (function (lambda (x) 919 (mapcar (function (lambda (cmd) 920 (autoload cmd (car x) nil t))) (cdr x)))) 921 '( 922 923 ("calc-alg" calc-alg-evaluate calc-apart calc-collect calc-expand 924calc-expand-formula calc-factor calc-normalize-rat calc-poly-div 925calc-poly-div-rem calc-poly-gcd calc-poly-rem calc-simplify 926calc-simplify-extended calc-substitute calc-powerexpand) 927 928 ("calcalg2" calc-alt-summation calc-derivative 929calc-dump-integral-cache calc-integral calc-num-integral 930calc-poly-roots calc-product calc-solve-for calc-summation 931calc-tabulate calc-taylor) 932 933 ("calcalg3" calc-curve-fit calc-find-maximum calc-find-minimum 934calc-find-root calc-poly-interp) 935 936 ("calc-arith" calc-abs calc-abssqr calc-ceiling calc-decrement 937calc-floor calc-idiv calc-increment calc-mant-part calc-max calc-min 938calc-round calc-scale-float calc-sign calc-trunc calc-xpon-part) 939 940 ("calc-bin" calc-and calc-binary-radix calc-clip calc-decimal-radix 941calc-diff calc-hex-radix calc-leading-zeros calc-lshift-arith 942calc-lshift-binary calc-not calc-octal-radix calc-or calc-radix 943calc-rotate-binary calc-rshift-arith calc-rshift-binary calc-word-size 944calc-xor) 945 946 ("calc-comb" calc-choose calc-double-factorial calc-extended-gcd 947calc-factorial calc-gamma calc-gcd calc-lcm calc-moebius 948calc-next-prime calc-perm calc-prev-prime calc-prime-factors 949calc-prime-test calc-random calc-random-again calc-rrandom 950calc-shuffle calc-totient) 951 952 ("calc-cplx" calc-argument calc-complex-notation calc-i-notation 953calc-im calc-j-notation calc-polar calc-polar-mode calc-re) 954 955 ("calc-embed" calc-embedded-copy-formula-as-kill 956calc-embedded-duplicate calc-embedded-edit calc-embedded-forget 957calc-embedded-kill-formula calc-embedded-mark-formula 958calc-embedded-new-formula calc-embedded-next calc-embedded-previous 959calc-embedded-select calc-embedded-update-formula calc-embedded-word 960calc-find-globals calc-show-plain) 961 962 ("calc-fin" calc-convert-percent calc-fin-ddb calc-fin-fv 963calc-fin-irr calc-fin-nper calc-fin-npv calc-fin-pmt calc-fin-pv 964calc-fin-rate calc-fin-sln calc-fin-syd calc-percent-change) 965 966 ("calc-forms" calc-business-days-minus calc-business-days-plus 967calc-convert-time-zones calc-date calc-date-notation calc-date-part 968calc-from-hms calc-hms-mode calc-hms-notation calc-inc-month 969calc-julian calc-new-month calc-new-week calc-new-year calc-now 970calc-time calc-time-zone calc-to-hms calc-unix-time) 971 972 ("calc-frac" calc-fdiv calc-frac-mode calc-fraction 973calc-over-notation calc-slash-notation) 974 975 ("calc-funcs" calc-bernoulli-number calc-bessel-J calc-bessel-Y 976calc-beta calc-erf calc-erfc calc-euler-number calc-inc-beta 977calc-inc-gamma calc-stirling-number calc-utpb calc-utpc calc-utpf 978calc-utpn calc-utpp calc-utpt) 979 980 ("calc-graph" calc-graph-add calc-graph-add-3d calc-graph-border 981calc-graph-clear calc-graph-command calc-graph-delete 982calc-graph-device calc-graph-display calc-graph-fast 983calc-graph-fast-3d calc-graph-geometry calc-graph-grid 984calc-graph-header calc-graph-hide calc-graph-juggle calc-graph-key 985calc-graph-kill calc-graph-line-style calc-graph-log-x 986calc-graph-log-y calc-graph-log-z calc-graph-name 987calc-graph-num-points calc-graph-output calc-graph-plot 988calc-graph-point-style calc-graph-print calc-graph-quit 989calc-graph-range-x calc-graph-range-y calc-graph-range-z 990calc-graph-show-dumb calc-graph-title-x calc-graph-title-y 991calc-graph-title-z calc-graph-view-commands calc-graph-view-trail 992calc-graph-zero-x calc-graph-zero-y) 993 994 ("calc-help" calc-a-prefix-help calc-b-prefix-help calc-c-prefix-help 995calc-d-prefix-help calc-describe-function calc-describe-key 996calc-describe-key-briefly calc-describe-variable calc-f-prefix-help 997calc-full-help calc-g-prefix-help calc-help-prefix 998calc-hyperbolic-prefix-help calc-inv-hyp-prefix-help 999calc-inverse-prefix-help calc-j-prefix-help calc-k-prefix-help 1000calc-m-prefix-help calc-r-prefix-help calc-s-prefix-help 1001calc-t-prefix-help calc-u-prefix-help calc-v-prefix-help) 1002 1003 ("calc-incom" calc-begin-complex calc-begin-vector calc-comma 1004calc-dots calc-end-complex calc-end-vector calc-semi) 1005 1006 ("calc-keypd" calc-keypad-menu calc-keypad-menu-back 1007calc-keypad-press) 1008 1009 ("calc-lang" calc-big-language calc-c-language calc-eqn-language 1010calc-flat-language calc-fortran-language calc-maple-language 1011calc-mathematica-language calc-normal-language calc-pascal-language 1012calc-tex-language calc-latex-language calc-unformatted-language) 1013 1014 ("calc-map" calc-accumulate calc-apply calc-inner-product calc-map 1015calc-map-equation calc-map-stack calc-outer-product calc-reduce) 1016 1017 ("calc-mtx" calc-mdet calc-mlud calc-mtrace) 1018 1019 ("calc-math" calc-arccos calc-arccosh calc-arcsin calc-arcsinh 1020calc-arctan calc-arctan2 calc-arctanh calc-conj calc-cos calc-cosh 1021calc-cot calc-coth calc-csc calc-csch 1022calc-degrees-mode calc-exp calc-expm1 calc-hypot calc-ilog 1023calc-imaginary calc-isqrt calc-ln calc-lnp1 calc-log calc-log10 1024calc-pi calc-radians-mode calc-sec calc-sech 1025calc-sin calc-sincos calc-sinh calc-sqrt 1026calc-tan calc-tanh calc-to-degrees calc-to-radians) 1027 1028 ("calc-mode" calc-alg-simplify-mode calc-algebraic-mode 1029calc-always-load-extensions calc-auto-recompute calc-auto-why 1030calc-bin-simplify-mode calc-break-vectors calc-center-justify 1031calc-default-simplify-mode calc-display-raw calc-eng-notation 1032calc-ext-simplify-mode calc-fix-notation calc-full-trail-vectors 1033calc-full-vectors calc-get-modes calc-group-char calc-group-digits 1034calc-infinite-mode calc-left-justify calc-left-label 1035calc-line-breaking calc-line-numbering calc-matrix-brackets 1036calc-matrix-center-justify calc-matrix-left-justify calc-matrix-mode 1037calc-matrix-right-justify calc-mode-record-mode calc-no-simplify-mode 1038calc-normal-notation calc-num-simplify-mode calc-point-char 1039calc-right-justify calc-right-label calc-save-modes calc-sci-notation 1040calc-settings-file-name calc-shift-prefix calc-symbolic-mode 1041calc-total-algebraic-mode calc-truncate-down calc-truncate-stack 1042calc-truncate-up calc-units-simplify-mode calc-vector-braces 1043calc-vector-brackets calc-vector-commas calc-vector-parens 1044calc-working) 1045 1046 ("calc-prog" calc-call-last-kbd-macro calc-edit-user-syntax 1047calc-equal-to calc-get-user-defn calc-greater-equal calc-greater-than 1048calc-in-set calc-kbd-break calc-kbd-else calc-kbd-else-if 1049calc-kbd-end-for calc-kbd-end-if calc-kbd-end-loop calc-kbd-end-repeat 1050calc-kbd-for calc-kbd-if calc-kbd-loop calc-kbd-pop calc-kbd-push 1051calc-kbd-query calc-kbd-repeat calc-kbd-report calc-less-equal 1052calc-less-than calc-logical-and calc-logical-if calc-logical-not 1053calc-logical-or calc-not-equal-to calc-pass-errors calc-remove-equal 1054calc-timing calc-user-define calc-user-define-composition 1055calc-user-define-edit calc-user-define-formula 1056calc-user-define-invocation calc-user-define-kbd-macro 1057calc-user-define-permanent calc-user-undefine) 1058 1059 ("calc-rewr" calc-match calc-rewrite calc-rewrite-selection) 1060 1061 ("calc-sel" calc-break-selections calc-clear-selections 1062calc-copy-selection calc-del-selection calc-edit-selection 1063calc-enable-selections calc-enter-selection calc-sel-add-both-sides 1064calc-sel-div-both-sides calc-sel-evaluate calc-sel-expand-formula 1065calc-sel-mult-both-sides calc-sel-sub-both-sides 1066calc-select-additional calc-select-here calc-select-here-maybe 1067calc-select-less calc-select-more calc-select-next calc-select-once 1068calc-select-once-maybe calc-select-part calc-select-previous 1069calc-show-selections calc-unselect) 1070 1071 ("calcsel2" calc-commute-left calc-commute-right calc-sel-commute 1072calc-sel-distribute calc-sel-invert calc-sel-isolate 1073calc-sel-jump-equals calc-sel-merge calc-sel-negate calc-sel-unpack) 1074 1075 ("calc-stat" calc-vector-correlation calc-vector-count 1076calc-vector-covariance calc-vector-geometric-mean 1077calc-vector-harmonic-mean calc-vector-max calc-vector-mean 1078calc-vector-mean-error calc-vector-median calc-vector-min 1079calc-vector-pop-covariance calc-vector-pop-sdev 1080calc-vector-pop-variance calc-vector-product calc-vector-sdev 1081calc-vector-sum calc-vector-variance) 1082 1083 ("calc-store" calc-assign calc-copy-special-constant 1084calc-copy-variable calc-declare-variable 1085calc-edit-AlgSimpRules calc-edit-Decls calc-edit-EvalRules 1086calc-edit-ExtSimpRules calc-edit-FitRules calc-edit-GenCount 1087calc-edit-Holidays calc-edit-IntegLimit calc-edit-LineStyles 1088calc-edit-PlotRejects calc-edit-PointStyles calc-edit-TimeZone 1089calc-edit-Units calc-edit-variable calc-evalto calc-insert-variables 1090calc-let calc-permanent-variable calc-recall calc-recall-quick 1091calc-store calc-store-concat calc-store-decr calc-store-div 1092calc-store-exchange calc-store-incr calc-store-into 1093calc-store-into-quick calc-store-inv calc-store-map calc-store-minus 1094calc-store-neg calc-store-plus calc-store-power calc-store-quick 1095calc-store-times calc-subscript calc-unstore) 1096 1097 ("calc-stuff" calc-clean calc-clean-num calc-flush-caches 1098calc-less-recursion-depth calc-more-recursion-depth calc-num-prefix 1099calc-version calc-why) 1100 1101 ("calc-trail" calc-trail-backward calc-trail-first calc-trail-forward 1102calc-trail-in calc-trail-isearch-backward calc-trail-isearch-forward 1103calc-trail-kill calc-trail-last calc-trail-marker calc-trail-next 1104calc-trail-out calc-trail-previous calc-trail-scroll-left 1105calc-trail-scroll-right calc-trail-yank) 1106 1107 ("calc-undo" calc-last-args calc-redo calc-undo) 1108 1109 ("calc-units" calc-autorange-units calc-base-units 1110calc-convert-temperature calc-convert-units calc-define-unit 1111calc-enter-units-table calc-explain-units calc-extract-units 1112calc-get-unit-definition calc-permanent-units calc-quick-units 1113calc-remove-units calc-simplify-units calc-undefine-unit 1114calc-view-units-table) 1115 1116 ("calc-vec" calc-arrange-vector calc-build-vector calc-cnorm 1117calc-conj-transpose calc-cons calc-cross calc-diag 1118calc-display-strings calc-expand-vector calc-grade calc-head 1119calc-histogram calc-ident calc-index calc-mask-vector calc-mcol 1120calc-mrow calc-pack calc-pack-bits calc-remove-duplicates 1121calc-reverse-vector calc-rnorm calc-set-cardinality 1122calc-set-complement calc-set-difference calc-set-enumerate 1123calc-set-floor calc-set-intersect calc-set-span calc-set-union 1124calc-set-xor calc-sort calc-subvector calc-tail calc-transpose 1125calc-unpack calc-unpack-bits calc-vector-find calc-vlength) 1126 1127 ("calc-yank" calc-copy-as-kill calc-copy-region-as-kill 1128calc-copy-to-buffer calc-edit calc-edit-cancel calc-edit-mode 1129calc-kill calc-kill-region calc-yank)))) 1130 1131(defun calc-init-prefixes () 1132 (if calc-shift-prefix 1133 (progn 1134 (define-key calc-mode-map "A" (lookup-key calc-mode-map "a")) 1135 (define-key calc-mode-map "B" (lookup-key calc-mode-map "b")) 1136 (define-key calc-mode-map "C" (lookup-key calc-mode-map "c")) 1137 (define-key calc-mode-map "D" (lookup-key calc-mode-map "d")) 1138 (define-key calc-mode-map "F" (lookup-key calc-mode-map "f")) 1139 (define-key calc-mode-map "G" (lookup-key calc-mode-map "g")) 1140 (define-key calc-mode-map "J" (lookup-key calc-mode-map "j")) 1141 (define-key calc-mode-map "K" (lookup-key calc-mode-map "k")) 1142 (define-key calc-mode-map "M" (lookup-key calc-mode-map "m")) 1143 (define-key calc-mode-map "S" (lookup-key calc-mode-map "s")) 1144 (define-key calc-mode-map "T" (lookup-key calc-mode-map "t")) 1145 (define-key calc-mode-map "U" (lookup-key calc-mode-map "u"))) 1146 (define-key calc-mode-map "A" 'calc-abs) 1147 (define-key calc-mode-map "B" 'calc-log) 1148 (define-key calc-mode-map "C" 'calc-cos) 1149 (define-key calc-mode-map "D" 'calc-redo) 1150 (define-key calc-mode-map "F" 'calc-floor) 1151 (define-key calc-mode-map "G" 'calc-argument) 1152 (define-key calc-mode-map "J" 'calc-conj) 1153 (define-key calc-mode-map "K" 'calc-keep-args) 1154 (define-key calc-mode-map "M" 'calc-more-recursion-depth) 1155 (define-key calc-mode-map "S" 'calc-sin) 1156 (define-key calc-mode-map "T" 'calc-tan) 1157 (define-key calc-mode-map "U" 'calc-undo))) 1158 1159(calc-init-extensions) 1160 1161 1162 1163 1164;;;; Miscellaneous. 1165 1166;; calc-command-flags is declared in calc.el 1167(defvar calc-command-flags) 1168 1169(defun calc-clear-command-flag (f) 1170 (setq calc-command-flags (delq f calc-command-flags))) 1171 1172 1173(defun calc-record-message (tag &rest args) 1174 (let ((msg (apply 'format args))) 1175 (message "%s" msg) 1176 (calc-record msg tag)) 1177 (calc-clear-command-flag 'clear-message)) 1178 1179 1180(defun calc-normalize-fancy (val) 1181 (let ((simp (if (consp calc-simplify-mode) 1182 (car calc-simplify-mode) 1183 calc-simplify-mode))) 1184 (cond ((eq simp 'binary) 1185 (let ((s (math-normalize val))) 1186 (if (math-realp s) 1187 (math-clip (math-round s)) 1188 s))) 1189 ((eq simp 'alg) 1190 (math-simplify val)) 1191 ((eq simp 'ext) 1192 (math-simplify-extended val)) 1193 ((eq simp 'units) 1194 (math-simplify-units val)) 1195 (t ; nil, none, num 1196 (math-normalize val))))) 1197 1198 1199(defvar calc-help-map nil) 1200 1201(if calc-help-map 1202 nil 1203 (setq calc-help-map (make-keymap)) 1204 (define-key calc-help-map "b" 'calc-describe-bindings) 1205 (define-key calc-help-map "c" 'calc-describe-key-briefly) 1206 (define-key calc-help-map "f" 'calc-describe-function) 1207 (define-key calc-help-map "h" 'calc-full-help) 1208 (define-key calc-help-map "i" 'calc-info) 1209 (define-key calc-help-map "k" 'calc-describe-key) 1210 (define-key calc-help-map "n" 'calc-view-news) 1211 (define-key calc-help-map "s" 'calc-info-summary) 1212 (define-key calc-help-map "t" 'calc-tutorial) 1213 (define-key calc-help-map "v" 'calc-describe-variable) 1214 (define-key calc-help-map "\C-c" 'calc-describe-copying) 1215 (define-key calc-help-map "\C-d" 'calc-describe-distribution) 1216 (define-key calc-help-map "\C-n" 'calc-view-news) 1217 (define-key calc-help-map "\C-w" 'calc-describe-no-warranty) 1218 (define-key calc-help-map "?" 'calc-help-for-help) 1219 (define-key calc-help-map "\C-h" 'calc-help-for-help)) 1220 1221(defvar calc-prefix-help-phase 0) 1222(defun calc-do-prefix-help (msgs group key) 1223 (if calc-full-help-flag 1224 (list msgs group key) 1225 (if (cdr msgs) 1226 (progn 1227 (setq calc-prefix-help-phase 1228 (if (eq this-command last-command) 1229 (% (1+ calc-prefix-help-phase) (1+ (length msgs))) 1230 0)) 1231 (let ((msg (nth calc-prefix-help-phase msgs))) 1232 (message "%s" (if msg 1233 (concat group ": " msg ":" 1234 (make-string 1235 (- (apply 'max (mapcar 'length msgs)) 1236 (length msg)) 32) 1237 " [MORE]" 1238 (if key 1239 (concat " " (char-to-string key) 1240 "-") 1241 "")) 1242 (if key (format "%c-" key) ""))))) 1243 (setq calc-prefix-help-phase 0) 1244 (if key 1245 (if msgs 1246 (message "%s: %s: %c-" group (car msgs) key) 1247 (message "%s: (none) %c-" group key)) 1248 (message "%s: %s" group (car msgs)))) 1249 (and key (calc-unread-command key)))) 1250 1251;;;; Commands. 1252 1253 1254;;; General. 1255 1256(defun calc-reset (arg) 1257 (interactive "P") 1258 (setq arg (if arg (prefix-numeric-value arg) nil)) 1259 (cond 1260 ((and 1261 calc-embedded-info 1262 (equal (aref calc-embedded-info 0) (current-buffer)) 1263 (<= (point) (aref calc-embedded-info 5)) 1264 (>= (point) (aref calc-embedded-info 4))) 1265 (let ((cbuf (aref calc-embedded-info 1)) 1266 (calc-embedded-quiet t)) 1267 (save-window-excursion 1268 (calc-embedded nil) 1269 (set-buffer cbuf) 1270 (calc-reset arg)) 1271 (calc-embedded nil))) 1272 ((eq major-mode 'calc-mode) 1273 (save-excursion 1274 (unless (and arg (> (abs arg) 0)) 1275 (setq calc-stack nil)) 1276 (setq calc-undo-list nil 1277 calc-redo-list nil) 1278 (let (calc-stack calc-user-parse-tables calc-standard-date-formats 1279 calc-invocation-macro) 1280 (mapcar (function (lambda (v) (set v nil))) calc-local-var-list) 1281 (if (and arg (<= arg 0)) 1282 (calc-mode-var-list-restore-default-values) 1283 (calc-mode-var-list-restore-saved-values))) 1284 (calc-set-language nil nil t) 1285 (calc-mode) 1286 (calc-flush-caches t) 1287 (run-hooks 'calc-reset-hook)) 1288 (calc-wrapper 1289 (let ((win (get-buffer-window (current-buffer)))) 1290 (calc-realign 0) 1291 ;; Adjust the window height if the window is visible, but doesn't 1292 ;; take up the whole height of the frame. 1293 (if (and 1294 win 1295 (< (window-height win) (1- (frame-height)))) 1296 (let ((height (- (window-height win) 2))) 1297 (set-window-point win (point)) 1298 (or (= height calc-window-height) 1299 (let ((swin (selected-window))) 1300 (select-window win) 1301 (enlarge-window (- calc-window-height height)) 1302 (select-window swin))))))) 1303 (message "(Calculator reset)")) 1304 (t 1305 (message "(Not inside a Calc buffer)")))) 1306 1307;; What a pain; scroll-left behaves differently when called non-interactively. 1308(defun calc-scroll-left (n) 1309 (interactive "P") 1310 (setq prefix-arg (or n (/ (window-width) 2))) 1311 (call-interactively #'scroll-left)) 1312 1313(defun calc-scroll-right (n) 1314 (interactive "P") 1315 (setq prefix-arg (or n (/ (window-width) 2))) 1316 (call-interactively #'scroll-right)) 1317 1318(defun calc-scroll-up (n) 1319 (interactive "P") 1320 (condition-case err 1321 (scroll-up (or n (/ (window-height) 2))) 1322 (error nil)) 1323 (if (pos-visible-in-window-p (max 1 (- (point-max) 2))) 1324 (if (eq major-mode 'calc-mode) 1325 (calc-realign) 1326 (goto-char (point-max)) 1327 (set-window-start (selected-window) 1328 (save-excursion 1329 (forward-line (- (1- (window-height)))) 1330 (point))) 1331 (forward-line -1)))) 1332 1333(defun calc-scroll-down (n) 1334 (interactive "P") 1335 (or (pos-visible-in-window-p 1) 1336 (scroll-down (or n (/ (window-height) 2))))) 1337 1338 1339(defun calc-precision (n) 1340 (interactive "NPrecision: ") 1341 (calc-wrapper 1342 (if (< (prefix-numeric-value n) 3) 1343 (error "Precision must be at least 3 digits") 1344 (calc-change-mode 'calc-internal-prec (prefix-numeric-value n) 1345 (and (memq (car calc-float-format) '(float sci eng)) 1346 (< (nth 1 calc-float-format) 1347 (if (= calc-number-radix 10) 0 1)))) 1348 (calc-record calc-internal-prec "prec")) 1349 (message "Floating-point precision is %d digits" calc-internal-prec))) 1350 1351 1352(defun calc-inverse (&optional n) 1353 (interactive "P") 1354 (let* ((hyp-flag (if (or 1355 (eq major-mode 'calc-keypad-mode) 1356 (eq major-mode 'calc-trail-mode)) 1357 (with-current-buffer calc-main-buffer 1358 calc-hyperbolic-flag) 1359 calc-hyperbolic-flag)) 1360 (msg (if hyp-flag 1361 "Inverse Hyperbolic..." 1362 "Inverse..."))) 1363 (calc-fancy-prefix 'calc-inverse-flag msg n))) 1364 1365(defconst calc-fancy-prefix-map 1366 (let ((map (make-sparse-keymap))) 1367 (define-key map [t] 'calc-fancy-prefix-other-key) 1368 (define-key map (vector meta-prefix-char t) 'calc-fancy-prefix-other-key) 1369 (define-key map [switch-frame] nil) 1370 (define-key map [?\C-u] 'universal-argument) 1371 (define-key map [?0] 'digit-argument) 1372 (define-key map [?1] 'digit-argument) 1373 (define-key map [?2] 'digit-argument) 1374 (define-key map [?3] 'digit-argument) 1375 (define-key map [?4] 'digit-argument) 1376 (define-key map [?5] 'digit-argument) 1377 (define-key map [?6] 'digit-argument) 1378 (define-key map [?7] 'digit-argument) 1379 (define-key map [?8] 'digit-argument) 1380 (define-key map [?9] 'digit-argument) 1381 map) 1382 "Keymap used while processing calc-fancy-prefix.") 1383 1384(defvar calc-is-keypad-press nil) 1385(defun calc-fancy-prefix (flag msg n) 1386 (let (prefix) 1387 (calc-wrapper 1388 (calc-set-command-flag 'keep-flags) 1389 (calc-set-command-flag 'no-align) 1390 (setq prefix (set flag (not (symbol-value flag))) 1391 prefix-arg n) 1392 (message (if prefix msg ""))) 1393 (and prefix 1394 (not calc-is-keypad-press) 1395 (if (boundp 'overriding-terminal-local-map) 1396 (setq overriding-terminal-local-map calc-fancy-prefix-map) 1397 (let ((event (calc-read-key t))) 1398 (if (eq (setq last-command-char (car event)) ?\C-u) 1399 (universal-argument) 1400 (if (or (not (integerp last-command-char)) 1401 (and (>= last-command-char 0) (< last-command-char ? ) 1402 (not (memq last-command-char '(?\e))))) 1403 (calc-wrapper)) ; clear flags if not a Calc command. 1404 (setq last-command-event (cdr event)) 1405 (if (or (not (integerp last-command-char)) 1406 (eq last-command-char ?-)) 1407 (calc-unread-command) 1408 (digit-argument n)))))))) 1409 1410(defun calc-fancy-prefix-other-key (arg) 1411 (interactive "P") 1412 (if (and 1413 (not (eq last-command-char 'tab)) 1414 (not (eq last-command-char 'M-tab)) 1415 (or (not (integerp last-command-char)) 1416 (and (>= last-command-char 0) (< last-command-char ? ) 1417 (not (eq last-command-char meta-prefix-char))))) 1418 (calc-wrapper)) ; clear flags if not a Calc command. 1419 (setq prefix-arg arg) 1420 (calc-unread-command) 1421 (setq overriding-terminal-local-map nil)) 1422 1423(defun calc-invert-func () 1424 (save-excursion 1425 (calc-select-buffer) 1426 (setq calc-inverse-flag (not (calc-is-inverse)) 1427 calc-hyperbolic-flag (calc-is-hyperbolic) 1428 current-prefix-arg nil))) 1429 1430(defun calc-is-inverse () 1431 calc-inverse-flag) 1432 1433(defun calc-hyperbolic (&optional n) 1434 (interactive "P") 1435 (let* ((inv-flag (if (or 1436 (eq major-mode 'calc-keypad-mode) 1437 (eq major-mode 'calc-trail-mode)) 1438 (with-current-buffer calc-main-buffer 1439 calc-inverse-flag) 1440 calc-inverse-flag)) 1441 (msg (if inv-flag 1442 "Inverse Hyperbolic..." 1443 "Hyperbolic..."))) 1444 (calc-fancy-prefix 'calc-hyperbolic-flag msg n))) 1445 1446(defun calc-hyperbolic-func () 1447 (save-excursion 1448 (calc-select-buffer) 1449 (setq calc-inverse-flag (calc-is-inverse) 1450 calc-hyperbolic-flag (not (calc-is-hyperbolic)) 1451 current-prefix-arg nil))) 1452 1453(defun calc-is-hyperbolic () 1454 calc-hyperbolic-flag) 1455 1456(defun calc-keep-args (&optional n) 1457 (interactive "P") 1458 (calc-fancy-prefix 'calc-keep-args-flag "Keep args..." n)) 1459 1460 1461(defun calc-change-mode (var value &optional refresh option) 1462 (if option 1463 (setq value (if value 1464 (> (prefix-numeric-value value) 0) 1465 (not (symbol-value var))))) 1466 (or (consp var) (setq var (list var) value (list value))) 1467 (if calc-inverse-flag 1468 (let ((old nil)) 1469 (or refresh (error "Not a display-mode command")) 1470 (calc-check-stack 1) 1471 (unwind-protect 1472 (let ((v var)) 1473 (while v 1474 (setq old (cons (symbol-value (car v)) old)) 1475 (set (car v) (car value)) 1476 (setq v (cdr v) 1477 value (cdr value))) 1478 (calc-refresh-top 1) 1479 (calc-refresh-evaltos) 1480 (symbol-value (car var))) 1481 (let ((v var)) 1482 (setq old (nreverse old)) 1483 (while v 1484 (set (car v) (car old)) 1485 (setq v (cdr v) 1486 old (cdr old))) 1487 (if (eq (car var) 'calc-language) 1488 (calc-set-language calc-language calc-language-option t))))) 1489 (let ((chg nil) 1490 (v var)) 1491 (while v 1492 (or (equal (symbol-value (car v)) (car value)) 1493 (progn 1494 (set (car v) (car value)) 1495 (if (eq (car v) 'calc-float-format) 1496 (setq calc-full-float-format 1497 (list (if (eq (car (car value)) 'fix) 1498 'float 1499 (car (car value))) 1500 0))) 1501 (setq chg t))) 1502 (setq v (cdr v) 1503 value (cdr value))) 1504 (if chg 1505 (progn 1506 (or (and refresh (calc-do-refresh)) 1507 (calc-refresh-evaltos)) 1508 (and (eq calc-mode-save-mode 'save) 1509 (not (equal var '(calc-mode-save-mode))) 1510 (calc-save-modes)))) 1511 (if calc-embedded-info (calc-embedded-modes-change var)) 1512 (symbol-value (car var))))) 1513 1514(defun calc-toggle-banner () 1515 "Toggle display of the friendly greeting calc normally shows above the stack." 1516 (interactive) 1517 (setq calc-show-banner (not calc-show-banner)) 1518 (calc-refresh)) 1519 1520(defun calc-refresh-top (n) 1521 (interactive "p") 1522 (calc-wrapper 1523 (cond ((< n 0) 1524 (setq n (- n)) 1525 (let ((entry (calc-top n 'entry)) 1526 (calc-undo-list nil) (calc-redo-list nil)) 1527 (calc-pop-stack 1 n t) 1528 (calc-push-list (list (car entry)) n (list (nth 2 entry))))) 1529 ((= n 0) 1530 (calc-refresh)) 1531 (t 1532 (let ((entries (calc-top-list n 1 'entry)) 1533 (calc-undo-list nil) (calc-redo-list nil)) 1534 (calc-pop-stack n 1 t) 1535 (calc-push-list (mapcar 'car entries) 1536 1 1537 (mapcar (function (lambda (x) (nth 2 x))) 1538 entries))))))) 1539 1540(defvar calc-refreshing-evaltos nil) 1541(defvar calc-no-refresh-evaltos nil) 1542(defun calc-refresh-evaltos (&optional which-var) 1543 (and calc-any-evaltos calc-auto-recompute (not calc-no-refresh-evaltos) 1544 (let ((calc-refreshing-evaltos t) 1545 (num (calc-stack-size)) 1546 (calc-undo-list nil) (calc-redo-list nil) 1547 value new-val) 1548 (while (> num 0) 1549 (setq value (calc-top num 'entry)) 1550 (if (and (not (nth 2 value)) 1551 (setq value (car value)) 1552 (or (eq (car-safe value) 'calcFunc-evalto) 1553 (and (eq (car-safe value) 'vec) 1554 (eq (car-safe (nth 1 value)) 'calcFunc-evalto)))) 1555 (progn 1556 (setq new-val (math-normalize value)) 1557 (or (equal new-val value) 1558 (progn 1559 (calc-push-list (list new-val) num) 1560 (calc-pop-stack 1 (1+ num) t))))) 1561 (setq num (1- num))))) 1562 (and calc-embedded-active which-var 1563 (calc-embedded-var-change which-var))) 1564 1565(defun calc-push (&rest vals) 1566 (calc-push-list vals)) 1567 1568(defun calc-pop-push (n &rest vals) 1569 (calc-pop-push-list n vals)) 1570 1571(defun calc-pop-push-record (n prefix &rest vals) 1572 (calc-pop-push-record-list n prefix vals)) 1573 1574 1575(defun calc-evaluate (n) 1576 (interactive "p") 1577 (calc-slow-wrapper 1578 (if (= n 0) 1579 (setq n (calc-stack-size))) 1580 (calc-with-default-simplification 1581 (if (< n 0) 1582 (calc-pop-push-record-list 1 "eval" 1583 (math-evaluate-expr (calc-top (- n))) 1584 (- n)) 1585 (calc-pop-push-record-list n "eval" (mapcar 'math-evaluate-expr 1586 (calc-top-list n))))) 1587 (calc-handle-whys))) 1588 1589 1590(defun calc-eval-num (n) 1591 (interactive "P") 1592 (calc-slow-wrapper 1593 (let* ((nn (prefix-numeric-value n)) 1594 (calc-internal-prec (cond ((>= nn 3) nn) 1595 ((< nn 0) (max (+ calc-internal-prec nn) 1596 3)) 1597 (t calc-internal-prec))) 1598 (calc-symbolic-mode nil)) 1599 (calc-with-default-simplification 1600 (calc-pop-push-record 1 "num" (math-evaluate-expr (calc-top 1))))) 1601 (calc-handle-whys))) 1602 1603 1604(defun calc-execute-extended-command (n) 1605 (interactive "P") 1606 (let* ((prompt (concat (calc-num-prefix-name n) "M-x ")) 1607 (cmd (intern (completing-read prompt obarray 'commandp t "calc-")))) 1608 (setq prefix-arg n) 1609 (command-execute cmd))) 1610 1611 1612(defun calc-realign (&optional num) 1613 (interactive "P") 1614 (if (and num (eq major-mode 'calc-mode)) 1615 (progn 1616 (calc-check-stack num) 1617 (calc-cursor-stack-index num) 1618 (and calc-line-numbering 1619 (forward-char 4))) 1620 (if (and calc-embedded-info 1621 (eq (current-buffer) (aref calc-embedded-info 0))) 1622 (progn 1623 (goto-char (aref calc-embedded-info 2)) 1624 (if (save-excursion (set-buffer (aref calc-embedded-info 1)) 1625 calc-show-plain) 1626 (forward-line 1))) 1627 (calc-wrapper 1628 (if (get-buffer-window (current-buffer)) 1629 (set-window-hscroll (get-buffer-window (current-buffer)) 0)))))) 1630 1631(defvar math-cache-list nil) 1632 1633(defun calc-var-value (v) 1634 (and (symbolp v) 1635 (boundp v) 1636 (symbol-value v) 1637 (if (symbolp (symbol-value v)) 1638 (set v (funcall (symbol-value v))) 1639 (if (stringp (symbol-value v)) 1640 (let ((val (math-read-expr (symbol-value v)))) 1641 (if (eq (car-safe val) 'error) 1642 (error "Bad format in variable contents: %s" (nth 2 val)) 1643 (set v val))) 1644 (symbol-value v))))) 1645 1646;;; In the following table, ( OP LOPS ROPS ) means that if an OP 1647;;; term appears as the first argument to any LOPS term, or as the 1648;;; second argument to any ROPS term, then they should be treated 1649;;; as one large term for purposes of associative selection. 1650(defconst calc-assoc-ops '( ( + ( + - ) ( + ) ) 1651 ( - ( + - ) ( + ) ) 1652 ( * ( * ) ( * ) ) 1653 ( / ( / ) ( ) ) 1654 ( | ( | ) ( | ) ) 1655 ( calcFunc-land ( calcFunc-land ) 1656 ( calcFunc-land ) ) 1657 ( calcFunc-lor ( calcFunc-lor ) 1658 ( calcFunc-lor ) ) )) 1659 1660 1661(defvar var-CommuteRules 'calc-CommuteRules) 1662(defvar var-JumpRules 'calc-JumpRules) 1663(defvar var-DistribRules 'calc-DistribRules) 1664(defvar var-MergeRules 'calc-MergeRules) 1665(defvar var-NegateRules 'calc-NegateRules) 1666(defvar var-InvertRules 'calc-InvertRules) 1667 1668 1669(defconst calc-tweak-eqn-table '( ( calcFunc-eq calcFunc-eq calcFunc-neq ) 1670 ( calcFunc-neq calcFunc-neq calcFunc-eq ) 1671 ( calcFunc-lt calcFunc-gt calcFunc-geq ) 1672 ( calcFunc-gt calcFunc-lt calcFunc-leq ) 1673 ( calcFunc-leq calcFunc-geq calcFunc-gt ) 1674 ( calcFunc-geq calcFunc-leq calcFunc-lt ) )) 1675 1676 1677 1678 1679(defun calc-float (arg) 1680 (interactive "P") 1681 (calc-slow-wrapper 1682 (calc-unary-op "flt" 1683 (if (calc-is-hyperbolic) 'calcFunc-float 'calcFunc-pfloat) 1684 arg))) 1685 1686 1687(defvar calc-gnuplot-process nil) 1688(defvar calc-gnuplot-input) 1689(defvar calc-gnuplot-buffer) 1690 1691(defun calc-gnuplot-alive () 1692 (and calc-gnuplot-process 1693 calc-gnuplot-buffer 1694 (buffer-name calc-gnuplot-buffer) 1695 calc-gnuplot-input 1696 (buffer-name calc-gnuplot-input) 1697 (memq (process-status calc-gnuplot-process) '(run stop)))) 1698 1699 1700 1701 1702 1703(defun calc-load-everything () 1704 (interactive) 1705 (require 'calc-aent) 1706 (require 'calc-alg) 1707 (require 'calc-arith) 1708 (require 'calc-bin) 1709 (require 'calc-comb) 1710 (require 'calc-cplx) 1711 (require 'calc-embed) 1712 (require 'calc-fin) 1713 (require 'calc-forms) 1714 (require 'calc-frac) 1715 (require 'calc-funcs) 1716 (require 'calc-graph) 1717 (require 'calc-help) 1718 (require 'calc-incom) 1719 (require 'calc-keypd) 1720 (require 'calc-lang) 1721 (require 'calc-macs) 1722 (require 'calc-map) 1723 (require 'calc-math) 1724 (require 'calc-misc) 1725 (require 'calc-mode) 1726 (require 'calc-mtx) 1727 (require 'calc-poly) 1728 (require 'calc-prog) 1729 (require 'calc-rewr) 1730 (require 'calc-rules) 1731 (require 'calc-sel) 1732 (require 'calc-stat) 1733 (require 'calc-store) 1734 (require 'calc-stuff) 1735 (require 'calc-trail) 1736 (require 'calc-undo) 1737 (require 'calc-units) 1738 (require 'calc-vec) 1739 (require 'calc-yank) 1740 (require 'calcalg2) 1741 (require 'calcalg3) 1742 (require 'calccomp) 1743 (require 'calcsel2) 1744 1745 (message "All parts of Calc are now loaded")) 1746 1747 1748;;; Vector commands. 1749 1750(defun calc-concat (arg) 1751 (interactive "P") 1752 (calc-wrapper 1753 (if (calc-is-inverse) 1754 (if (calc-is-hyperbolic) 1755 (calc-enter-result 2 "apnd" (list 'calcFunc-append 1756 (calc-top 1) (calc-top 2))) 1757 (calc-enter-result 2 "|" (list 'calcFunc-vconcat 1758 (calc-top 1) (calc-top 2)))) 1759 (if (calc-is-hyperbolic) 1760 (calc-binary-op "apnd" 'calcFunc-append arg '(vec)) 1761 (calc-binary-op "|" 'calcFunc-vconcat arg '(vec) nil '|))))) 1762 1763(defun calc-append (arg) 1764 (interactive "P") 1765 (calc-hyperbolic-func) 1766 (calc-concat arg)) 1767 1768 1769(defconst calc-arg-values '( ( var ArgA var-ArgA ) ( var ArgB var-ArgB ) 1770 ( var ArgC var-ArgC ) ( var ArgD var-ArgD ) 1771 ( var ArgE var-ArgE ) ( var ArgF var-ArgF ) 1772 ( var ArgG var-ArgG ) ( var ArgH var-ArgH ) 1773 ( var ArgI var-ArgI ) ( var ArgJ var-ArgJ ) 1774)) 1775 1776(defun calc-invent-args (n) 1777 (nreverse (nthcdr (- (length calc-arg-values) n) (reverse calc-arg-values)))) 1778 1779 1780 1781 1782;;; User menu. 1783 1784(defun calc-user-key-map () 1785 (if calc-emacs-type-lucid 1786 (error "User-defined keys are not supported in Lucid Emacs")) 1787 (let ((res (cdr (lookup-key calc-mode-map "z")))) 1788 (if (eq (car (car res)) 27) 1789 (cdr res) 1790 res))) 1791 1792(defvar calc-z-prefix-buf nil) 1793(defvar calc-z-prefix-msgs nil) 1794 1795(defun calc-z-prefix-help () 1796 (interactive) 1797 (let* ((calc-z-prefix-msgs nil) 1798 (calc-z-prefix-buf "") 1799 (kmap (sort (copy-sequence (calc-user-key-map)) 1800 (function (lambda (x y) (< (car x) (car y)))))) 1801 (flags (apply 'logior 1802 (mapcar (function 1803 (lambda (k) 1804 (calc-user-function-classify (car k)))) 1805 kmap)))) 1806 (if (= (logand flags 8) 0) 1807 (calc-user-function-list kmap 7) 1808 (calc-user-function-list kmap 1) 1809 (setq calc-z-prefix-msgs (cons calc-z-prefix-buf calc-z-prefix-msgs) 1810 calc-z-prefix-buf "") 1811 (calc-user-function-list kmap 6)) 1812 (if (/= flags 0) 1813 (setq calc-z-prefix-msgs (cons calc-z-prefix-buf calc-z-prefix-msgs))) 1814 (calc-do-prefix-help (nreverse calc-z-prefix-msgs) "user" ?z))) 1815 1816(defun calc-user-function-classify (key) 1817 (cond ((/= key (downcase key)) ; upper-case 1818 (if (assq (downcase key) (calc-user-key-map)) 9 1)) 1819 ((/= key (upcase key)) 2) ; lower-case 1820 ((= key ??) 0) 1821 (t 4))) ; other 1822 1823(defun calc-user-function-list (map flags) 1824 (and map 1825 (let* ((key (car (car map))) 1826 (kind (calc-user-function-classify key)) 1827 (func (cdr (car map)))) 1828 (if (or (= (logand kind flags) 0) 1829 (not (symbolp func))) 1830 () 1831 (let* ((name (symbol-name func)) 1832 (name (if (string-match "\\`calc-" name) 1833 (substring name 5) name)) 1834 (pos (string-match (char-to-string key) name)) 1835 (desc 1836 (if (symbolp func) 1837 (if (= (logand kind 3) 0) 1838 (format "`%c' = %s" key name) 1839 (if pos 1840 (format "%s%c%s" 1841 (downcase (substring name 0 pos)) 1842 (upcase key) 1843 (downcase (substring name (1+ pos)))) 1844 (format "%c = %s" 1845 (upcase key) 1846 (downcase name)))) 1847 (char-to-string (upcase key))))) 1848 (if (= (length calc-z-prefix-buf) 0) 1849 (setq calc-z-prefix-buf (concat (if (= flags 1) "SHIFT + " "") 1850 desc)) 1851 (if (> (+ (length calc-z-prefix-buf) (length desc)) 58) 1852 (setq calc-z-prefix-msgs 1853 (cons calc-z-prefix-buf calc-z-prefix-msgs) 1854 calc-z-prefix-buf (concat (if (= flags 1) "SHIFT + " "") 1855 desc)) 1856 (setq calc-z-prefix-buf (concat calc-z-prefix-buf ", " desc)))))) 1857 (calc-user-function-list (cdr map) flags)))) 1858 1859 1860 1861(defun calc-shift-Z-prefix-help () 1862 (interactive) 1863 (calc-do-prefix-help 1864 '("Define, Undefine, Formula, Kbd-macro, Edit, Get-defn" 1865 "Composition, Syntax; Invocation; Permanent; Timing" 1866 "kbd-macros: [ (if), : (else), | (else-if), ] (end-if)" 1867 "kbd-macros: < > (repeat), ( ) (for), { } (loop)" 1868 "kbd-macros: / (break)" 1869 "kbd-macros: ` (save), ' (restore)") 1870 "user" ?Z)) 1871 1872 1873;;;; Caches. 1874 1875(defmacro math-defcache (name init form) 1876 (let ((cache-prec (intern (concat (symbol-name name) "-cache-prec"))) 1877 (cache-val (intern (concat (symbol-name name) "-cache"))) 1878 (last-prec (intern (concat (symbol-name name) "-last-prec"))) 1879 (last-val (intern (concat (symbol-name name) "-last")))) 1880 (list 'progn 1881 (list 'defvar cache-prec (if init (math-numdigs (nth 1 init)) -100)) 1882 (list 'defvar cache-val (list 'quote init)) 1883 (list 'defvar last-prec -100) 1884 (list 'defvar last-val nil) 1885 (list 'setq 'math-cache-list 1886 (list 'cons 1887 (list 'quote cache-prec) 1888 (list 'cons 1889 (list 'quote last-prec) 1890 'math-cache-list))) 1891 (list 'defun 1892 name () 1893 (list 'or 1894 (list '= last-prec 'calc-internal-prec) 1895 (list 'setq 1896 last-val 1897 (list 'math-normalize 1898 (list 'progn 1899 (list 'or 1900 (list '>= cache-prec 1901 'calc-internal-prec) 1902 (list 'setq 1903 cache-val 1904 (list 'let 1905 '((calc-internal-prec 1906 (+ calc-internal-prec 1907 4))) 1908 form) 1909 cache-prec 1910 '(+ calc-internal-prec 2))) 1911 cache-val)) 1912 last-prec 'calc-internal-prec)) 1913 last-val)))) 1914(put 'math-defcache 'lisp-indent-hook 2) 1915 1916;;; Betcha didn't know that pi = 16 atan(1/5) - 4 atan(1/239). [F] [Public] 1917(math-defcache math-pi (float (bigpos 463 238 793 589 653 592 141 3) -21) 1918 (math-add-float (math-mul-float '(float 16 0) 1919 (math-arctan-raw '(float 2 -1))) 1920 (math-mul-float '(float -4 0) 1921 (math-arctan-raw 1922 (math-float '(frac 1 239)))))) 1923 1924(math-defcache math-two-pi nil 1925 (math-mul-float (math-pi) '(float 2 0))) 1926 1927(math-defcache math-pi-over-2 nil 1928 (math-mul-float (math-pi) '(float 5 -1))) 1929 1930(math-defcache math-pi-over-4 nil 1931 (math-mul-float (math-pi) '(float 25 -2))) 1932 1933(math-defcache math-pi-over-180 nil 1934 (math-div-float (math-pi) '(float 18 1))) 1935 1936(math-defcache math-sqrt-pi nil 1937 (math-sqrt-float (math-pi))) 1938 1939(math-defcache math-sqrt-2 nil 1940 (math-sqrt-float '(float 2 0))) 1941 1942(math-defcache math-sqrt-12 nil 1943 (math-sqrt-float '(float 12 0))) 1944 1945(math-defcache math-sqrt-two-pi nil 1946 (math-sqrt-float (math-two-pi))) 1947 1948(math-defcache math-sqrt-e (float (bigpos 849 146 128 700 270 721 648 1) -21) 1949 (math-add-float '(float 1 0) (math-exp-minus-1-raw '(float 5 -1)))) 1950 1951(math-defcache math-e nil 1952 (math-pow (math-sqrt-e) 2)) 1953 1954(math-defcache math-phi nil 1955 (math-mul-float (math-add-float (math-sqrt-raw '(float 5 0)) '(float 1 0)) 1956 '(float 5 -1))) 1957 1958(math-defcache math-gamma-const nil 1959 '(float (bigpos 495 467 917 632 470 369 709 646 776 267 677 848 348 672 1960 057 988 235 399 359 593 421 310 024 824 900 120 065 606 1961 328 015 649 156 772 5) -100)) 1962 1963(defun math-half-circle (symb) 1964 (if (eq calc-angle-mode 'rad) 1965 (if symb 1966 '(var pi var-pi) 1967 (math-pi)) 1968 180)) 1969 1970(defun math-full-circle (symb) 1971 (math-mul 2 (math-half-circle symb))) 1972 1973(defun math-quarter-circle (symb) 1974 (math-div (math-half-circle symb) 2)) 1975 1976(defvar math-expand-formulas nil) 1977 1978;;;; Miscellaneous math routines. 1979 1980;;; True if A is an odd integer. [P R R] [Public] 1981(defun math-oddp (a) 1982 (if (consp a) 1983 (and (memq (car a) '(bigpos bigneg)) 1984 (= (% (nth 1 a) 2) 1)) 1985 (/= (% a 2) 0))) 1986 1987;;; True if A is a small or big integer. [P x] [Public] 1988(defun math-integerp (a) 1989 (or (integerp a) 1990 (memq (car-safe a) '(bigpos bigneg)))) 1991 1992;;; True if A is (numerically) a non-negative integer. [P N] [Public] 1993(defun math-natnump (a) 1994 (or (natnump a) 1995 (eq (car-safe a) 'bigpos))) 1996 1997;;; True if A is a rational (or integer). [P x] [Public] 1998(defun math-ratp (a) 1999 (or (integerp a) 2000 (memq (car-safe a) '(bigpos bigneg frac)))) 2001 2002;;; True if A is a real (or rational). [P x] [Public] 2003(defun math-realp (a) 2004 (or (integerp a) 2005 (memq (car-safe a) '(bigpos bigneg frac float)))) 2006 2007;;; True if A is a real or HMS form. [P x] [Public] 2008(defun math-anglep (a) 2009 (or (integerp a) 2010 (memq (car-safe a) '(bigpos bigneg frac float hms)))) 2011 2012;;; True if A is a number of any kind. [P x] [Public] 2013(defun math-numberp (a) 2014 (or (integerp a) 2015 (memq (car-safe a) '(bigpos bigneg frac float cplx polar)))) 2016 2017;;; True if A is a complex number or angle. [P x] [Public] 2018(defun math-scalarp (a) 2019 (or (integerp a) 2020 (memq (car-safe a) '(bigpos bigneg frac float cplx polar hms)))) 2021 2022;;; True if A is a vector. [P x] [Public] 2023(defun math-vectorp (a) 2024 (eq (car-safe a) 'vec)) 2025 2026;;; True if A is any vector or scalar data object. [P x] 2027(defun math-objvecp (a) ; [Public] 2028 (or (integerp a) 2029 (memq (car-safe a) '(bigpos bigneg frac float cplx polar 2030 hms date sdev intv mod vec incomplete)))) 2031 2032;;; True if A is an object not composed of sub-formulas . [P x] [Public] 2033(defun math-primp (a) 2034 (or (integerp a) 2035 (memq (car-safe a) '(bigpos bigneg frac float cplx polar 2036 hms date mod var)))) 2037 2038;;; True if A is numerically (but not literally) an integer. [P x] [Public] 2039(defun math-messy-integerp (a) 2040 (cond 2041 ((eq (car-safe a) 'float) (>= (nth 2 a) 0)) 2042 ((eq (car-safe a) 'frac) (Math-integerp (math-normalize a))))) 2043 2044;;; True if A is numerically an integer. [P x] [Public] 2045(defun math-num-integerp (a) 2046 (or (Math-integerp a) 2047 (Math-messy-integerp a))) 2048 2049;;; True if A is (numerically) a non-negative integer. [P N] [Public] 2050(defun math-num-natnump (a) 2051 (or (natnump a) 2052 (eq (car-safe a) 'bigpos) 2053 (and (eq (car-safe a) 'float) 2054 (Math-natnump (nth 1 a)) 2055 (>= (nth 2 a) 0)))) 2056 2057;;; True if A is an integer or will evaluate to an integer. [P x] [Public] 2058(defun math-provably-integerp (a) 2059 (or (Math-integerp a) 2060 (and (memq (car-safe a) '(calcFunc-trunc 2061 calcFunc-round 2062 calcFunc-rounde 2063 calcFunc-roundu 2064 calcFunc-floor 2065 calcFunc-ceil)) 2066 (= (length a) 2)))) 2067 2068;;; True if A is a real or will evaluate to a real. [P x] [Public] 2069(defun math-provably-realp (a) 2070 (or (Math-realp a) 2071 (math-provably-integer a) 2072 (memq (car-safe a) '(abs arg)))) 2073 2074;;; True if A is a non-real, complex number. [P x] [Public] 2075(defun math-complexp (a) 2076 (memq (car-safe a) '(cplx polar))) 2077 2078;;; True if A is a non-real, rectangular complex number. [P x] [Public] 2079(defun math-rect-complexp (a) 2080 (eq (car-safe a) 'cplx)) 2081 2082;;; True if A is a non-real, polar complex number. [P x] [Public] 2083(defun math-polar-complexp (a) 2084 (eq (car-safe a) 'polar)) 2085 2086;;; True if A is a matrix. [P x] [Public] 2087(defun math-matrixp (a) 2088 (and (Math-vectorp a) 2089 (Math-vectorp (nth 1 a)) 2090 (cdr (nth 1 a)) 2091 (let ((len (length (nth 1 a)))) 2092 (setq a (cdr a)) 2093 (while (and (setq a (cdr a)) 2094 (Math-vectorp (car a)) 2095 (= (length (car a)) len))) 2096 (null a)))) 2097 2098(defun math-matrixp-step (a len) ; [P L] 2099 (or (null a) 2100 (and (Math-vectorp (car a)) 2101 (= (length (car a)) len) 2102 (math-matrixp-step (cdr a) len)))) 2103 2104;;; True if A is a square matrix. [P V] [Public] 2105(defun math-square-matrixp (a) 2106 (let ((dims (math-mat-dimens a))) 2107 (and (cdr dims) 2108 (= (car dims) (nth 1 dims))))) 2109 2110;;; True if MAT is an identity matrix. 2111(defun math-identity-matrix-p (mat &optional mul) 2112 (if (math-square-matrixp mat) 2113 (let ((a (if mul 2114 (nth 1 (nth 1 mat)) 2115 1)) 2116 (n (1- (length mat))) 2117 (i 1)) 2118 (while (and (<= i n) 2119 (math-ident-row-p (nth i mat) i a)) 2120 (setq i (1+ i))) 2121 (if (> i n) 2122 a 2123 nil)))) 2124 2125(defun math-ident-row-p (row n &optional a) 2126 (unless a 2127 (setq a 1)) 2128 (and 2129 (not (memq nil (mapcar 2130 (lambda (x) (eq x 0)) 2131 (nthcdr (1+ n) row)))) 2132 (not (memq nil (mapcar 2133 (lambda (x) (eq x 0)) 2134 (butlast 2135 (cdr row) 2136 (- (length row) n))))) 2137 (eq (elt row n) a))) 2138 2139;;; True if A is any scalar data object. [P x] 2140(defun math-objectp (a) ; [Public] 2141 (or (integerp a) 2142 (memq (car-safe a) '(bigpos bigneg frac float cplx 2143 polar hms date sdev intv mod)))) 2144 2145;;; Verify that A is an integer and return A in integer form. [I N; - x] 2146(defun math-check-integer (a) ; [Public] 2147 (cond ((integerp a) a) ; for speed 2148 ((math-integerp a) a) 2149 ((math-messy-integerp a) 2150 (math-trunc a)) 2151 (t (math-reject-arg a 'integerp)))) 2152 2153;;; Verify that A is a small integer and return A in integer form. [S N; - x] 2154(defun math-check-fixnum (a &optional allow-inf) ; [Public] 2155 (cond ((integerp a) a) ; for speed 2156 ((Math-num-integerp a) 2157 (let ((a (math-trunc a))) 2158 (if (integerp a) 2159 a 2160 (if (or (Math-lessp (lsh -1 -1) a) 2161 (Math-lessp a (- (lsh -1 -1)))) 2162 (math-reject-arg a 'fixnump) 2163 (math-fixnum a))))) 2164 ((and allow-inf (equal a '(var inf var-inf))) 2165 (lsh -1 -1)) 2166 ((and allow-inf (equal a '(neg (var inf var-inf)))) 2167 (- (lsh -1 -1))) 2168 (t (math-reject-arg a 'fixnump)))) 2169 2170;;; Verify that A is an integer >= 0 and return A in integer form. [I N; - x] 2171(defun math-check-natnum (a) ; [Public] 2172 (cond ((natnump a) a) 2173 ((and (not (math-negp a)) 2174 (Math-num-integerp a)) 2175 (math-trunc a)) 2176 (t (math-reject-arg a 'natnump)))) 2177 2178;;; Verify that A is in floating-point form, or force it to be a float. [F N] 2179(defun math-check-float (a) ; [Public] 2180 (cond ((eq (car-safe a) 'float) a) 2181 ((Math-vectorp a) (math-map-vec 'math-check-float a)) 2182 ((Math-objectp a) (math-float a)) 2183 (t a))) 2184 2185;;; Verify that A is a constant. 2186(defun math-check-const (a &optional exp-ok) 2187 (if (or (math-constp a) 2188 (and exp-ok math-expand-formulas)) 2189 a 2190 (math-reject-arg a 'constp))) 2191 2192 2193;;; Coerce integer A to be a small integer. [S I] 2194(defun math-fixnum (a) 2195 (if (consp a) 2196 (if (cdr a) 2197 (if (eq (car a) 'bigneg) 2198 (- (math-fixnum-big (cdr a))) 2199 (math-fixnum-big (cdr a))) 2200 0) 2201 a)) 2202 2203(defun math-fixnum-big (a) 2204 (if (cdr a) 2205 (+ (car a) (* (math-fixnum-big (cdr a)) 1000)) 2206 (car a))) 2207 2208(defvar math-simplify-only nil) 2209 2210(defun math-normalize-fancy (a) 2211 (cond ((eq (car a) 'frac) 2212 (math-make-frac (math-normalize (nth 1 a)) 2213 (math-normalize (nth 2 a)))) 2214 ((eq (car a) 'cplx) 2215 (let ((real (math-normalize (nth 1 a))) 2216 (imag (math-normalize (nth 2 a)))) 2217 (if (and (math-zerop imag) 2218 (not math-simplify-only)) ; oh, what a kludge! 2219 real 2220 (list 'cplx real imag)))) 2221 ((eq (car a) 'polar) 2222 (math-normalize-polar a)) 2223 ((eq (car a) 'hms) 2224 (math-normalize-hms a)) 2225 ((eq (car a) 'date) 2226 (list 'date (math-normalize (nth 1 a)))) 2227 ((eq (car a) 'mod) 2228 (math-normalize-mod a)) 2229 ((eq (car a) 'sdev) 2230 (let ((x (math-normalize (nth 1 a))) 2231 (s (math-normalize (nth 2 a)))) 2232 (if (or (and (Math-objectp x) (not (Math-scalarp x))) 2233 (and (Math-objectp s) (not (Math-scalarp s)))) 2234 (list 'calcFunc-sdev x s) 2235 (math-make-sdev x s)))) 2236 ((eq (car a) 'intv) 2237 (let ((mask (math-normalize (nth 1 a))) 2238 (lo (math-normalize (nth 2 a))) 2239 (hi (math-normalize (nth 3 a)))) 2240 (if (if (eq (car-safe lo) 'date) 2241 (not (eq (car-safe hi) 'date)) 2242 (or (and (Math-objectp lo) (not (Math-anglep lo))) 2243 (and (Math-objectp hi) (not (Math-anglep hi))))) 2244 (list 'calcFunc-intv mask lo hi) 2245 (math-make-intv mask lo hi)))) 2246 ((eq (car a) 'vec) 2247 (cons 'vec (mapcar 'math-normalize (cdr a)))) 2248 ((eq (car a) 'quote) 2249 (math-normalize (nth 1 a))) 2250 ((eq (car a) 'special-const) 2251 (calc-with-default-simplification 2252 (math-normalize (nth 1 a)))) 2253 ((eq (car a) 'var) 2254 (cons 'var (cdr a))) ; need to re-cons for selection routines 2255 ((eq (car a) 'calcFunc-if) 2256 (math-normalize-logical-op a)) 2257 ((memq (car a) '(calcFunc-lambda calcFunc-quote calcFunc-condition)) 2258 (let ((calc-simplify-mode 'none)) 2259 (cons (car a) (mapcar 'math-normalize (cdr a))))) 2260 ((eq (car a) 'calcFunc-evalto) 2261 (setq a (or (nth 1 a) 0)) 2262 (or calc-refreshing-evaltos 2263 (setq a (let ((calc-simplify-mode 'none)) (math-normalize a)))) 2264 (let ((b (if (and (eq (car-safe a) 'calcFunc-assign) 2265 (= (length a) 3)) 2266 (nth 2 a) 2267 a))) 2268 (list 'calcFunc-evalto 2269 a 2270 (if (eq calc-simplify-mode 'none) 2271 (math-normalize b) 2272 (calc-with-default-simplification 2273 (math-evaluate-expr b)))))) 2274 ((or (integerp (car a)) (consp (car a))) 2275 (if (null (cdr a)) 2276 (math-normalize (car a)) 2277 (error "Can't use multi-valued function in an expression"))))) 2278 2279;; The variable math-normalize-a is local to math-normalize in calc.el, 2280;; but is used by math-normalize-nonstandard, which is called by 2281;; math-normalize. 2282(defvar math-normalize-a) 2283 2284(defun math-normalize-nonstandard () 2285 (if (consp calc-simplify-mode) 2286 (progn 2287 (setq calc-simplify-mode 'none 2288 math-simplify-only (car-safe (cdr-safe math-normalize-a))) 2289 nil) 2290 (and (symbolp (car math-normalize-a)) 2291 (or (eq calc-simplify-mode 'none) 2292 (and (eq calc-simplify-mode 'num) 2293 (let ((aptr (setq math-normalize-a 2294 (cons 2295 (car math-normalize-a) 2296 (mapcar 'math-normalize 2297 (cdr math-normalize-a)))))) 2298 (while (and aptr (math-constp (car aptr))) 2299 (setq aptr (cdr aptr))) 2300 aptr))) 2301 (cons (car math-normalize-a) 2302 (mapcar 'math-normalize (cdr math-normalize-a)))))) 2303 2304 2305;;; Normalize a bignum digit list by trimming high-end zeros. [L l] 2306(defun math-norm-bignum (a) 2307 (let ((digs a) (last nil)) 2308 (while digs 2309 (or (eq (car digs) 0) (setq last digs)) 2310 (setq digs (cdr digs))) 2311 (and last 2312 (progn 2313 (setcdr last nil) 2314 a)))) 2315 2316(defun math-bignum-test (a) ; [B N; B s; b b] 2317 (if (consp a) 2318 a 2319 (math-bignum a))) 2320 2321 2322;;; Return 0 for zero, -1 for negative, 1 for positive. [S n] [Public] 2323(defun calcFunc-sign (a &optional x) 2324 (let ((signs (math-possible-signs a))) 2325 (cond ((eq signs 4) (or x 1)) 2326 ((eq signs 2) 0) 2327 ((eq signs 1) (if x (math-neg x) -1)) 2328 ((math-looks-negp a) (math-neg (calcFunc-sign (math-neg a)))) 2329 (t (calc-record-why 'realp a) 2330 (if x 2331 (list 'calcFunc-sign a x) 2332 (list 'calcFunc-sign a)))))) 2333 2334;;; Return 0 if A is numerically equal to B, <0 if less, >0 if more. 2335;;; Arguments must be normalized! [S N N] 2336(defun math-compare (a b) 2337 (cond ((equal a b) 2338 (if (and (consp a) 2339 (memq (car a) '(var neg * /)) 2340 (math-infinitep a)) 2341 2 2342 0)) 2343 ((and (integerp a) (Math-integerp b)) 2344 (if (consp b) 2345 (if (eq (car b) 'bigpos) -1 1) 2346 (if (< a b) -1 1))) 2347 ((and (eq (car-safe a) 'bigpos) (Math-integerp b)) 2348 (if (eq (car-safe b) 'bigpos) 2349 (math-compare-bignum (cdr a) (cdr b)) 2350 1)) 2351 ((and (eq (car-safe a) 'bigneg) (Math-integerp b)) 2352 (if (eq (car-safe b) 'bigneg) 2353 (math-compare-bignum (cdr b) (cdr a)) 2354 -1)) 2355 ((eq (car-safe a) 'frac) 2356 (if (eq (car-safe b) 'frac) 2357 (math-compare (math-mul (nth 1 a) (nth 2 b)) 2358 (math-mul (nth 1 b) (nth 2 a))) 2359 (math-compare (nth 1 a) (math-mul b (nth 2 a))))) 2360 ((eq (car-safe b) 'frac) 2361 (math-compare (math-mul a (nth 2 b)) (nth 1 b))) 2362 ((and (eq (car-safe a) 'float) (eq (car-safe b) 'float)) 2363 (if (math-lessp-float a b) -1 1)) 2364 ((and (eq (car-safe a) 'date) (eq (car-safe b) 'date)) 2365 (math-compare (nth 1 a) (nth 1 b))) 2366 ((and (or (Math-anglep a) 2367 (and (eq (car a) 'cplx) (eq (nth 2 a) 0))) 2368 (or (Math-anglep b) 2369 (and (eq (car b) 'cplx) (eq (nth 2 b) 0)))) 2370 (calcFunc-sign (math-add a (math-neg b)))) 2371 ((and (eq (car-safe a) 'intv) 2372 (or (Math-anglep b) (eq (car-safe b) 'date))) 2373 (let ((res (math-compare (nth 2 a) b))) 2374 (cond ((eq res 1) 1) 2375 ((and (eq res 0) (memq (nth 1 a) '(0 1))) 1) 2376 ((eq (setq res (math-compare (nth 3 a) b)) -1) -1) 2377 ((and (eq res 0) (memq (nth 1 a) '(0 2))) -1) 2378 (t 2)))) 2379 ((and (eq (car-safe b) 'intv) 2380 (or (Math-anglep a) (eq (car-safe a) 'date))) 2381 (let ((res (math-compare a (nth 2 b)))) 2382 (cond ((eq res -1) -1) 2383 ((and (eq res 0) (memq (nth 1 b) '(0 1))) -1) 2384 ((eq (setq res (math-compare a (nth 3 b))) 1) 1) 2385 ((and (eq res 0) (memq (nth 1 b) '(0 2))) 1) 2386 (t 2)))) 2387 ((and (eq (car-safe a) 'intv) (eq (car-safe b) 'intv)) 2388 (let ((res (math-compare (nth 3 a) (nth 2 b)))) 2389 (cond ((eq res -1) -1) 2390 ((and (eq res 0) (or (memq (nth 1 a) '(0 2)) 2391 (memq (nth 1 b) '(0 1)))) -1) 2392 ((eq (setq res (math-compare (nth 2 a) (nth 3 b))) 1) 1) 2393 ((and (eq res 0) (or (memq (nth 1 a) '(0 1)) 2394 (memq (nth 1 b) '(0 2)))) 1) 2395 (t 2)))) 2396 ((math-infinitep a) 2397 (if (or (equal a '(var uinf var-uinf)) 2398 (equal a '(var nan var-nan))) 2399 2 2400 (let ((dira (math-infinite-dir a))) 2401 (if (math-infinitep b) 2402 (if (or (equal b '(var uinf var-uinf)) 2403 (equal b '(var nan var-nan))) 2404 2 2405 (let ((dirb (math-infinite-dir b))) 2406 (cond ((and (eq dira 1) (eq dirb -1)) 1) 2407 ((and (eq dira -1) (eq dirb 1)) -1) 2408 (t 2)))) 2409 (cond ((eq dira 1) 1) 2410 ((eq dira -1) -1) 2411 (t 2)))))) 2412 ((math-infinitep b) 2413 (if (or (equal b '(var uinf var-uinf)) 2414 (equal b '(var nan var-nan))) 2415 2 2416 (let ((dirb (math-infinite-dir b))) 2417 (cond ((eq dirb 1) -1) 2418 ((eq dirb -1) 1) 2419 (t 2))))) 2420 ((and (eq (car-safe a) 'calcFunc-exp) 2421 (eq (car-safe b) '^) 2422 (equal (nth 1 b) '(var e var-e))) 2423 (math-compare (nth 1 a) (nth 2 b))) 2424 ((and (eq (car-safe b) 'calcFunc-exp) 2425 (eq (car-safe a) '^) 2426 (equal (nth 1 a) '(var e var-e))) 2427 (math-compare (nth 2 a) (nth 1 b))) 2428 ((or (and (eq (car-safe a) 'calcFunc-sqrt) 2429 (eq (car-safe b) '^) 2430 (or (equal (nth 2 b) '(frac 1 2)) 2431 (equal (nth 2 b) '(float 5 -1)))) 2432 (and (eq (car-safe b) 'calcFunc-sqrt) 2433 (eq (car-safe a) '^) 2434 (or (equal (nth 2 a) '(frac 1 2)) 2435 (equal (nth 2 a) '(float 5 -1))))) 2436 (math-compare (nth 1 a) (nth 1 b))) 2437 ((eq (car-safe a) 'var) 2438 2) 2439 (t 2440 (if (and (consp a) (consp b) 2441 (eq (car a) (car b)) 2442 (math-compare-lists (cdr a) (cdr b))) 2443 0 2444 2)))) 2445 2446;;; Compare two bignum digit lists, return -1 for A<B, 0 for A=B, 1 for A>B. 2447(defun math-compare-bignum (a b) ; [S l l] 2448 (let ((res 0)) 2449 (while (and a b) 2450 (if (< (car a) (car b)) 2451 (setq res -1) 2452 (if (> (car a) (car b)) 2453 (setq res 1))) 2454 (setq a (cdr a) 2455 b (cdr b))) 2456 (if a 2457 (progn 2458 (while (eq (car a) 0) (setq a (cdr a))) 2459 (if a 1 res)) 2460 (while (eq (car b) 0) (setq b (cdr b))) 2461 (if b -1 res)))) 2462 2463(defun math-compare-lists (a b) 2464 (cond ((null a) (null b)) 2465 ((null b) nil) 2466 (t (and (Math-equal (car a) (car b)) 2467 (math-compare-lists (cdr a) (cdr b)))))) 2468 2469(defun math-lessp-float (a b) ; [P F F] 2470 (let ((ediff (- (nth 2 a) (nth 2 b)))) 2471 (if (>= ediff 0) 2472 (if (>= ediff (+ calc-internal-prec calc-internal-prec)) 2473 (if (eq (nth 1 a) 0) 2474 (Math-integer-posp (nth 1 b)) 2475 (Math-integer-negp (nth 1 a))) 2476 (Math-lessp (math-scale-int (nth 1 a) ediff) 2477 (nth 1 b))) 2478 (if (>= (setq ediff (- ediff)) 2479 (+ calc-internal-prec calc-internal-prec)) 2480 (if (eq (nth 1 b) 0) 2481 (Math-integer-negp (nth 1 a)) 2482 (Math-integer-posp (nth 1 b))) 2483 (Math-lessp (nth 1 a) 2484 (math-scale-int (nth 1 b) ediff)))))) 2485 2486;;; True if A is numerically equal to B. [P N N] [Public] 2487(defun math-equal (a b) 2488 (= (math-compare a b) 0)) 2489 2490;;; True if A is numerically less than B. [P R R] [Public] 2491(defun math-lessp (a b) 2492 (= (math-compare a b) -1)) 2493 2494;;; True if A is numerically equal to the integer B. [P N S] [Public] 2495;;; B must not be a multiple of 10. 2496(defun math-equal-int (a b) 2497 (or (eq a b) 2498 (and (eq (car-safe a) 'float) 2499 (eq (nth 1 a) b) 2500 (= (nth 2 a) 0)))) 2501 2502 2503 2504 2505;;; Return the dimensions of a matrix as a list. [l x] [Public] 2506(defun math-mat-dimens (m) 2507 (if (math-vectorp m) 2508 (if (math-matrixp m) 2509 (cons (1- (length m)) 2510 (math-mat-dimens (nth 1 m))) 2511 (list (1- (length m)))) 2512 nil)) 2513 2514 2515 2516(defun calc-binary-op-fancy (name func arg ident unary) 2517 (let ((n (prefix-numeric-value arg))) 2518 (cond ((> n 1) 2519 (calc-enter-result n 2520 name 2521 (list 'calcFunc-reduce 2522 (math-calcFunc-to-var func) 2523 (cons 'vec (calc-top-list-n n))))) 2524 ((= n 1) 2525 (if unary 2526 (calc-enter-result 1 name (list unary (calc-top-n 1))))) 2527 ((= n 0) 2528 (if ident 2529 (calc-enter-result 0 name ident) 2530 (error "Argument must be nonzero"))) 2531 (t 2532 (let ((rhs (calc-top-n 1))) 2533 (calc-enter-result (- 1 n) 2534 name 2535 (mapcar (function 2536 (lambda (x) 2537 (list func x rhs))) 2538 (calc-top-list-n (- n) 2)))))))) 2539 2540(defun calc-unary-op-fancy (name func arg) 2541 (let ((n (prefix-numeric-value arg))) 2542 (if (= n 0) (setq n (calc-stack-size))) 2543 (cond ((> n 0) 2544 (calc-enter-result n 2545 name 2546 (mapcar (function 2547 (lambda (x) 2548 (list func x))) 2549 (calc-top-list-n n)))) 2550 ((< n 0) 2551 (calc-enter-result 1 2552 name 2553 (list func (calc-top-n (- n))) 2554 (- n)))))) 2555 2556(defvar var-Holidays '(vec (var sat var-sat) (var sun var-sun))) 2557(defvar var-Decls (list 'vec)) 2558 2559 2560(defun math-inexact-result () 2561 (and calc-symbolic-mode 2562 (signal 'inexact-result nil))) 2563 2564(defun math-overflow (&optional exp) 2565 (if (and exp (math-negp exp)) 2566 (math-underflow) 2567 (signal 'math-overflow nil))) 2568 2569(defun math-underflow () 2570 (signal 'math-underflow nil)) 2571 2572;;; Compute the greatest common divisor of A and B. [I I I] [Public] 2573(defun math-gcd (a b) 2574 (cond ((not (or (consp a) (consp b))) 2575 (if (< a 0) (setq a (- a))) 2576 (if (< b 0) (setq b (- b))) 2577 (let (c) 2578 (if (< a b) 2579 (setq c b b a a c)) 2580 (while (> b 0) 2581 (setq c b 2582 b (% a b) 2583 a c)) 2584 a)) 2585 ((eq a 0) b) 2586 ((eq b 0) a) 2587 (t 2588 (if (Math-integer-negp a) (setq a (math-neg a))) 2589 (if (Math-integer-negp b) (setq b (math-neg b))) 2590 (let (c) 2591 (if (Math-natnum-lessp a b) 2592 (setq c b b a a c)) 2593 (while (and (consp a) (not (eq b 0))) 2594 (setq c b 2595 b (math-imod a b) 2596 a c)) 2597 (while (> b 0) 2598 (setq c b 2599 b (% a b) 2600 a c)) 2601 a)))) 2602 2603 2604;;;; Algebra. 2605 2606;;; Evaluate variables in an expression. 2607(defun math-evaluate-expr (x) ; [Public] 2608 (if calc-embedded-info 2609 (calc-embedded-evaluate-expr x) 2610 (calc-normalize (math-evaluate-expr-rec x)))) 2611 2612(defalias 'calcFunc-evalv 'math-evaluate-expr) 2613 2614(defun calcFunc-evalvn (x &optional prec) 2615 (if prec 2616 (progn 2617 (or (math-num-integerp prec) 2618 (if (and (math-vectorp prec) 2619 (= (length prec) 2) 2620 (math-num-integerp (nth 1 prec))) 2621 (setq prec (math-add (nth 1 prec) calc-internal-prec)) 2622 (math-reject-arg prec 'integerp))) 2623 (setq prec (math-trunc prec)) 2624 (if (< prec 3) (setq prec 3)) 2625 (if (> prec calc-internal-prec) 2626 (math-normalize 2627 (let ((calc-internal-prec prec)) 2628 (calcFunc-evalvn x))) 2629 (let ((calc-internal-prec prec)) 2630 (calcFunc-evalvn x)))) 2631 (let ((calc-symbolic-mode nil)) 2632 (math-evaluate-expr x)))) 2633 2634(defun math-evaluate-expr-rec (x) 2635 (if (consp x) 2636 (if (memq (car x) '(calcFunc-quote calcFunc-condition 2637 calcFunc-evalto calcFunc-assign)) 2638 (if (and (eq (car x) 'calcFunc-assign) 2639 (= (length x) 3)) 2640 (list (car x) (nth 1 x) (math-evaluate-expr-rec (nth 2 x))) 2641 x) 2642 (if (eq (car x) 'var) 2643 (if (and (calc-var-value (nth 2 x)) 2644 (not (eq (car-safe (symbol-value (nth 2 x))) 2645 'incomplete))) 2646 (let ((val (symbol-value (nth 2 x)))) 2647 (if (eq (car-safe val) 'special-const) 2648 (if calc-symbolic-mode 2649 x 2650 val) 2651 val)) 2652 x) 2653 (if (Math-primp x) 2654 x 2655 (cons (car x) (mapcar 'math-evaluate-expr-rec (cdr x)))))) 2656 x)) 2657 2658(defun math-any-floats (expr) 2659 (if (Math-primp expr) 2660 (math-floatp expr) 2661 (while (and (setq expr (cdr expr)) (not (math-any-floats (car expr))))) 2662 expr)) 2663 2664(defvar var-FactorRules 'calc-FactorRules) 2665 2666(defvar math-mt-many nil) 2667(defvar math-mt-func nil) 2668 2669(defun math-map-tree (math-mt-func mmt-expr &optional math-mt-many) 2670 (or math-mt-many (setq math-mt-many 1000000)) 2671 (math-map-tree-rec mmt-expr)) 2672 2673(defun math-map-tree-rec (mmt-expr) 2674 (or (= math-mt-many 0) 2675 (let ((mmt-done nil) 2676 mmt-nextval) 2677 (while (not mmt-done) 2678 (while (and (/= math-mt-many 0) 2679 (setq mmt-nextval (funcall math-mt-func mmt-expr)) 2680 (not (equal mmt-expr mmt-nextval))) 2681 (setq mmt-expr mmt-nextval 2682 math-mt-many (if (> math-mt-many 0) 2683 (1- math-mt-many) 2684 (1+ math-mt-many)))) 2685 (if (or (Math-primp mmt-expr) 2686 (<= math-mt-many 0)) 2687 (setq mmt-done t) 2688 (setq mmt-nextval (cons (car mmt-expr) 2689 (mapcar 'math-map-tree-rec 2690 (cdr mmt-expr)))) 2691 (if (equal mmt-nextval mmt-expr) 2692 (setq mmt-done t) 2693 (setq mmt-expr mmt-nextval)))))) 2694 mmt-expr) 2695 2696(defun math-is-true (expr) 2697 (if (Math-numberp expr) 2698 (not (Math-zerop expr)) 2699 (math-known-nonzerop expr))) 2700 2701(defun math-const-var (expr) 2702 (and (consp expr) 2703 (eq (car expr) 'var) 2704 (or (and (symbolp (nth 2 expr)) 2705 (boundp (nth 2 expr)) 2706 (eq (car-safe (symbol-value (nth 2 expr))) 'special-const)) 2707 (memq (nth 2 expr) '(var-inf var-uinf var-nan))))) 2708 2709;; The variable math-integral-cache is originally declared in calcalg2.el, 2710;; but is set by math-defintegral and math-definitegral2. 2711(defvar math-integral-cache) 2712 2713(defmacro math-defintegral (funcs &rest code) 2714 (setq math-integral-cache nil) 2715 (append '(progn) 2716 (mapcar (function 2717 (lambda (func) 2718 (list 'put (list 'quote func) ''math-integral 2719 (list 'nconc 2720 (list 'get (list 'quote func) ''math-integral) 2721 (list 'list 2722 (list 'function 2723 (append '(lambda (u)) 2724 code))))))) 2725 (if (symbolp funcs) (list funcs) funcs)))) 2726(put 'math-defintegral 'lisp-indent-hook 1) 2727 2728(defmacro math-defintegral-2 (funcs &rest code) 2729 (setq math-integral-cache nil) 2730 (append '(progn) 2731 (mapcar (function 2732 (lambda (func) 2733 (list 'put (list 'quote func) ''math-integral-2 2734 (list 'nconc 2735 (list 'get (list 'quote func) 2736 ''math-integral-2) 2737 (list 'list 2738 (list 'function 2739 (append '(lambda (u v)) 2740 code))))))) 2741 (if (symbolp funcs) (list funcs) funcs)))) 2742(put 'math-defintegral-2 'lisp-indent-hook 1) 2743 2744(defvar var-IntegAfterRules 'calc-IntegAfterRules) 2745 2746(defvar var-FitRules 'calc-FitRules) 2747 2748(defvar math-poly-base-variable nil) 2749(defvar math-poly-neg-powers nil) 2750(defvar math-poly-mult-powers 1) 2751(defvar math-poly-frac-powers nil) 2752(defvar math-poly-exp-base nil) 2753 2754(defun math-build-var-name (name) 2755 (if (stringp name) 2756 (setq name (intern name))) 2757 (if (string-match "\\`var-." (symbol-name name)) 2758 (list 'var (intern (substring (symbol-name name) 4)) name) 2759 (list 'var name (intern (concat "var-" (symbol-name name)))))) 2760 2761(defvar math-simplifying-units nil) 2762(defvar math-combining-units t) 2763 2764;;; Nontrivial number parsing. 2765 2766(defun math-read-number-fancy (s) 2767 (cond 2768 2769 ;; Integer+fractions 2770 ((string-match "^\\([0-9]*\\)[:/]\\([0-9]*\\)[:/]\\([0-9]*\\)$" s) 2771 (let ((int (math-match-substring s 1)) 2772 (num (math-match-substring s 2)) 2773 (den (math-match-substring s 3))) 2774 (let ((int (if (> (length int) 0) (math-read-number int) 0)) 2775 (num (if (> (length num) 0) (math-read-number num) 1)) 2776 (den (if (> (length num) 0) (math-read-number den) 1))) 2777 (and int num den 2778 (math-integerp int) (math-integerp num) (math-integerp den) 2779 (not (math-zerop den)) 2780 (list 'frac (math-add num (math-mul int den)) den))))) 2781 2782 ;; Fractions 2783 ((string-match "^\\([0-9]*\\)[:/]\\([0-9]*\\)$" s) 2784 (let ((num (math-match-substring s 1)) 2785 (den (math-match-substring s 2))) 2786 (let ((num (if (> (length num) 0) (math-read-number num) 1)) 2787 (den (if (> (length num) 0) (math-read-number den) 1))) 2788 (and num den (math-integerp num) (math-integerp den) 2789 (not (math-zerop den)) 2790 (list 'frac num den))))) 2791 2792 ;; Modulo forms 2793 ((string-match "^\\(.*\\) *mod *\\(.*\\)$" s) 2794 (let* ((n (math-match-substring s 1)) 2795 (m (math-match-substring s 2)) 2796 (n (math-read-number n)) 2797 (m (math-read-number m))) 2798 (and n m (math-anglep n) (math-anglep m) 2799 (list 'mod n m)))) 2800 2801 ;; Error forms 2802 ((string-match "^\\(.*\\) *\\+/- *\\(.*\\)$" s) 2803 (let* ((x (math-match-substring s 1)) 2804 (sigma (math-match-substring s 2)) 2805 (x (math-read-number x)) 2806 (sigma (math-read-number sigma))) 2807 (and x sigma (math-scalarp x) (math-anglep sigma) 2808 (list 'sdev x sigma)))) 2809 2810 ;; Hours (or degrees) 2811 ((or (string-match "^\\([^#^]+\\)[@oOhH]\\(.*\\)$" s) 2812 (string-match "^\\([^#^]+\\)[dD][eE]?[gG]?\\(.*\\)$" s)) 2813 (let* ((hours (math-match-substring s 1)) 2814 (minsec (math-match-substring s 2)) 2815 (hours (math-read-number hours)) 2816 (minsec (if (> (length minsec) 0) (math-read-number minsec) 0))) 2817 (and hours minsec 2818 (math-num-integerp hours) 2819 (not (math-negp hours)) (not (math-negp minsec)) 2820 (cond ((math-num-integerp minsec) 2821 (and (Math-lessp minsec 60) 2822 (list 'hms hours minsec 0))) 2823 ((and (eq (car-safe minsec) 'hms) 2824 (math-zerop (nth 1 minsec))) 2825 (math-add (list 'hms hours 0 0) minsec)) 2826 (t nil))))) 2827 2828 ;; Minutes 2829 ((string-match "^\\([^'#^]+\\)[mM']\\(.*\\)$" s) 2830 (let* ((minutes (math-match-substring s 1)) 2831 (seconds (math-match-substring s 2)) 2832 (minutes (math-read-number minutes)) 2833 (seconds (if (> (length seconds) 0) (math-read-number seconds) 0))) 2834 (and minutes seconds 2835 (math-num-integerp minutes) 2836 (not (math-negp minutes)) (not (math-negp seconds)) 2837 (cond ((math-realp seconds) 2838 (and (Math-lessp minutes 60) 2839 (list 'hms 0 minutes seconds))) 2840 ((and (eq (car-safe seconds) 'hms) 2841 (math-zerop (nth 1 seconds)) 2842 (math-zerop (nth 2 seconds))) 2843 (math-add (list 'hms 0 minutes 0) seconds)) 2844 (t nil))))) 2845 2846 ;; Seconds 2847 ((string-match "^\\([^\"#^]+\\)[sS\"]$" s) 2848 (let ((seconds (math-read-number (math-match-substring s 1)))) 2849 (and seconds (math-realp seconds) 2850 (not (math-negp seconds)) 2851 (Math-lessp seconds 60) 2852 (list 'hms 0 0 seconds)))) 2853 2854 ;; Integer+fraction with explicit radix 2855 ((string-match "^\\([0-9]+\\)\\(#\\|\\^\\^\\)\\([0-9a-zA-Z]*\\)[:/]\\([0-9a-zA-Z]*\\)[:/]\\([0-9a-zA-Z]\\)$" s) 2856 (let ((radix (string-to-number (math-match-substring s 1))) 2857 (int (math-match-substring s 3)) 2858 (num (math-match-substring s 4)) 2859 (den (math-match-substring s 5))) 2860 (let ((int (if (> (length int) 0) (math-read-radix int radix) 0)) 2861 (num (if (> (length num) 0) (math-read-radix num radix) 1)) 2862 (den (if (> (length den) 0) (math-read-radix den radix) 1))) 2863 (and int num den (not (math-zerop den)) 2864 (list 'frac 2865 (math-add num (math-mul int den)) 2866 den))))) 2867 2868 ;; Fraction with explicit radix 2869 ((string-match "^\\([0-9]+\\)\\(#\\|\\^\\^\\)\\([0-9a-zA-Z]*\\)[:/]\\([0-9a-zA-Z]*\\)$" s) 2870 (let ((radix (string-to-number (math-match-substring s 1))) 2871 (num (math-match-substring s 3)) 2872 (den (math-match-substring s 4))) 2873 (let ((num (if (> (length num) 0) (math-read-radix num radix) 1)) 2874 (den (if (> (length den) 0) (math-read-radix den radix) 1))) 2875 (and num den (not (math-zerop den)) (list 'frac num den))))) 2876 2877 ;; Float with explicit radix and exponent 2878 ((or (string-match "^0*\\(\\([2-9]\\|1[0-4]\\)\\(#\\|\\^\\^\\)[0-9a-dA-D.]+\\)[eE]\\([-+]?[0-9]+\\)$" s) 2879 (string-match "^\\(\\([0-9]+\\)\\(#\\|\\^\\^\\)[0-9a-zA-Z.]+\\) *\\* *\\2\\.? *\\^ *\\([-+]?[0-9]+\\)$" s)) 2880 (let ((radix (string-to-number (math-match-substring s 2))) 2881 (mant (math-match-substring s 1)) 2882 (exp (math-match-substring s 4))) 2883 (let ((mant (math-read-number mant)) 2884 (exp (math-read-number exp))) 2885 (and mant exp 2886 (math-mul mant (math-pow (math-float radix) exp)))))) 2887 2888 ;; Float with explicit radix, no exponent 2889 ((string-match "^\\([0-9]+\\)\\(#\\|\\^\\^\\)\\([0-9a-zA-Z]*\\)\\.\\([0-9a-zA-Z]*\\)$" s) 2890 (let ((radix (string-to-number (math-match-substring s 1))) 2891 (int (math-match-substring s 3)) 2892 (fracs (math-match-substring s 4))) 2893 (let ((int (if (> (length int) 0) (math-read-radix int radix) 0)) 2894 (frac (if (> (length fracs) 0) (math-read-radix fracs radix) 0)) 2895 (calc-prefer-frac nil)) 2896 (and int frac 2897 (math-add int (math-div frac (math-pow radix (length fracs)))))))) 2898 2899 ;; Integer with explicit radix 2900 ((string-match "^\\([0-9]+\\)\\(#\\|\\^\\^\\)\\([0-9a-zA-Z]+\\)$" s) 2901 (math-read-radix (math-match-substring s 3) 2902 (string-to-number (math-match-substring s 1)))) 2903 2904 ;; C language hexadecimal notation 2905 ((and (eq calc-language 'c) 2906 (string-match "^0[xX]\\([0-9a-fA-F]+\\)$" s)) 2907 (let ((digs (math-match-substring s 1))) 2908 (math-read-radix digs 16))) 2909 2910 ;; Pascal language hexadecimal notation 2911 ((and (eq calc-language 'pascal) 2912 (string-match "^\\$\\([0-9a-fA-F]+\\)$" s)) 2913 (let ((digs (math-match-substring s 1))) 2914 (math-read-radix digs 16))) 2915 2916 ;; Fraction using "/" instead of ":" 2917 ((string-match "^\\([0-9]+\\)/\\([0-9/]+\\)$" s) 2918 (math-read-number (concat (math-match-substring s 1) ":" 2919 (math-match-substring s 2)))) 2920 2921 ;; Syntax error! 2922 (t nil))) 2923 2924(defun math-read-radix (s r) ; [I X D] 2925 (setq s (upcase s)) 2926 (let ((i 0) 2927 (res 0) 2928 dig) 2929 (while (and (< i (length s)) 2930 (setq dig (math-read-radix-digit (elt s i))) 2931 (< dig r)) 2932 (setq res (math-add (math-mul res r) dig) 2933 i (1+ i))) 2934 (and (= i (length s)) 2935 res))) 2936 2937 2938 2939;;; Expression parsing. 2940 2941(defvar math-expr-data) 2942 2943(defun math-read-expr (math-exp-str) 2944 (let ((math-exp-pos 0) 2945 (math-exp-old-pos 0) 2946 (math-exp-keep-spaces nil) 2947 math-exp-token math-expr-data) 2948 (setq math-exp-str (math-read-preprocess-string math-exp-str)) 2949 (while (setq math-exp-token (string-match "\\.\\.\\([^.]\\|.[^.]\\)" math-exp-str)) 2950 (setq math-exp-str (concat (substring math-exp-str 0 math-exp-token) "\\dots" 2951 (substring math-exp-str (+ math-exp-token 2))))) 2952 (math-build-parse-table) 2953 (math-read-token) 2954 (let ((val (catch 'syntax (math-read-expr-level 0)))) 2955 (if (stringp val) 2956 (list 'error math-exp-old-pos val) 2957 (if (equal math-exp-token 'end) 2958 val 2959 (list 'error math-exp-old-pos "Syntax error")))))) 2960 2961(defun math-read-plain-expr (exp-str &optional error-check) 2962 (let* ((calc-language nil) 2963 (math-expr-opers math-standard-opers) 2964 (val (math-read-expr exp-str))) 2965 (and error-check 2966 (eq (car-safe val) 'error) 2967 (error "%s: %s" (nth 2 val) exp-str)) 2968 val)) 2969 2970 2971(defun math-read-string () 2972 (let ((str (read-from-string (concat math-expr-data "\"")))) 2973 (or (and (= (cdr str) (1+ (length math-expr-data))) 2974 (stringp (car str))) 2975 (throw 'syntax "Error in string constant")) 2976 (math-read-token) 2977 (append '(vec) (car str) nil))) 2978 2979 2980 2981;;; They said it couldn't be done... 2982 2983(defun math-read-big-expr (str) 2984 (and (> (length calc-left-label) 0) 2985 (string-match (concat "^" (regexp-quote calc-left-label)) str) 2986 (setq str (concat (substring str 0 (match-beginning 0)) 2987 (substring str (match-end 0))))) 2988 (and (> (length calc-right-label) 0) 2989 (string-match (concat (regexp-quote calc-right-label) " *$") str) 2990 (setq str (concat (substring str 0 (match-beginning 0)) 2991 (substring str (match-end 0))))) 2992 (if (string-match "\\\\[^ \n|]" str) 2993 (if (eq calc-language 'latex) 2994 (math-read-expr str) 2995 (let ((calc-language 'latex) 2996 (calc-language-option nil) 2997 (math-expr-opers (get 'latex 'math-oper-table)) 2998 (math-expr-function-mapping (get 'latex 'math-function-table)) 2999 (math-expr-variable-mapping (get 'latex 'math-variable-table))) 3000 (math-read-expr str))) 3001 (let ((math-read-big-lines nil) 3002 (pos 0) 3003 (width 0) 3004 (math-read-big-err-msg nil) 3005 math-read-big-baseline math-read-big-h2 3006 new-pos p) 3007 (while (setq new-pos (string-match "\n" str pos)) 3008 (setq math-read-big-lines 3009 (cons (substring str pos new-pos) math-read-big-lines) 3010 pos (1+ new-pos))) 3011 (setq math-read-big-lines 3012 (nreverse (cons (substring str pos) math-read-big-lines)) 3013 p math-read-big-lines) 3014 (while p 3015 (setq width (max width (length (car p))) 3016 p (cdr p))) 3017 (if (math-read-big-bigp math-read-big-lines) 3018 (or (catch 'syntax 3019 (math-read-big-rec 0 0 width (length math-read-big-lines))) 3020 math-read-big-err-msg 3021 '(error 0 "Syntax error")) 3022 (math-read-expr str))))) 3023 3024(defun math-read-big-bigp (math-read-big-lines) 3025 (and (cdr math-read-big-lines) 3026 (let ((matrix nil) 3027 (v 0) 3028 (height (if (> (length (car math-read-big-lines)) 0) 1 0))) 3029 (while (and (cdr math-read-big-lines) 3030 (let* ((i 0) 3031 j 3032 (l1 (car math-read-big-lines)) 3033 (l2 (nth 1 math-read-big-lines)) 3034 (len (min (length l1) (length l2)))) 3035 (if (> (length l2) 0) 3036 (setq height (1+ height))) 3037 (while (and (< i len) 3038 (or (memq (aref l1 i) '(?\ ?\- ?\_)) 3039 (memq (aref l2 i) '(?\ ?\-)) 3040 (and (memq (aref l1 i) '(?\| ?\,)) 3041 (= (aref l2 i) (aref l1 i))) 3042 (and (eq (aref l1 i) ?\[) 3043 (eq (aref l2 i) ?\[) 3044 (let ((math-rb-h2 (length l1))) 3045 (setq j (math-read-big-balance 3046 (1+ i) v "["))) 3047 (setq i (1- j))))) 3048 (setq i (1+ i))) 3049 (or (= i len) 3050 (and (eq (aref l1 i) ?\[) 3051 (eq (aref l2 i) ?\[) 3052 (setq matrix t) 3053 nil)))) 3054 (setq math-read-big-lines (cdr math-read-big-lines) 3055 v (1+ v))) 3056 (or (and (> height 1) 3057 (not (cdr math-read-big-lines))) 3058 matrix)))) 3059 3060;;; Nontrivial "flat" formatting. 3061 3062(defvar math-format-hash-args nil) 3063(defvar calc-can-abbrev-vectors nil) 3064 3065(defun math-format-flat-expr-fancy (a prec) 3066 (cond 3067 ((eq (car a) 'incomplete) 3068 (format "<incomplete %s>" (nth 1 a))) 3069 ((eq (car a) 'vec) 3070 (if (or calc-full-trail-vectors (not calc-can-abbrev-vectors) 3071 (< (length a) 7)) 3072 (concat "[" (math-format-flat-vector (cdr a) ", " 3073 (if (cdr (cdr a)) 0 1000)) "]") 3074 (concat "[" 3075 (math-format-flat-expr (nth 1 a) 0) ", " 3076 (math-format-flat-expr (nth 2 a) 0) ", " 3077 (math-format-flat-expr (nth 3 a) 0) ", ..., " 3078 (math-format-flat-expr (nth (1- (length a)) a) 0) "]"))) 3079 ((eq (car a) 'intv) 3080 (concat (if (memq (nth 1 a) '(0 1)) "(" "[") 3081 (math-format-flat-expr (nth 2 a) 1000) 3082 " .. " 3083 (math-format-flat-expr (nth 3 a) 1000) 3084 (if (memq (nth 1 a) '(0 2)) ")" "]"))) 3085 ((eq (car a) 'date) 3086 (concat "<" (math-format-date a) ">")) 3087 ((and (eq (car a) 'calcFunc-lambda) (> (length a) 2)) 3088 (let ((p (cdr a)) 3089 (ap calc-arg-values) 3090 (math-format-hash-args (if (= (length a) 3) 1 t))) 3091 (while (and (cdr p) (equal (car p) (car ap))) 3092 (setq p (cdr p) ap (cdr ap))) 3093 (concat "<" 3094 (if (cdr p) 3095 (concat (math-format-flat-vector 3096 (nreverse (cdr (reverse (cdr a)))) ", " 0) 3097 " : ") 3098 "") 3099 (math-format-flat-expr (nth (1- (length a)) a) 0) 3100 ">"))) 3101 ((eq (car a) 'var) 3102 (or (and math-format-hash-args 3103 (let ((p calc-arg-values) (v 1)) 3104 (while (and p (not (equal (car p) a))) 3105 (setq p (and (eq math-format-hash-args t) (cdr p)) 3106 v (1+ v))) 3107 (and p 3108 (if (eq math-format-hash-args 1) 3109 "#" 3110 (format "#%d" v))))) 3111 (symbol-name (nth 1 a)))) 3112 ((and (memq (car a) '(calcFunc-string calcFunc-bstring)) 3113 (= (length a) 2) 3114 (math-vectorp (nth 1 a)) 3115 (math-vector-is-string (nth 1 a))) 3116 (concat (substring (symbol-name (car a)) 9) 3117 "(" (math-vector-to-string (nth 1 a) t) ")")) 3118 (t 3119 (let ((op (math-assq2 (car a) math-standard-opers))) 3120 (cond ((and op (= (length a) 3)) 3121 (if (> prec (min (nth 2 op) (nth 3 op))) 3122 (concat "(" (math-format-flat-expr a 0) ")") 3123 (let ((lhs (math-format-flat-expr (nth 1 a) (nth 2 op))) 3124 (rhs (math-format-flat-expr (nth 2 a) (nth 3 op)))) 3125 (setq op (car op)) 3126 (if (or (equal op "^") (equal op "_")) 3127 (if (= (aref lhs 0) ?-) 3128 (setq lhs (concat "(" lhs ")"))) 3129 (setq op (concat " " op " "))) 3130 (concat lhs op rhs)))) 3131 ((eq (car a) 'neg) 3132 (concat "-" (math-format-flat-expr (nth 1 a) 1000))) 3133 (t 3134 (concat (math-remove-dashes 3135 (if (string-match "\\`calcFunc-\\([a-zA-Z0-9']+\\)\\'" 3136 (symbol-name (car a))) 3137 (math-match-substring (symbol-name (car a)) 1) 3138 (symbol-name (car a)))) 3139 "(" 3140 (math-format-flat-vector (cdr a) ", " 0) 3141 ")"))))))) 3142 3143(defun math-format-flat-vector (vec sep prec) 3144 (if vec 3145 (let ((buf (math-format-flat-expr (car vec) prec))) 3146 (while (setq vec (cdr vec)) 3147 (setq buf (concat buf sep (math-format-flat-expr (car vec) prec)))) 3148 buf) 3149 "")) 3150 3151(defun math-format-nice-expr (x w) 3152 (cond ((and (eq (car-safe x) 'vec) 3153 (cdr (cdr x)) 3154 (let ((ops '(vec calcFunc-assign calcFunc-condition 3155 calcFunc-schedule calcFunc-iterations 3156 calcFunc-phase))) 3157 (or (memq (car-safe (nth 1 x)) ops) 3158 (memq (car-safe (nth 2 x)) ops) 3159 (memq (car-safe (nth 3 x)) ops) 3160 calc-break-vectors))) 3161 (concat "[ " (math-format-flat-vector (cdr x) ",\n " 0) " ]")) 3162 (t 3163 (let ((str (math-format-flat-expr x 0)) 3164 (pos 0) p) 3165 (or (string-match "\"" str) 3166 (while (<= (setq p (+ pos w)) (length str)) 3167 (while (and (> (setq p (1- p)) pos) 3168 (not (= (aref str p) ? )))) 3169 (if (> p (+ pos 5)) 3170 (setq str (concat (substring str 0 p) 3171 "\n " 3172 (substring str p)) 3173 pos (1+ p)) 3174 (setq pos (+ pos w))))) 3175 str)))) 3176 3177(defun math-assq2 (v a) 3178 (while (and a (not (eq v (nth 1 (car a))))) 3179 (setq a (cdr a))) 3180 (car a)) 3181 3182(defun math-format-number-fancy (a prec) 3183 (cond 3184 ((eq (car a) 'float) ; non-decimal radix 3185 (if (Math-integer-negp (nth 1 a)) 3186 (concat "-" (math-format-number (math-neg a))) 3187 (let ((str (if (and calc-radix-formatter 3188 (not (memq calc-language '(c pascal)))) 3189 (funcall calc-radix-formatter 3190 calc-number-radix 3191 (math-format-radix-float a prec)) 3192 (format "%d#%s" calc-number-radix 3193 (math-format-radix-float a prec))))) 3194 (if (and prec (> prec 191) (string-match "\\*" str)) 3195 (concat "(" str ")") 3196 str)))) 3197 ((eq (car a) 'frac) 3198 (setq a (math-adjust-fraction a)) 3199 (if (> (length (car calc-frac-format)) 1) 3200 (if (Math-integer-negp (nth 1 a)) 3201 (concat "-" (math-format-number (math-neg a))) 3202 (let ((q (math-idivmod (nth 1 a) (nth 2 a)))) 3203 (concat (let ((calc-frac-format nil)) 3204 (math-format-number (car q))) 3205 (substring (car calc-frac-format) 0 1) 3206 (let ((math-radix-explicit-format nil) 3207 (calc-frac-format nil)) 3208 (math-format-number (cdr q))) 3209 (substring (car calc-frac-format) 1 2) 3210 (let ((math-radix-explicit-format nil) 3211 (calc-frac-format nil)) 3212 (math-format-number (nth 2 a)))))) 3213 (concat (let ((calc-frac-format nil)) 3214 (math-format-number (nth 1 a))) 3215 (car calc-frac-format) 3216 (let ((math-radix-explicit-format nil) 3217 (calc-frac-format nil)) 3218 (math-format-number (nth 2 a)))))) 3219 ((eq (car a) 'cplx) 3220 (if (math-zerop (nth 2 a)) 3221 (math-format-number (nth 1 a)) 3222 (if (null calc-complex-format) 3223 (concat "(" (math-format-number (nth 1 a)) 3224 ", " (math-format-number (nth 2 a)) ")") 3225 (if (math-zerop (nth 1 a)) 3226 (if (math-equal-int (nth 2 a) 1) 3227 (symbol-name calc-complex-format) 3228 (if (math-equal-int (nth 2 a) -1) 3229 (concat "-" (symbol-name calc-complex-format)) 3230 (if prec 3231 (math-compose-expr (list '* (nth 2 a) '(cplx 0 1)) prec) 3232 (concat (math-format-number (nth 2 a)) " " 3233 (symbol-name calc-complex-format))))) 3234 (if prec 3235 (math-compose-expr (list (if (math-negp (nth 2 a)) '- '+) 3236 (nth 1 a) 3237 (list 'cplx 0 (math-abs (nth 2 a)))) 3238 prec) 3239 (concat (math-format-number (nth 1 a)) 3240 (if (math-negp (nth 2 a)) " - " " + ") 3241 (math-format-number 3242 (list 'cplx 0 (math-abs (nth 2 a)))))))))) 3243 ((eq (car a) 'polar) 3244 (concat "(" (math-format-number (nth 1 a)) 3245 "; " (math-format-number (nth 2 a)) ")")) 3246 ((eq (car a) 'hms) 3247 (if (math-negp a) 3248 (concat "-" (math-format-number (math-neg a))) 3249 (let ((calc-number-radix 10) 3250 (calc-leading-zeros nil) 3251 (calc-group-digits nil)) 3252 (format calc-hms-format 3253 (let ((calc-frac-format '(":" nil))) 3254 (math-format-number (nth 1 a))) 3255 (let ((calc-frac-format '(":" nil))) 3256 (math-format-number (nth 2 a))) 3257 (math-format-number (nth 3 a)))))) 3258 ((eq (car a) 'intv) 3259 (concat (if (memq (nth 1 a) '(0 1)) "(" "[") 3260 (math-format-number (nth 2 a)) 3261 " .. " 3262 (math-format-number (nth 3 a)) 3263 (if (memq (nth 1 a) '(0 2)) ")" "]"))) 3264 ((eq (car a) 'sdev) 3265 (concat (math-format-number (nth 1 a)) 3266 " +/- " 3267 (math-format-number (nth 2 a)))) 3268 ((eq (car a) 'vec) 3269 (math-format-flat-expr a 0)) 3270 (t (format "%s" a)))) 3271 3272(defun math-adjust-fraction (a) 3273 (if (nth 1 calc-frac-format) 3274 (progn 3275 (if (Math-integerp a) (setq a (list 'frac a 1))) 3276 (let ((g (math-quotient (nth 1 calc-frac-format) 3277 (math-gcd (nth 2 a) 3278 (nth 1 calc-frac-format))))) 3279 (list 'frac (math-mul (nth 1 a) g) (math-mul (nth 2 a) g)))) 3280 a)) 3281 3282(defun math-format-bignum-fancy (a) ; [X L] 3283 (let ((str (cond ((= calc-number-radix 10) 3284 (math-format-bignum-decimal a)) 3285 ((= calc-number-radix 2) 3286 (math-format-bignum-binary a)) 3287 ((= calc-number-radix 8) 3288 (math-format-bignum-octal a)) 3289 ((= calc-number-radix 16) 3290 (math-format-bignum-hex a)) 3291 (t (math-format-bignum-radix a))))) 3292 (if calc-leading-zeros 3293 (let* ((calc-internal-prec 6) 3294 (digs (math-compute-max-digits (math-abs calc-word-size) 3295 calc-number-radix)) 3296 (len (length str))) 3297 (if (< len digs) 3298 (setq str (concat (make-string (- digs len) ?0) str))))) 3299 (if calc-group-digits 3300 (let ((i (length str)) 3301 (g (if (integerp calc-group-digits) 3302 (math-abs calc-group-digits) 3303 (if (memq calc-number-radix '(2 16)) 4 3)))) 3304 (while (> i g) 3305 (setq i (- i g) 3306 str (concat (substring str 0 i) 3307 calc-group-char 3308 (substring str i)))) 3309 str)) 3310 (if (and (/= calc-number-radix 10) 3311 math-radix-explicit-format) 3312 (if calc-radix-formatter 3313 (funcall calc-radix-formatter calc-number-radix str) 3314 (format "%d#%s" calc-number-radix str)) 3315 str))) 3316 3317 3318(defun math-group-float (str) ; [X X] 3319 (let* ((pt (or (string-match "[^0-9a-zA-Z]" str) (length str))) 3320 (g (if (integerp calc-group-digits) (math-abs calc-group-digits) 3)) 3321 (i pt)) 3322 (if (and (integerp calc-group-digits) (< calc-group-digits 0)) 3323 (while (< (setq i (+ (1+ i) g)) (length str)) 3324 (setq str (concat (substring str 0 i) 3325 calc-group-char 3326 (substring str i)) 3327 i (+ i (1- (length calc-group-char)))))) 3328 (setq i pt) 3329 (while (> i g) 3330 (setq i (- i g) 3331 str (concat (substring str 0 i) 3332 calc-group-char 3333 (substring str i)))) 3334 str)) 3335 3336;;; Users can redefine this in their .emacs files. 3337(defvar calc-keypad-user-menu nil 3338 "If non-nil, this describes an additional menu for calc-keypad. 3339It should contain a list of three rows. 3340Each row should be a list of six keys. 3341Each key should be a list of a label string, plus a Calc command name spec. 3342A command spec is a command name symbol, a keyboard macro string, a 3343list containing a numeric entry string, or nil. 3344A key may contain additional specs for Inverse, Hyperbolic, and Inv+Hyp.") 3345 3346(run-hooks 'calc-ext-load-hook) 3347 3348(provide 'calc-ext) 3349 3350;;; arch-tag: 1814ba7f-a390-49dc-9e25-a5adc205e97e 3351;;; calc-ext.el ends here 3352