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