(math-small-factorial-table,math-init-random-base,math-prime-test):
[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
13;; the Free Software Foundation; either version 2, or (at your option)
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]
37b54438
JB
1928(defconst math-approx-pi
1929 (eval-when-compile
1930 (math-read-number-simple "3.141592653589793238463")))
1931(math-defcache math-pi math-approx-pi
136211a9
EZ
1932 (math-add-float (math-mul-float '(float 16 0)
1933 (math-arctan-raw '(float 2 -1)))
1934 (math-mul-float '(float -4 0)
1935 (math-arctan-raw
1936 (math-float '(frac 1 239))))))
1937
1938(math-defcache math-two-pi nil
1939 (math-mul-float (math-pi) '(float 2 0)))
1940
1941(math-defcache math-pi-over-2 nil
1942 (math-mul-float (math-pi) '(float 5 -1)))
1943
1944(math-defcache math-pi-over-4 nil
1945 (math-mul-float (math-pi) '(float 25 -2)))
1946
1947(math-defcache math-pi-over-180 nil
1948 (math-div-float (math-pi) '(float 18 1)))
1949
1950(math-defcache math-sqrt-pi nil
1951 (math-sqrt-float (math-pi)))
1952
1953(math-defcache math-sqrt-2 nil
1954 (math-sqrt-float '(float 2 0)))
1955
1956(math-defcache math-sqrt-12 nil
1957 (math-sqrt-float '(float 12 0)))
1958
1959(math-defcache math-sqrt-two-pi nil
1960 (math-sqrt-float (math-two-pi)))
1961
37b54438
JB
1962(defconst math-approx-sqrt-e
1963 (eval-when-compile (math-read-number-simple "1.648721270700128146849")))
1964
1965(math-defcache math-sqrt-e math-approx-sqrt-e
136211a9
EZ
1966 (math-add-float '(float 1 0) (math-exp-minus-1-raw '(float 5 -1))))
1967
1968(math-defcache math-e nil
1969 (math-pow (math-sqrt-e) 2))
1970
1971(math-defcache math-phi nil
1972 (math-mul-float (math-add-float (math-sqrt-raw '(float 5 0)) '(float 1 0))
1973 '(float 5 -1)))
1974
37b54438
JB
1975(defconst math-approx-gamma-const
1976 (eval-when-compile
1977 (math-read-number-simple
1978 "0.5772156649015328606065120900824024310421593359399235988057672348848677267776646709369470632917467495")))
1979
f9e09a51 1980(math-defcache math-gamma-const nil
37b54438 1981 math-approx-gamma-const)
136211a9
EZ
1982
1983(defun math-half-circle (symb)
1984 (if (eq calc-angle-mode 'rad)
1985 (if symb
1986 '(var pi var-pi)
1987 (math-pi))
cce7e5a6 1988 180))
136211a9
EZ
1989
1990(defun math-full-circle (symb)
cce7e5a6 1991 (math-mul 2 (math-half-circle symb)))
136211a9
EZ
1992
1993(defun math-quarter-circle (symb)
cce7e5a6 1994 (math-div (math-half-circle symb) 2))
136211a9 1995
3132f345 1996(defvar math-expand-formulas nil)
136211a9
EZ
1997
1998;;;; Miscellaneous math routines.
1999
2000;;; True if A is an odd integer. [P R R] [Public]
2001(defun math-oddp (a)
2002 (if (consp a)
2003 (and (memq (car a) '(bigpos bigneg))
2004 (= (% (nth 1 a) 2) 1))
cce7e5a6 2005 (/= (% a 2) 0)))
136211a9
EZ
2006
2007;;; True if A is a small or big integer. [P x] [Public]
2008(defun math-integerp (a)
2009 (or (integerp a)
cce7e5a6 2010 (memq (car-safe a) '(bigpos bigneg))))
136211a9
EZ
2011
2012;;; True if A is (numerically) a non-negative integer. [P N] [Public]
2013(defun math-natnump (a)
2014 (or (natnump a)
cce7e5a6 2015 (eq (car-safe a) 'bigpos)))
136211a9
EZ
2016
2017;;; True if A is a rational (or integer). [P x] [Public]
2018(defun math-ratp (a)
2019 (or (integerp a)
cce7e5a6 2020 (memq (car-safe a) '(bigpos bigneg frac))))
136211a9
EZ
2021
2022;;; True if A is a real (or rational). [P x] [Public]
2023(defun math-realp (a)
2024 (or (integerp a)
cce7e5a6 2025 (memq (car-safe a) '(bigpos bigneg frac float))))
136211a9
EZ
2026
2027;;; True if A is a real or HMS form. [P x] [Public]
2028(defun math-anglep (a)
2029 (or (integerp a)
cce7e5a6 2030 (memq (car-safe a) '(bigpos bigneg frac float hms))))
136211a9
EZ
2031
2032;;; True if A is a number of any kind. [P x] [Public]
2033(defun math-numberp (a)
2034 (or (integerp a)
cce7e5a6 2035 (memq (car-safe a) '(bigpos bigneg frac float cplx polar))))
136211a9
EZ
2036
2037;;; True if A is a complex number or angle. [P x] [Public]
2038(defun math-scalarp (a)
2039 (or (integerp a)
cce7e5a6 2040 (memq (car-safe a) '(bigpos bigneg frac float cplx polar hms))))
136211a9
EZ
2041
2042;;; True if A is a vector. [P x] [Public]
2043(defun math-vectorp (a)
cce7e5a6 2044 (eq (car-safe a) 'vec))
136211a9
EZ
2045
2046;;; True if A is any vector or scalar data object. [P x]
2047(defun math-objvecp (a) ; [Public]
2048 (or (integerp a)
2049 (memq (car-safe a) '(bigpos bigneg frac float cplx polar
cce7e5a6 2050 hms date sdev intv mod vec incomplete))))
136211a9
EZ
2051
2052;;; True if A is an object not composed of sub-formulas . [P x] [Public]
2053(defun math-primp (a)
2054 (or (integerp a)
2055 (memq (car-safe a) '(bigpos bigneg frac float cplx polar
cce7e5a6 2056 hms date mod var))))
136211a9
EZ
2057
2058;;; True if A is numerically (but not literally) an integer. [P x] [Public]
2059(defun math-messy-integerp (a)
2060 (cond
2061 ((eq (car-safe a) 'float) (>= (nth 2 a) 0))
cce7e5a6 2062 ((eq (car-safe a) 'frac) (Math-integerp (math-normalize a)))))
136211a9
EZ
2063
2064;;; True if A is numerically an integer. [P x] [Public]
2065(defun math-num-integerp (a)
2066 (or (Math-integerp a)
cce7e5a6 2067 (Math-messy-integerp a)))
136211a9
EZ
2068
2069;;; True if A is (numerically) a non-negative integer. [P N] [Public]
2070(defun math-num-natnump (a)
2071 (or (natnump a)
2072 (eq (car-safe a) 'bigpos)
2073 (and (eq (car-safe a) 'float)
2074 (Math-natnump (nth 1 a))
cce7e5a6 2075 (>= (nth 2 a) 0))))
136211a9
EZ
2076
2077;;; True if A is an integer or will evaluate to an integer. [P x] [Public]
2078(defun math-provably-integerp (a)
2079 (or (Math-integerp a)
2080 (and (memq (car-safe a) '(calcFunc-trunc
2081 calcFunc-round
2082 calcFunc-rounde
2083 calcFunc-roundu
2084 calcFunc-floor
2085 calcFunc-ceil))
cce7e5a6 2086 (= (length a) 2))))
136211a9
EZ
2087
2088;;; True if A is a real or will evaluate to a real. [P x] [Public]
2089(defun math-provably-realp (a)
2090 (or (Math-realp a)
2091 (math-provably-integer a)
cce7e5a6 2092 (memq (car-safe a) '(abs arg))))
136211a9
EZ
2093
2094;;; True if A is a non-real, complex number. [P x] [Public]
2095(defun math-complexp (a)
cce7e5a6 2096 (memq (car-safe a) '(cplx polar)))
136211a9
EZ
2097
2098;;; True if A is a non-real, rectangular complex number. [P x] [Public]
2099(defun math-rect-complexp (a)
cce7e5a6 2100 (eq (car-safe a) 'cplx))
136211a9
EZ
2101
2102;;; True if A is a non-real, polar complex number. [P x] [Public]
2103(defun math-polar-complexp (a)
cce7e5a6 2104 (eq (car-safe a) 'polar))
136211a9
EZ
2105
2106;;; True if A is a matrix. [P x] [Public]
2107(defun math-matrixp (a)
2108 (and (Math-vectorp a)
2109 (Math-vectorp (nth 1 a))
2110 (cdr (nth 1 a))
2111 (let ((len (length (nth 1 a))))
2112 (setq a (cdr a))
2113 (while (and (setq a (cdr a))
2114 (Math-vectorp (car a))
2115 (= (length (car a)) len)))
cce7e5a6 2116 (null a))))
136211a9
EZ
2117
2118(defun math-matrixp-step (a len) ; [P L]
2119 (or (null a)
2120 (and (Math-vectorp (car a))
2121 (= (length (car a)) len)
cce7e5a6 2122 (math-matrixp-step (cdr a) len))))
136211a9
EZ
2123
2124;;; True if A is a square matrix. [P V] [Public]
2125(defun math-square-matrixp (a)
2126 (let ((dims (math-mat-dimens a)))
2127 (and (cdr dims)
cce7e5a6 2128 (= (car dims) (nth 1 dims)))))
136211a9 2129
cbd4e89b
JB
2130;;; True if MAT is an identity matrix.
2131(defun math-identity-matrix-p (mat &optional mul)
2132 (if (math-square-matrixp mat)
2133 (let ((a (if mul
2134 (nth 1 (nth 1 mat))
2135 1))
2136 (n (1- (length mat)))
2137 (i 1))
2138 (while (and (<= i n)
2139 (math-ident-row-p (nth i mat) i a))
2140 (setq i (1+ i)))
2141 (if (> i n)
2142 a
2143 nil))))
2144
2145(defun math-ident-row-p (row n &optional a)
2146 (unless a
2147 (setq a 1))
2148 (and
2149 (not (memq nil (mapcar
2150 (lambda (x) (eq x 0))
2151 (nthcdr (1+ n) row))))
2152 (not (memq nil (mapcar
2153 (lambda (x) (eq x 0))
2154 (butlast
2155 (cdr row)
2156 (- (length row) n)))))
2157 (eq (elt row n) a)))
2158
136211a9
EZ
2159;;; True if A is any scalar data object. [P x]
2160(defun math-objectp (a) ; [Public]
2161 (or (integerp a)
2162 (memq (car-safe a) '(bigpos bigneg frac float cplx
cce7e5a6 2163 polar hms date sdev intv mod))))
136211a9
EZ
2164
2165;;; Verify that A is an integer and return A in integer form. [I N; - x]
2166(defun math-check-integer (a) ; [Public]
2167 (cond ((integerp a) a) ; for speed
2168 ((math-integerp a) a)
2169 ((math-messy-integerp a)
2170 (math-trunc a))
cce7e5a6 2171 (t (math-reject-arg a 'integerp))))
136211a9
EZ
2172
2173;;; Verify that A is a small integer and return A in integer form. [S N; - x]
2174(defun math-check-fixnum (a &optional allow-inf) ; [Public]
2175 (cond ((integerp a) a) ; for speed
2176 ((Math-num-integerp a)
2177 (let ((a (math-trunc a)))
2178 (if (integerp a)
2179 a
2180 (if (or (Math-lessp (lsh -1 -1) a)
2181 (Math-lessp a (- (lsh -1 -1))))
2182 (math-reject-arg a 'fixnump)
2183 (math-fixnum a)))))
2184 ((and allow-inf (equal a '(var inf var-inf)))
2185 (lsh -1 -1))
2186 ((and allow-inf (equal a '(neg (var inf var-inf))))
2187 (- (lsh -1 -1)))
cce7e5a6 2188 (t (math-reject-arg a 'fixnump))))
136211a9
EZ
2189
2190;;; Verify that A is an integer >= 0 and return A in integer form. [I N; - x]
2191(defun math-check-natnum (a) ; [Public]
2192 (cond ((natnump a) a)
2193 ((and (not (math-negp a))
2194 (Math-num-integerp a))
2195 (math-trunc a))
cce7e5a6 2196 (t (math-reject-arg a 'natnump))))
136211a9
EZ
2197
2198;;; Verify that A is in floating-point form, or force it to be a float. [F N]
2199(defun math-check-float (a) ; [Public]
2200 (cond ((eq (car-safe a) 'float) a)
2201 ((Math-vectorp a) (math-map-vec 'math-check-float a))
2202 ((Math-objectp a) (math-float a))
cce7e5a6 2203 (t a)))
136211a9
EZ
2204
2205;;; Verify that A is a constant.
2206(defun math-check-const (a &optional exp-ok)
2207 (if (or (math-constp a)
2208 (and exp-ok math-expand-formulas))
2209 a
cce7e5a6 2210 (math-reject-arg a 'constp)))
136211a9
EZ
2211
2212
2213;;; Coerce integer A to be a small integer. [S I]
2214(defun math-fixnum (a)
2215 (if (consp a)
2216 (if (cdr a)
2217 (if (eq (car a) 'bigneg)
2218 (- (math-fixnum-big (cdr a)))
2219 (math-fixnum-big (cdr a)))
2220 0)
cce7e5a6 2221 a))
136211a9
EZ
2222
2223(defun math-fixnum-big (a)
2224 (if (cdr a)
b593f1de 2225 (+ (car a) (* (math-fixnum-big (cdr a)) math-bignum-digit-size))
cce7e5a6 2226 (car a)))
136211a9 2227
3132f345 2228(defvar math-simplify-only nil)
136211a9
EZ
2229
2230(defun math-normalize-fancy (a)
2231 (cond ((eq (car a) 'frac)
2232 (math-make-frac (math-normalize (nth 1 a))
2233 (math-normalize (nth 2 a))))
2234 ((eq (car a) 'cplx)
2235 (let ((real (math-normalize (nth 1 a)))
2236 (imag (math-normalize (nth 2 a))))
2237 (if (and (math-zerop imag)
2238 (not math-simplify-only)) ; oh, what a kludge!
2239 real
2240 (list 'cplx real imag))))
2241 ((eq (car a) 'polar)
2242 (math-normalize-polar a))
2243 ((eq (car a) 'hms)
2244 (math-normalize-hms a))
2245 ((eq (car a) 'date)
2246 (list 'date (math-normalize (nth 1 a))))
2247 ((eq (car a) 'mod)
2248 (math-normalize-mod a))
2249 ((eq (car a) 'sdev)
2250 (let ((x (math-normalize (nth 1 a)))
2251 (s (math-normalize (nth 2 a))))
2252 (if (or (and (Math-objectp x) (not (Math-scalarp x)))
2253 (and (Math-objectp s) (not (Math-scalarp s))))
2254 (list 'calcFunc-sdev x s)
2255 (math-make-sdev x s))))
2256 ((eq (car a) 'intv)
2257 (let ((mask (math-normalize (nth 1 a)))
2258 (lo (math-normalize (nth 2 a)))
2259 (hi (math-normalize (nth 3 a))))
2260 (if (if (eq (car-safe lo) 'date)
2261 (not (eq (car-safe hi) 'date))
2262 (or (and (Math-objectp lo) (not (Math-anglep lo)))
2263 (and (Math-objectp hi) (not (Math-anglep hi)))))
2264 (list 'calcFunc-intv mask lo hi)
2265 (math-make-intv mask lo hi))))
2266 ((eq (car a) 'vec)
2267 (cons 'vec (mapcar 'math-normalize (cdr a))))
2268 ((eq (car a) 'quote)
2269 (math-normalize (nth 1 a)))
2270 ((eq (car a) 'special-const)
2271 (calc-with-default-simplification
2272 (math-normalize (nth 1 a))))
2273 ((eq (car a) 'var)
2274 (cons 'var (cdr a))) ; need to re-cons for selection routines
2275 ((eq (car a) 'calcFunc-if)
2276 (math-normalize-logical-op a))
2277 ((memq (car a) '(calcFunc-lambda calcFunc-quote calcFunc-condition))
2278 (let ((calc-simplify-mode 'none))
2279 (cons (car a) (mapcar 'math-normalize (cdr a)))))
2280 ((eq (car a) 'calcFunc-evalto)
2281 (setq a (or (nth 1 a) 0))
2282 (or calc-refreshing-evaltos
2283 (setq a (let ((calc-simplify-mode 'none)) (math-normalize a))))
2284 (let ((b (if (and (eq (car-safe a) 'calcFunc-assign)
2285 (= (length a) 3))
2286 (nth 2 a)
2287 a)))
2288 (list 'calcFunc-evalto
2289 a
2290 (if (eq calc-simplify-mode 'none)
2291 (math-normalize b)
2292 (calc-with-default-simplification
2293 (math-evaluate-expr b))))))
2294 ((or (integerp (car a)) (consp (car a)))
2295 (if (null (cdr a))
2296 (math-normalize (car a))
cce7e5a6 2297 (error "Can't use multi-valued function in an expression")))))
136211a9 2298
90b44097
JB
2299;; The variable math-normalize-a is local to math-normalize in calc.el,
2300;; but is used by math-normalize-nonstandard, which is called by
2301;; math-normalize.
2302(defvar math-normalize-a)
2303
722401eb 2304(defun math-normalize-nonstandard ()
136211a9
EZ
2305 (if (consp calc-simplify-mode)
2306 (progn
2307 (setq calc-simplify-mode 'none
722401eb 2308 math-simplify-only (car-safe (cdr-safe math-normalize-a)))
136211a9 2309 nil)
722401eb 2310 (and (symbolp (car math-normalize-a))
136211a9
EZ
2311 (or (eq calc-simplify-mode 'none)
2312 (and (eq calc-simplify-mode 'num)
722401eb
JB
2313 (let ((aptr (setq math-normalize-a
2314 (cons
2315 (car math-normalize-a)
2316 (mapcar 'math-normalize
2317 (cdr math-normalize-a))))))
136211a9
EZ
2318 (while (and aptr (math-constp (car aptr)))
2319 (setq aptr (cdr aptr)))
2320 aptr)))
722401eb
JB
2321 (cons (car math-normalize-a)
2322 (mapcar 'math-normalize (cdr math-normalize-a))))))
136211a9
EZ
2323
2324
2325;;; Normalize a bignum digit list by trimming high-end zeros. [L l]
2326(defun math-norm-bignum (a)
2327 (let ((digs a) (last nil))
2328 (while digs
2329 (or (eq (car digs) 0) (setq last digs))
2330 (setq digs (cdr digs)))
2331 (and last
2332 (progn
2333 (setcdr last nil)
cce7e5a6 2334 a))))
136211a9
EZ
2335
2336(defun math-bignum-test (a) ; [B N; B s; b b]
2337 (if (consp a)
2338 a
cce7e5a6 2339 (math-bignum a)))
136211a9
EZ
2340
2341
2342;;; Return 0 for zero, -1 for negative, 1 for positive. [S n] [Public]
2343(defun calcFunc-sign (a &optional x)
2344 (let ((signs (math-possible-signs a)))
2345 (cond ((eq signs 4) (or x 1))
2346 ((eq signs 2) 0)
2347 ((eq signs 1) (if x (math-neg x) -1))
2348 ((math-looks-negp a) (math-neg (calcFunc-sign (math-neg a))))
2349 (t (calc-record-why 'realp a)
2350 (if x
2351 (list 'calcFunc-sign a x)
cce7e5a6 2352 (list 'calcFunc-sign a))))))
136211a9
EZ
2353
2354;;; Return 0 if A is numerically equal to B, <0 if less, >0 if more.
2355;;; Arguments must be normalized! [S N N]
2356(defun math-compare (a b)
2357 (cond ((equal a b)
2358 (if (and (consp a)
2359 (memq (car a) '(var neg * /))
2360 (math-infinitep a))
2361 2
2362 0))
2363 ((and (integerp a) (Math-integerp b))
2364 (if (consp b)
2365 (if (eq (car b) 'bigpos) -1 1)
2366 (if (< a b) -1 1)))
2367 ((and (eq (car-safe a) 'bigpos) (Math-integerp b))
2368 (if (eq (car-safe b) 'bigpos)
2369 (math-compare-bignum (cdr a) (cdr b))
2370 1))
2371 ((and (eq (car-safe a) 'bigneg) (Math-integerp b))
2372 (if (eq (car-safe b) 'bigneg)
2373 (math-compare-bignum (cdr b) (cdr a))
2374 -1))
2375 ((eq (car-safe a) 'frac)
2376 (if (eq (car-safe b) 'frac)
2377 (math-compare (math-mul (nth 1 a) (nth 2 b))
2378 (math-mul (nth 1 b) (nth 2 a)))
2379 (math-compare (nth 1 a) (math-mul b (nth 2 a)))))
2380 ((eq (car-safe b) 'frac)
2381 (math-compare (math-mul a (nth 2 b)) (nth 1 b)))
2382 ((and (eq (car-safe a) 'float) (eq (car-safe b) 'float))
2383 (if (math-lessp-float a b) -1 1))
2384 ((and (eq (car-safe a) 'date) (eq (car-safe b) 'date))
2385 (math-compare (nth 1 a) (nth 1 b)))
2386 ((and (or (Math-anglep a)
2387 (and (eq (car a) 'cplx) (eq (nth 2 a) 0)))
2388 (or (Math-anglep b)
2389 (and (eq (car b) 'cplx) (eq (nth 2 b) 0))))
2390 (calcFunc-sign (math-add a (math-neg b))))
2391 ((and (eq (car-safe a) 'intv)
2392 (or (Math-anglep b) (eq (car-safe b) 'date)))
2393 (let ((res (math-compare (nth 2 a) b)))
2394 (cond ((eq res 1) 1)
2395 ((and (eq res 0) (memq (nth 1 a) '(0 1))) 1)
2396 ((eq (setq res (math-compare (nth 3 a) b)) -1) -1)
2397 ((and (eq res 0) (memq (nth 1 a) '(0 2))) -1)
2398 (t 2))))
2399 ((and (eq (car-safe b) 'intv)
2400 (or (Math-anglep a) (eq (car-safe a) 'date)))
2401 (let ((res (math-compare a (nth 2 b))))
2402 (cond ((eq res -1) -1)
2403 ((and (eq res 0) (memq (nth 1 b) '(0 1))) -1)
2404 ((eq (setq res (math-compare a (nth 3 b))) 1) 1)
2405 ((and (eq res 0) (memq (nth 1 b) '(0 2))) 1)
2406 (t 2))))
2407 ((and (eq (car-safe a) 'intv) (eq (car-safe b) 'intv))
2408 (let ((res (math-compare (nth 3 a) (nth 2 b))))
2409 (cond ((eq res -1) -1)
2410 ((and (eq res 0) (or (memq (nth 1 a) '(0 2))
2411 (memq (nth 1 b) '(0 1)))) -1)
2412 ((eq (setq res (math-compare (nth 2 a) (nth 3 b))) 1) 1)
2413 ((and (eq res 0) (or (memq (nth 1 a) '(0 1))
2414 (memq (nth 1 b) '(0 2)))) 1)
2415 (t 2))))
2416 ((math-infinitep a)
2417 (if (or (equal a '(var uinf var-uinf))
2418 (equal a '(var nan var-nan)))
2419 2
2420 (let ((dira (math-infinite-dir a)))
2421 (if (math-infinitep b)
2422 (if (or (equal b '(var uinf var-uinf))
2423 (equal b '(var nan var-nan)))
2424 2
2425 (let ((dirb (math-infinite-dir b)))
2426 (cond ((and (eq dira 1) (eq dirb -1)) 1)
2427 ((and (eq dira -1) (eq dirb 1)) -1)
2428 (t 2))))
2429 (cond ((eq dira 1) 1)
2430 ((eq dira -1) -1)
2431 (t 2))))))
2432 ((math-infinitep b)
2433 (if (or (equal b '(var uinf var-uinf))
2434 (equal b '(var nan var-nan)))
2435 2
2436 (let ((dirb (math-infinite-dir b)))
2437 (cond ((eq dirb 1) -1)
2438 ((eq dirb -1) 1)
2439 (t 2)))))
2440 ((and (eq (car-safe a) 'calcFunc-exp)
2441 (eq (car-safe b) '^)
2442 (equal (nth 1 b) '(var e var-e)))
2443 (math-compare (nth 1 a) (nth 2 b)))
2444 ((and (eq (car-safe b) 'calcFunc-exp)
2445 (eq (car-safe a) '^)
2446 (equal (nth 1 a) '(var e var-e)))
2447 (math-compare (nth 2 a) (nth 1 b)))
2448 ((or (and (eq (car-safe a) 'calcFunc-sqrt)
2449 (eq (car-safe b) '^)
2450 (or (equal (nth 2 b) '(frac 1 2))
2451 (equal (nth 2 b) '(float 5 -1))))
2452 (and (eq (car-safe b) 'calcFunc-sqrt)
2453 (eq (car-safe a) '^)
2454 (or (equal (nth 2 a) '(frac 1 2))
2455 (equal (nth 2 a) '(float 5 -1)))))
2456 (math-compare (nth 1 a) (nth 1 b)))
2457 ((eq (car-safe a) 'var)
2458 2)
2459 (t
2460 (if (and (consp a) (consp b)
2461 (eq (car a) (car b))
2462 (math-compare-lists (cdr a) (cdr b)))
2463 0
cce7e5a6 2464 2))))
136211a9
EZ
2465
2466;;; Compare two bignum digit lists, return -1 for A<B, 0 for A=B, 1 for A>B.
2467(defun math-compare-bignum (a b) ; [S l l]
2468 (let ((res 0))
2469 (while (and a b)
2470 (if (< (car a) (car b))
2471 (setq res -1)
2472 (if (> (car a) (car b))
2473 (setq res 1)))
2474 (setq a (cdr a)
2475 b (cdr b)))
2476 (if a
2477 (progn
2478 (while (eq (car a) 0) (setq a (cdr a)))
2479 (if a 1 res))
2480 (while (eq (car b) 0) (setq b (cdr b)))
cce7e5a6 2481 (if b -1 res))))
136211a9
EZ
2482
2483(defun math-compare-lists (a b)
2484 (cond ((null a) (null b))
2485 ((null b) nil)
2486 (t (and (Math-equal (car a) (car b))
cce7e5a6 2487 (math-compare-lists (cdr a) (cdr b))))))
136211a9
EZ
2488
2489(defun math-lessp-float (a b) ; [P F F]
2490 (let ((ediff (- (nth 2 a) (nth 2 b))))
2491 (if (>= ediff 0)
2492 (if (>= ediff (+ calc-internal-prec calc-internal-prec))
2493 (if (eq (nth 1 a) 0)
2494 (Math-integer-posp (nth 1 b))
2495 (Math-integer-negp (nth 1 a)))
2496 (Math-lessp (math-scale-int (nth 1 a) ediff)
2497 (nth 1 b)))
2498 (if (>= (setq ediff (- ediff))
2499 (+ calc-internal-prec calc-internal-prec))
2500 (if (eq (nth 1 b) 0)
2501 (Math-integer-negp (nth 1 a))
2502 (Math-integer-posp (nth 1 b)))
2503 (Math-lessp (nth 1 a)
cce7e5a6 2504 (math-scale-int (nth 1 b) ediff))))))
136211a9
EZ
2505
2506;;; True if A is numerically equal to B. [P N N] [Public]
2507(defun math-equal (a b)
cce7e5a6 2508 (= (math-compare a b) 0))
136211a9
EZ
2509
2510;;; True if A is numerically less than B. [P R R] [Public]
2511(defun math-lessp (a b)
cce7e5a6 2512 (= (math-compare a b) -1))
136211a9
EZ
2513
2514;;; True if A is numerically equal to the integer B. [P N S] [Public]
2515;;; B must not be a multiple of 10.
2516(defun math-equal-int (a b)
2517 (or (eq a b)
2518 (and (eq (car-safe a) 'float)
2519 (eq (nth 1 a) b)
cce7e5a6 2520 (= (nth 2 a) 0))))
136211a9
EZ
2521
2522
2523
2524
2525;;; Return the dimensions of a matrix as a list. [l x] [Public]
2526(defun math-mat-dimens (m)
2527 (if (math-vectorp m)
2528 (if (math-matrixp m)
2529 (cons (1- (length m))
2530 (math-mat-dimens (nth 1 m)))
2531 (list (1- (length m))))
cce7e5a6 2532 nil))
136211a9
EZ
2533
2534
2535
2536(defun calc-binary-op-fancy (name func arg ident unary)
2537 (let ((n (prefix-numeric-value arg)))
2538 (cond ((> n 1)
2539 (calc-enter-result n
2540 name
2541 (list 'calcFunc-reduce
2542 (math-calcFunc-to-var func)
2543 (cons 'vec (calc-top-list-n n)))))
2544 ((= n 1)
2545 (if unary
2546 (calc-enter-result 1 name (list unary (calc-top-n 1)))))
2547 ((= n 0)
2548 (if ident
2549 (calc-enter-result 0 name ident)
2550 (error "Argument must be nonzero")))
2551 (t
2552 (let ((rhs (calc-top-n 1)))
2553 (calc-enter-result (- 1 n)
2554 name
2555 (mapcar (function
2556 (lambda (x)
2557 (list func x rhs)))
cce7e5a6 2558 (calc-top-list-n (- n) 2))))))))
136211a9
EZ
2559
2560(defun calc-unary-op-fancy (name func arg)
2561 (let ((n (prefix-numeric-value arg)))
2562 (if (= n 0) (setq n (calc-stack-size)))
2563 (cond ((> n 0)
2564 (calc-enter-result n
2565 name
2566 (mapcar (function
2567 (lambda (x)
2568 (list func x)))
2569 (calc-top-list-n n))))
2570 ((< n 0)
2571 (calc-enter-result 1
2572 name
2573 (list func (calc-top-n (- n)))
cce7e5a6 2574 (- n))))))
136211a9 2575
136211a9 2576(defvar var-Holidays '(vec (var sat var-sat) (var sun var-sun)))
136211a9
EZ
2577(defvar var-Decls (list 'vec))
2578
2579
136211a9
EZ
2580(defun math-inexact-result ()
2581 (and calc-symbolic-mode
cce7e5a6 2582 (signal 'inexact-result nil)))
136211a9
EZ
2583
2584(defun math-overflow (&optional exp)
2585 (if (and exp (math-negp exp))
2586 (math-underflow)
cce7e5a6 2587 (signal 'math-overflow nil)))
136211a9
EZ
2588
2589(defun math-underflow ()
cce7e5a6 2590 (signal 'math-underflow nil))
136211a9 2591
136211a9
EZ
2592;;; Compute the greatest common divisor of A and B. [I I I] [Public]
2593(defun math-gcd (a b)
2594 (cond ((not (or (consp a) (consp b)))
2595 (if (< a 0) (setq a (- a)))
2596 (if (< b 0) (setq b (- b)))
2597 (let (c)
2598 (if (< a b)
2599 (setq c b b a a c))
2600 (while (> b 0)
2601 (setq c b
2602 b (% a b)
2603 a c))
2604 a))
2605 ((eq a 0) b)
2606 ((eq b 0) a)
2607 (t
2608 (if (Math-integer-negp a) (setq a (math-neg a)))
2609 (if (Math-integer-negp b) (setq b (math-neg b)))
2610 (let (c)
2611 (if (Math-natnum-lessp a b)
2612 (setq c b b a a c))
2613 (while (and (consp a) (not (eq b 0)))
2614 (setq c b
2615 b (math-imod a b)
2616 a c))
2617 (while (> b 0)
2618 (setq c b
2619 b (% a b)
2620 a c))
cce7e5a6 2621 a))))
136211a9
EZ
2622
2623
2624;;;; Algebra.
2625
2626;;; Evaluate variables in an expression.
2627(defun math-evaluate-expr (x) ; [Public]
2628 (if calc-embedded-info
2629 (calc-embedded-evaluate-expr x)
cce7e5a6
CW
2630 (calc-normalize (math-evaluate-expr-rec x))))
2631
2632(defalias 'calcFunc-evalv 'math-evaluate-expr)
136211a9
EZ
2633
2634(defun calcFunc-evalvn (x &optional prec)
2635 (if prec
2636 (progn
2637 (or (math-num-integerp prec)
2638 (if (and (math-vectorp prec)
2639 (= (length prec) 2)
2640 (math-num-integerp (nth 1 prec)))
2641 (setq prec (math-add (nth 1 prec) calc-internal-prec))
2642 (math-reject-arg prec 'integerp)))
2643 (setq prec (math-trunc prec))
2644 (if (< prec 3) (setq prec 3))
2645 (if (> prec calc-internal-prec)
2646 (math-normalize
2647 (let ((calc-internal-prec prec))
2648 (calcFunc-evalvn x)))
2649 (let ((calc-internal-prec prec))
2650 (calcFunc-evalvn x))))
2651 (let ((calc-symbolic-mode nil))
cce7e5a6 2652 (math-evaluate-expr x))))
136211a9
EZ
2653
2654(defun math-evaluate-expr-rec (x)
2655 (if (consp x)
2656 (if (memq (car x) '(calcFunc-quote calcFunc-condition
2657 calcFunc-evalto calcFunc-assign))
2658 (if (and (eq (car x) 'calcFunc-assign)
2659 (= (length x) 3))
2660 (list (car x) (nth 1 x) (math-evaluate-expr-rec (nth 2 x)))
2661 x)
2662 (if (eq (car x) 'var)
2663 (if (and (calc-var-value (nth 2 x))
2664 (not (eq (car-safe (symbol-value (nth 2 x)))
2665 'incomplete)))
2666 (let ((val (symbol-value (nth 2 x))))
2667 (if (eq (car-safe val) 'special-const)
2668 (if calc-symbolic-mode
2669 x
2670 val)
2671 val))
2672 x)
2673 (if (Math-primp x)
2674 x
2675 (cons (car x) (mapcar 'math-evaluate-expr-rec (cdr x))))))
cce7e5a6 2676 x))
136211a9 2677
136211a9
EZ
2678(defun math-any-floats (expr)
2679 (if (Math-primp expr)
2680 (math-floatp expr)
2681 (while (and (setq expr (cdr expr)) (not (math-any-floats (car expr)))))
cce7e5a6 2682 expr))
136211a9
EZ
2683
2684(defvar var-FactorRules 'calc-FactorRules)
2685
722401eb
JB
2686(defvar math-mt-many nil)
2687(defvar math-mt-func nil)
2688
2689(defun math-map-tree (math-mt-func mmt-expr &optional math-mt-many)
2690 (or math-mt-many (setq math-mt-many 1000000))
cce7e5a6 2691 (math-map-tree-rec mmt-expr))
136211a9
EZ
2692
2693(defun math-map-tree-rec (mmt-expr)
722401eb 2694 (or (= math-mt-many 0)
136211a9
EZ
2695 (let ((mmt-done nil)
2696 mmt-nextval)
2697 (while (not mmt-done)
722401eb
JB
2698 (while (and (/= math-mt-many 0)
2699 (setq mmt-nextval (funcall math-mt-func mmt-expr))
136211a9
EZ
2700 (not (equal mmt-expr mmt-nextval)))
2701 (setq mmt-expr mmt-nextval
722401eb
JB
2702 math-mt-many (if (> math-mt-many 0)
2703 (1- math-mt-many)
2704 (1+ math-mt-many))))
136211a9 2705 (if (or (Math-primp mmt-expr)
722401eb 2706 (<= math-mt-many 0))
136211a9
EZ
2707 (setq mmt-done t)
2708 (setq mmt-nextval (cons (car mmt-expr)
2709 (mapcar 'math-map-tree-rec
2710 (cdr mmt-expr))))
2711 (if (equal mmt-nextval mmt-expr)
2712 (setq mmt-done t)
2713 (setq mmt-expr mmt-nextval))))))
cce7e5a6 2714 mmt-expr)
136211a9 2715
136211a9
EZ
2716(defun math-is-true (expr)
2717 (if (Math-numberp expr)
2718 (not (Math-zerop expr))
cce7e5a6 2719 (math-known-nonzerop expr)))
136211a9
EZ
2720
2721(defun math-const-var (expr)
2722 (and (consp expr)
2723 (eq (car expr) 'var)
2724 (or (and (symbolp (nth 2 expr))
2725 (boundp (nth 2 expr))
2726 (eq (car-safe (symbol-value (nth 2 expr))) 'special-const))
cce7e5a6 2727 (memq (nth 2 expr) '(var-inf var-uinf var-nan)))))
136211a9 2728
90b44097
JB
2729;; The variable math-integral-cache is originally declared in calcalg2.el,
2730;; but is set by math-defintegral and math-definitegral2.
2731(defvar math-integral-cache)
2732
136211a9
EZ
2733(defmacro math-defintegral (funcs &rest code)
2734 (setq math-integral-cache nil)
2735 (append '(progn)
2736 (mapcar (function
2737 (lambda (func)
2738 (list 'put (list 'quote func) ''math-integral
2739 (list 'nconc
2740 (list 'get (list 'quote func) ''math-integral)
2741 (list 'list
2742 (list 'function
2743 (append '(lambda (u))
2744 code)))))))
cce7e5a6 2745 (if (symbolp funcs) (list funcs) funcs))))
136211a9
EZ
2746(put 'math-defintegral 'lisp-indent-hook 1)
2747
2748(defmacro math-defintegral-2 (funcs &rest code)
2749 (setq math-integral-cache nil)
2750 (append '(progn)
2751 (mapcar (function
2752 (lambda (func)
2753 (list 'put (list 'quote func) ''math-integral-2
2754 (list 'nconc
2755 (list 'get (list 'quote func)
2756 ''math-integral-2)
2757 (list 'list
2758 (list 'function
2759 (append '(lambda (u v))
2760 code)))))))
cce7e5a6 2761 (if (symbolp funcs) (list funcs) funcs))))
136211a9
EZ
2762(put 'math-defintegral-2 'lisp-indent-hook 1)
2763
136211a9
EZ
2764(defvar var-IntegAfterRules 'calc-IntegAfterRules)
2765
136211a9
EZ
2766(defvar var-FitRules 'calc-FitRules)
2767
3132f345
CW
2768(defvar math-poly-base-variable nil)
2769(defvar math-poly-neg-powers nil)
2770(defvar math-poly-mult-powers 1)
2771(defvar math-poly-frac-powers nil)
2772(defvar math-poly-exp-base nil)
136211a9 2773
136211a9
EZ
2774(defun math-build-var-name (name)
2775 (if (stringp name)
2776 (setq name (intern name)))
2777 (if (string-match "\\`var-." (symbol-name name))
2778 (list 'var (intern (substring (symbol-name name) 4)) name)
cce7e5a6 2779 (list 'var name (intern (concat "var-" (symbol-name name))))))
136211a9 2780
3132f345
CW
2781(defvar math-simplifying-units nil)
2782(defvar math-combining-units t)
136211a9
EZ
2783
2784;;; Nontrivial number parsing.
2785
2786(defun math-read-number-fancy (s)
2787 (cond
2788
2789 ;; Integer+fractions
2790 ((string-match "^\\([0-9]*\\)[:/]\\([0-9]*\\)[:/]\\([0-9]*\\)$" s)
2791 (let ((int (math-match-substring s 1))
2792 (num (math-match-substring s 2))
2793 (den (math-match-substring s 3)))
2794 (let ((int (if (> (length int) 0) (math-read-number int) 0))
2795 (num (if (> (length num) 0) (math-read-number num) 1))
2796 (den (if (> (length num) 0) (math-read-number den) 1)))
2797 (and int num den
2798 (math-integerp int) (math-integerp num) (math-integerp den)
2799 (not (math-zerop den))
2800 (list 'frac (math-add num (math-mul int den)) den)))))
a1506d29 2801
136211a9
EZ
2802 ;; Fractions
2803 ((string-match "^\\([0-9]*\\)[:/]\\([0-9]*\\)$" s)
2804 (let ((num (math-match-substring s 1))
2805 (den (math-match-substring s 2)))
2806 (let ((num (if (> (length num) 0) (math-read-number num) 1))
2807 (den (if (> (length num) 0) (math-read-number den) 1)))
2808 (and num den (math-integerp num) (math-integerp den)
2809 (not (math-zerop den))
2810 (list 'frac num den)))))
a1506d29 2811
136211a9
EZ
2812 ;; Modulo forms
2813 ((string-match "^\\(.*\\) *mod *\\(.*\\)$" s)
2814 (let* ((n (math-match-substring s 1))
2815 (m (math-match-substring s 2))
2816 (n (math-read-number n))
2817 (m (math-read-number m)))
2818 (and n m (math-anglep n) (math-anglep m)
2819 (list 'mod n m))))
2820
2821 ;; Error forms
2822 ((string-match "^\\(.*\\) *\\+/- *\\(.*\\)$" s)
2823 (let* ((x (math-match-substring s 1))
2824 (sigma (math-match-substring s 2))
2825 (x (math-read-number x))
2826 (sigma (math-read-number sigma)))
2827 (and x sigma (math-scalarp x) (math-anglep sigma)
2828 (list 'sdev x sigma))))
2829
2830 ;; Hours (or degrees)
2831 ((or (string-match "^\\([^#^]+\\)[@oOhH]\\(.*\\)$" s)
2832 (string-match "^\\([^#^]+\\)[dD][eE]?[gG]?\\(.*\\)$" s))
2833 (let* ((hours (math-match-substring s 1))
2834 (minsec (math-match-substring s 2))
2835 (hours (math-read-number hours))
2836 (minsec (if (> (length minsec) 0) (math-read-number minsec) 0)))
2837 (and hours minsec
2838 (math-num-integerp hours)
2839 (not (math-negp hours)) (not (math-negp minsec))
2840 (cond ((math-num-integerp minsec)
2841 (and (Math-lessp minsec 60)
2842 (list 'hms hours minsec 0)))
2843 ((and (eq (car-safe minsec) 'hms)
2844 (math-zerop (nth 1 minsec)))
2845 (math-add (list 'hms hours 0 0) minsec))
2846 (t nil)))))
a1506d29 2847
136211a9
EZ
2848 ;; Minutes
2849 ((string-match "^\\([^'#^]+\\)[mM']\\(.*\\)$" s)
2850 (let* ((minutes (math-match-substring s 1))
2851 (seconds (math-match-substring s 2))
2852 (minutes (math-read-number minutes))
2853 (seconds (if (> (length seconds) 0) (math-read-number seconds) 0)))
2854 (and minutes seconds
2855 (math-num-integerp minutes)
2856 (not (math-negp minutes)) (not (math-negp seconds))
2857 (cond ((math-realp seconds)
2858 (and (Math-lessp minutes 60)
2859 (list 'hms 0 minutes seconds)))
2860 ((and (eq (car-safe seconds) 'hms)
2861 (math-zerop (nth 1 seconds))
2862 (math-zerop (nth 2 seconds)))
2863 (math-add (list 'hms 0 minutes 0) seconds))
2864 (t nil)))))
a1506d29 2865
136211a9
EZ
2866 ;; Seconds
2867 ((string-match "^\\([^\"#^]+\\)[sS\"]$" s)
2868 (let ((seconds (math-read-number (math-match-substring s 1))))
2869 (and seconds (math-realp seconds)
2870 (not (math-negp seconds))
2871 (Math-lessp seconds 60)
2872 (list 'hms 0 0 seconds))))
a1506d29 2873
136211a9
EZ
2874 ;; Integer+fraction with explicit radix
2875 ((string-match "^\\([0-9]+\\)\\(#\\|\\^\\^\\)\\([0-9a-zA-Z]*\\)[:/]\\([0-9a-zA-Z]*\\)[:/]\\([0-9a-zA-Z]\\)$" s)
8f4a8efc 2876 (let ((radix (string-to-number (math-match-substring s 1)))
136211a9
EZ
2877 (int (math-match-substring s 3))
2878 (num (math-match-substring s 4))
2879 (den (math-match-substring s 5)))
2880 (let ((int (if (> (length int) 0) (math-read-radix int radix) 0))
2881 (num (if (> (length num) 0) (math-read-radix num radix) 1))
2882 (den (if (> (length den) 0) (math-read-radix den radix) 1)))
2883 (and int num den (not (math-zerop den))
2884 (list 'frac
2885 (math-add num (math-mul int den))
2886 den)))))
a1506d29 2887
136211a9
EZ
2888 ;; Fraction with explicit radix
2889 ((string-match "^\\([0-9]+\\)\\(#\\|\\^\\^\\)\\([0-9a-zA-Z]*\\)[:/]\\([0-9a-zA-Z]*\\)$" s)
8f4a8efc 2890 (let ((radix (string-to-number (math-match-substring s 1)))
136211a9
EZ
2891 (num (math-match-substring s 3))
2892 (den (math-match-substring s 4)))
2893 (let ((num (if (> (length num) 0) (math-read-radix num radix) 1))
2894 (den (if (> (length den) 0) (math-read-radix den radix) 1)))
2895 (and num den (not (math-zerop den)) (list 'frac num den)))))
a1506d29 2896
136211a9
EZ
2897 ;; Float with explicit radix and exponent
2898 ((or (string-match "^0*\\(\\([2-9]\\|1[0-4]\\)\\(#\\|\\^\\^\\)[0-9a-dA-D.]+\\)[eE]\\([-+]?[0-9]+\\)$" s)
2899 (string-match "^\\(\\([0-9]+\\)\\(#\\|\\^\\^\\)[0-9a-zA-Z.]+\\) *\\* *\\2\\.? *\\^ *\\([-+]?[0-9]+\\)$" s))
8f4a8efc 2900 (let ((radix (string-to-number (math-match-substring s 2)))
136211a9
EZ
2901 (mant (math-match-substring s 1))
2902 (exp (math-match-substring s 4)))
2903 (let ((mant (math-read-number mant))
2904 (exp (math-read-number exp)))
2905 (and mant exp
2906 (math-mul mant (math-pow (math-float radix) exp))))))
2907
2908 ;; Float with explicit radix, no exponent
2909 ((string-match "^\\([0-9]+\\)\\(#\\|\\^\\^\\)\\([0-9a-zA-Z]*\\)\\.\\([0-9a-zA-Z]*\\)$" s)
8f4a8efc 2910 (let ((radix (string-to-number (math-match-substring s 1)))
136211a9
EZ
2911 (int (math-match-substring s 3))
2912 (fracs (math-match-substring s 4)))
2913 (let ((int (if (> (length int) 0) (math-read-radix int radix) 0))
2914 (frac (if (> (length fracs) 0) (math-read-radix fracs radix) 0))
2915 (calc-prefer-frac nil))
2916 (and int frac
2917 (math-add int (math-div frac (math-pow radix (length fracs))))))))
2918
2919 ;; Integer with explicit radix
2920 ((string-match "^\\([0-9]+\\)\\(#\\|\\^\\^\\)\\([0-9a-zA-Z]+\\)$" s)
2921 (math-read-radix (math-match-substring s 3)
8f4a8efc 2922 (string-to-number (math-match-substring s 1))))
136211a9
EZ
2923
2924 ;; C language hexadecimal notation
2925 ((and (eq calc-language 'c)
2926 (string-match "^0[xX]\\([0-9a-fA-F]+\\)$" s))
2927 (let ((digs (math-match-substring s 1)))
2928 (math-read-radix digs 16)))
2929
2930 ;; Pascal language hexadecimal notation
2931 ((and (eq calc-language 'pascal)
2932 (string-match "^\\$\\([0-9a-fA-F]+\\)$" s))
2933 (let ((digs (math-match-substring s 1)))
2934 (math-read-radix digs 16)))
2935
2936 ;; Fraction using "/" instead of ":"
2937 ((string-match "^\\([0-9]+\\)/\\([0-9/]+\\)$" s)
2938 (math-read-number (concat (math-match-substring s 1) ":"
2939 (math-match-substring s 2))))
2940
2941 ;; Syntax error!
cce7e5a6 2942 (t nil)))
136211a9
EZ
2943
2944(defun math-read-radix (s r) ; [I X D]
2945 (setq s (upcase s))
2946 (let ((i 0)
2947 (res 0)
2948 dig)
2949 (while (and (< i (length s))
2950 (setq dig (math-read-radix-digit (elt s i)))
2951 (< dig r))
2952 (setq res (math-add (math-mul res r) dig)
2953 i (1+ i)))
2954 (and (= i (length s))
cce7e5a6 2955 res)))
136211a9
EZ
2956
2957
2958
2959;;; Expression parsing.
2960
722401eb
JB
2961(defvar math-expr-data)
2962
e59b8655
JB
2963(defun math-read-expr (math-exp-str)
2964 (let ((math-exp-pos 0)
2965 (math-exp-old-pos 0)
2966 (math-exp-keep-spaces nil)
2967 math-exp-token math-expr-data)
66c2cf66 2968 (setq math-exp-str (math-read-preprocess-string math-exp-str))
e59b8655
JB
2969 (while (setq math-exp-token (string-match "\\.\\.\\([^.]\\|.[^.]\\)" math-exp-str))
2970 (setq math-exp-str (concat (substring math-exp-str 0 math-exp-token) "\\dots"
2971 (substring math-exp-str (+ math-exp-token 2)))))
136211a9
EZ
2972 (math-build-parse-table)
2973 (math-read-token)
2974 (let ((val (catch 'syntax (math-read-expr-level 0))))
2975 (if (stringp val)
e59b8655
JB
2976 (list 'error math-exp-old-pos val)
2977 (if (equal math-exp-token 'end)
136211a9 2978 val
e59b8655 2979 (list 'error math-exp-old-pos "Syntax error"))))))
136211a9
EZ
2980
2981(defun math-read-plain-expr (exp-str &optional error-check)
2982 (let* ((calc-language nil)
1dccbfee 2983 (math-expr-opers (math-standard-ops))
136211a9
EZ
2984 (val (math-read-expr exp-str)))
2985 (and error-check
2986 (eq (car-safe val) 'error)
2987 (error "%s: %s" (nth 2 val) exp-str))
cce7e5a6 2988 val))
136211a9
EZ
2989
2990
2991(defun math-read-string ()
722401eb
JB
2992 (let ((str (read-from-string (concat math-expr-data "\""))))
2993 (or (and (= (cdr str) (1+ (length math-expr-data)))
136211a9
EZ
2994 (stringp (car str)))
2995 (throw 'syntax "Error in string constant"))
2996 (math-read-token)
cce7e5a6 2997 (append '(vec) (car str) nil)))
136211a9
EZ
2998
2999
3000
3001;;; They said it couldn't be done...
3002
3003(defun math-read-big-expr (str)
3004 (and (> (length calc-left-label) 0)
3005 (string-match (concat "^" (regexp-quote calc-left-label)) str)
3006 (setq str (concat (substring str 0 (match-beginning 0))
3007 (substring str (match-end 0)))))
3008 (and (> (length calc-right-label) 0)
3009 (string-match (concat (regexp-quote calc-right-label) " *$") str)
3010 (setq str (concat (substring str 0 (match-beginning 0))
3011 (substring str (match-end 0)))))
3012 (if (string-match "\\\\[^ \n|]" str)
86e3afd3 3013 (if (eq calc-language 'latex)
136211a9 3014 (math-read-expr str)
86e3afd3 3015 (let ((calc-language 'latex)
136211a9 3016 (calc-language-option nil)
86e3afd3
JB
3017 (math-expr-opers (get 'latex 'math-oper-table))
3018 (math-expr-function-mapping (get 'latex 'math-function-table))
3019 (math-expr-variable-mapping (get 'latex 'math-variable-table)))
136211a9 3020 (math-read-expr str)))
c308c463 3021 (let ((math-read-big-lines nil)
136211a9
EZ
3022 (pos 0)
3023 (width 0)
c308c463
JB
3024 (math-read-big-err-msg nil)
3025 math-read-big-baseline math-read-big-h2
136211a9
EZ
3026 new-pos p)
3027 (while (setq new-pos (string-match "\n" str pos))
c308c463
JB
3028 (setq math-read-big-lines
3029 (cons (substring str pos new-pos) math-read-big-lines)
136211a9 3030 pos (1+ new-pos)))
c308c463
JB
3031 (setq math-read-big-lines
3032 (nreverse (cons (substring str pos) math-read-big-lines))
3033 p math-read-big-lines)
136211a9
EZ
3034 (while p
3035 (setq width (max width (length (car p)))
3036 p (cdr p)))
c308c463 3037 (if (math-read-big-bigp math-read-big-lines)
136211a9 3038 (or (catch 'syntax
c308c463
JB
3039 (math-read-big-rec 0 0 width (length math-read-big-lines)))
3040 math-read-big-err-msg
136211a9 3041 '(error 0 "Syntax error"))
cce7e5a6 3042 (math-read-expr str)))))
136211a9 3043
c308c463
JB
3044(defun math-read-big-bigp (math-read-big-lines)
3045 (and (cdr math-read-big-lines)
136211a9
EZ
3046 (let ((matrix nil)
3047 (v 0)
c308c463
JB
3048 (height (if (> (length (car math-read-big-lines)) 0) 1 0)))
3049 (while (and (cdr math-read-big-lines)
136211a9
EZ
3050 (let* ((i 0)
3051 j
c308c463
JB
3052 (l1 (car math-read-big-lines))
3053 (l2 (nth 1 math-read-big-lines))
136211a9
EZ
3054 (len (min (length l1) (length l2))))
3055 (if (> (length l2) 0)
3056 (setq height (1+ height)))
3057 (while (and (< i len)
3058 (or (memq (aref l1 i) '(?\ ?\- ?\_))
3059 (memq (aref l2 i) '(?\ ?\-))
3060 (and (memq (aref l1 i) '(?\| ?\,))
3061 (= (aref l2 i) (aref l1 i)))
3062 (and (eq (aref l1 i) ?\[)
3063 (eq (aref l2 i) ?\[)
c308c463 3064 (let ((math-rb-h2 (length l1)))
136211a9
EZ
3065 (setq j (math-read-big-balance
3066 (1+ i) v "[")))
3067 (setq i (1- j)))))
3068 (setq i (1+ i)))
3069 (or (= i len)
3070 (and (eq (aref l1 i) ?\[)
3071 (eq (aref l2 i) ?\[)
3072 (setq matrix t)
3073 nil))))
c308c463 3074 (setq math-read-big-lines (cdr math-read-big-lines)
136211a9
EZ
3075 v (1+ v)))
3076 (or (and (> height 1)
c308c463 3077 (not (cdr math-read-big-lines)))
cce7e5a6 3078 matrix))))
136211a9 3079
136211a9
EZ
3080;;; Nontrivial "flat" formatting.
3081
3132f345
CW
3082(defvar math-format-hash-args nil)
3083(defvar calc-can-abbrev-vectors nil)
3084
136211a9
EZ
3085(defun math-format-flat-expr-fancy (a prec)
3086 (cond
3087 ((eq (car a) 'incomplete)
3088 (format "<incomplete %s>" (nth 1 a)))
3089 ((eq (car a) 'vec)
3090 (if (or calc-full-trail-vectors (not calc-can-abbrev-vectors)
3091 (< (length a) 7))
3092 (concat "[" (math-format-flat-vector (cdr a) ", "
3093 (if (cdr (cdr a)) 0 1000)) "]")
3094 (concat "["
3095 (math-format-flat-expr (nth 1 a) 0) ", "
3096 (math-format-flat-expr (nth 2 a) 0) ", "
3097 (math-format-flat-expr (nth 3 a) 0) ", ..., "
3098 (math-format-flat-expr (nth (1- (length a)) a) 0) "]")))
3099 ((eq (car a) 'intv)
3100 (concat (if (memq (nth 1 a) '(0 1)) "(" "[")
3101 (math-format-flat-expr (nth 2 a) 1000)
3102 " .. "
3103 (math-format-flat-expr (nth 3 a) 1000)
3104 (if (memq (nth 1 a) '(0 2)) ")" "]")))
3105 ((eq (car a) 'date)
3106 (concat "<" (math-format-date a) ">"))
3107 ((and (eq (car a) 'calcFunc-lambda) (> (length a) 2))
3108 (let ((p (cdr a))
3109 (ap calc-arg-values)
3110 (math-format-hash-args (if (= (length a) 3) 1 t)))
3111 (while (and (cdr p) (equal (car p) (car ap)))
3112 (setq p (cdr p) ap (cdr ap)))
3113 (concat "<"
3114 (if (cdr p)
3115 (concat (math-format-flat-vector
3116 (nreverse (cdr (reverse (cdr a)))) ", " 0)
3117 " : ")
3118 "")
3119 (math-format-flat-expr (nth (1- (length a)) a) 0)
3120 ">")))
3121 ((eq (car a) 'var)
3122 (or (and math-format-hash-args
3123 (let ((p calc-arg-values) (v 1))
3124 (while (and p (not (equal (car p) a)))
3125 (setq p (and (eq math-format-hash-args t) (cdr p))
3126 v (1+ v)))
3127 (and p
3128 (if (eq math-format-hash-args 1)
3129 "#"
3130 (format "#%d" v)))))
3131 (symbol-name (nth 1 a))))
3132 ((and (memq (car a) '(calcFunc-string calcFunc-bstring))
3133 (= (length a) 2)
3134 (math-vectorp (nth 1 a))
3135 (math-vector-is-string (nth 1 a)))
3136 (concat (substring (symbol-name (car a)) 9)
3137 "(" (math-vector-to-string (nth 1 a) t) ")"))
3138 (t
1dccbfee 3139 (let ((op (math-assq2 (car a) (math-standard-ops))))
136211a9
EZ
3140 (cond ((and op (= (length a) 3))
3141 (if (> prec (min (nth 2 op) (nth 3 op)))
3142 (concat "(" (math-format-flat-expr a 0) ")")
3143 (let ((lhs (math-format-flat-expr (nth 1 a) (nth 2 op)))
3144 (rhs (math-format-flat-expr (nth 2 a) (nth 3 op))))
3145 (setq op (car op))
3146 (if (or (equal op "^") (equal op "_"))
3147 (if (= (aref lhs 0) ?-)
3148 (setq lhs (concat "(" lhs ")")))
3149 (setq op (concat " " op " ")))
3150 (concat lhs op rhs))))
3151 ((eq (car a) 'neg)
3152 (concat "-" (math-format-flat-expr (nth 1 a) 1000)))
3153 (t
3154 (concat (math-remove-dashes
3155 (if (string-match "\\`calcFunc-\\([a-zA-Z0-9']+\\)\\'"
3156 (symbol-name (car a)))
3157 (math-match-substring (symbol-name (car a)) 1)
3158 (symbol-name (car a))))
3159 "("
3160 (math-format-flat-vector (cdr a) ", " 0)
cce7e5a6 3161 ")")))))))
136211a9
EZ
3162
3163(defun math-format-flat-vector (vec sep prec)
3164 (if vec
3165 (let ((buf (math-format-flat-expr (car vec) prec)))
3166 (while (setq vec (cdr vec))
3167 (setq buf (concat buf sep (math-format-flat-expr (car vec) prec))))
3168 buf)
cce7e5a6 3169 ""))
136211a9
EZ
3170
3171(defun math-format-nice-expr (x w)
3172 (cond ((and (eq (car-safe x) 'vec)
3173 (cdr (cdr x))
3174 (let ((ops '(vec calcFunc-assign calcFunc-condition
3175 calcFunc-schedule calcFunc-iterations
3176 calcFunc-phase)))
3177 (or (memq (car-safe (nth 1 x)) ops)
3178 (memq (car-safe (nth 2 x)) ops)
3179 (memq (car-safe (nth 3 x)) ops)
3180 calc-break-vectors)))
3181 (concat "[ " (math-format-flat-vector (cdr x) ",\n " 0) " ]"))
3182 (t
3183 (let ((str (math-format-flat-expr x 0))
3184 (pos 0) p)
3185 (or (string-match "\"" str)
3186 (while (<= (setq p (+ pos w)) (length str))
3187 (while (and (> (setq p (1- p)) pos)
3188 (not (= (aref str p) ? ))))
3189 (if (> p (+ pos 5))
3190 (setq str (concat (substring str 0 p)
3191 "\n "
3192 (substring str p))
3193 pos (1+ p))
3194 (setq pos (+ pos w)))))
cce7e5a6 3195 str))))
136211a9
EZ
3196
3197(defun math-assq2 (v a)
3198 (while (and a (not (eq v (nth 1 (car a)))))
3199 (setq a (cdr a)))
cce7e5a6 3200 (car a))
136211a9 3201
136211a9
EZ
3202(defun math-format-number-fancy (a prec)
3203 (cond
3204 ((eq (car a) 'float) ; non-decimal radix
3205 (if (Math-integer-negp (nth 1 a))
3206 (concat "-" (math-format-number (math-neg a)))
3207 (let ((str (if (and calc-radix-formatter
3208 (not (memq calc-language '(c pascal))))
3209 (funcall calc-radix-formatter
3210 calc-number-radix
3211 (math-format-radix-float a prec))
3212 (format "%d#%s" calc-number-radix
3213 (math-format-radix-float a prec)))))
3214 (if (and prec (> prec 191) (string-match "\\*" str))
3215 (concat "(" str ")")
3216 str))))
3217 ((eq (car a) 'frac)
3218 (setq a (math-adjust-fraction a))
3219 (if (> (length (car calc-frac-format)) 1)
3220 (if (Math-integer-negp (nth 1 a))
3221 (concat "-" (math-format-number (math-neg a)))
3222 (let ((q (math-idivmod (nth 1 a) (nth 2 a))))
3223 (concat (let ((calc-frac-format nil))
3224 (math-format-number (car q)))
3225 (substring (car calc-frac-format) 0 1)
3226 (let ((math-radix-explicit-format nil)
3227 (calc-frac-format nil))
3228 (math-format-number (cdr q)))
3229 (substring (car calc-frac-format) 1 2)
3230 (let ((math-radix-explicit-format nil)
3231 (calc-frac-format nil))
3232 (math-format-number (nth 2 a))))))
3233 (concat (let ((calc-frac-format nil))
3234 (math-format-number (nth 1 a)))
3235 (car calc-frac-format)
3236 (let ((math-radix-explicit-format nil)
3237 (calc-frac-format nil))
3238 (math-format-number (nth 2 a))))))
3239 ((eq (car a) 'cplx)
3240 (if (math-zerop (nth 2 a))
3241 (math-format-number (nth 1 a))
3242 (if (null calc-complex-format)
3243 (concat "(" (math-format-number (nth 1 a))
3244 ", " (math-format-number (nth 2 a)) ")")
3245 (if (math-zerop (nth 1 a))
3246 (if (math-equal-int (nth 2 a) 1)
3247 (symbol-name calc-complex-format)
3248 (if (math-equal-int (nth 2 a) -1)
3249 (concat "-" (symbol-name calc-complex-format))
3250 (if prec
3251 (math-compose-expr (list '* (nth 2 a) '(cplx 0 1)) prec)
3252 (concat (math-format-number (nth 2 a)) " "
3253 (symbol-name calc-complex-format)))))
3254 (if prec
3255 (math-compose-expr (list (if (math-negp (nth 2 a)) '- '+)
3256 (nth 1 a)
3257 (list 'cplx 0 (math-abs (nth 2 a))))
3258 prec)
3259 (concat (math-format-number (nth 1 a))
3260 (if (math-negp (nth 2 a)) " - " " + ")
3261 (math-format-number
3262 (list 'cplx 0 (math-abs (nth 2 a))))))))))
3263 ((eq (car a) 'polar)
3264 (concat "(" (math-format-number (nth 1 a))
3265 "; " (math-format-number (nth 2 a)) ")"))
3266 ((eq (car a) 'hms)
3267 (if (math-negp a)
3268 (concat "-" (math-format-number (math-neg a)))
3269 (let ((calc-number-radix 10)
3270 (calc-leading-zeros nil)
3271 (calc-group-digits nil))
3272 (format calc-hms-format
3273 (let ((calc-frac-format '(":" nil)))
3274 (math-format-number (nth 1 a)))
3275 (let ((calc-frac-format '(":" nil)))
3276 (math-format-number (nth 2 a)))
3277 (math-format-number (nth 3 a))))))
3278 ((eq (car a) 'intv)
3279 (concat (if (memq (nth 1 a) '(0 1)) "(" "[")
3280 (math-format-number (nth 2 a))
3281 " .. "
3282 (math-format-number (nth 3 a))
3283 (if (memq (nth 1 a) '(0 2)) ")" "]")))
3284 ((eq (car a) 'sdev)
3285 (concat (math-format-number (nth 1 a))
3286 " +/- "
3287 (math-format-number (nth 2 a))))
3288 ((eq (car a) 'vec)
3289 (math-format-flat-expr a 0))
cce7e5a6 3290 (t (format "%s" a))))
136211a9
EZ
3291
3292(defun math-adjust-fraction (a)
3293 (if (nth 1 calc-frac-format)
3294 (progn
3295 (if (Math-integerp a) (setq a (list 'frac a 1)))
3296 (let ((g (math-quotient (nth 1 calc-frac-format)
3297 (math-gcd (nth 2 a)
3298 (nth 1 calc-frac-format)))))
3299 (list 'frac (math-mul (nth 1 a) g) (math-mul (nth 2 a) g))))
cce7e5a6 3300 a))
136211a9
EZ
3301
3302(defun math-format-bignum-fancy (a) ; [X L]
3303 (let ((str (cond ((= calc-number-radix 10)
3304 (math-format-bignum-decimal a))
3305 ((= calc-number-radix 2)
3306 (math-format-bignum-binary a))
3307 ((= calc-number-radix 8)
3308 (math-format-bignum-octal a))
3309 ((= calc-number-radix 16)
3310 (math-format-bignum-hex a))
3311 (t (math-format-bignum-radix a)))))
3312 (if calc-leading-zeros
3313 (let* ((calc-internal-prec 6)
3314 (digs (math-compute-max-digits (math-abs calc-word-size)
3315 calc-number-radix))
3316 (len (length str)))
3317 (if (< len digs)
3318 (setq str (concat (make-string (- digs len) ?0) str)))))
3319 (if calc-group-digits
3320 (let ((i (length str))
3321 (g (if (integerp calc-group-digits)
3322 (math-abs calc-group-digits)
3323 (if (memq calc-number-radix '(2 16)) 4 3))))
3324 (while (> i g)
3325 (setq i (- i g)
3326 str (concat (substring str 0 i)
3327 calc-group-char
3328 (substring str i))))
3329 str))
3330 (if (and (/= calc-number-radix 10)
3331 math-radix-explicit-format)
3332 (if calc-radix-formatter
3333 (funcall calc-radix-formatter calc-number-radix str)
3334 (format "%d#%s" calc-number-radix str))
cce7e5a6 3335 str)))
136211a9
EZ
3336
3337
3338(defun math-group-float (str) ; [X X]
3339 (let* ((pt (or (string-match "[^0-9a-zA-Z]" str) (length str)))
3340 (g (if (integerp calc-group-digits) (math-abs calc-group-digits) 3))
3341 (i pt))
3342 (if (and (integerp calc-group-digits) (< calc-group-digits 0))
3343 (while (< (setq i (+ (1+ i) g)) (length str))
3344 (setq str (concat (substring str 0 i)
3345 calc-group-char
3346 (substring str i))
3347 i (+ i (1- (length calc-group-char))))))
3348 (setq i pt)
3349 (while (> i g)
3350 (setq i (- i g)
3351 str (concat (substring str 0 i)
3352 calc-group-char
3353 (substring str i))))
cce7e5a6 3354 str))
136211a9 3355
136211a9
EZ
3356;;; Users can redefine this in their .emacs files.
3357(defvar calc-keypad-user-menu nil
f0529b5b 3358 "If non-nil, this describes an additional menu for calc-keypad.
136211a9
EZ
3359It should contain a list of three rows.
3360Each row should be a list of six keys.
3361Each key should be a list of a label string, plus a Calc command name spec.
3362A command spec is a command name symbol, a keyboard macro string, a
3363list containing a numeric entry string, or nil.
3364A key may contain additional specs for Inverse, Hyperbolic, and Inv+Hyp.")
3365
136211a9
EZ
3366(run-hooks 'calc-ext-load-hook)
3367
6697b53c 3368(provide 'calc-ext)
1b303b2c 3369
ab5796a9 3370;;; arch-tag: 1814ba7f-a390-49dc-9e25-a5adc205e97e
cce7e5a6 3371;;; calc-ext.el ends here