lisp/calc/calc-ext.el

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