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

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