code.delx.au - gnu-emacs/blob - lisp/calc/calc-ext.el

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