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