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