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