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