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