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