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