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