delete_temp_file fix
[bpt/emacs.git] / lisp / calc / calc-stuff.el
CommitLineData
3132f345
CW
1;;; calc-stuff.el --- miscellaneous functions for Calc
2
ba318903 3;; Copyright (C) 1990-1993, 2001-2014 Free Software Foundation, Inc.
3132f345
CW
4
5;; Author: David Gillespie <daveg@synaptics.com>
e8fff8ed 6;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
136211a9
EZ
7
8;; This file is part of GNU Emacs.
9
662c9c64 10;; GNU Emacs is free software: you can redistribute it and/or modify
7c671b23 11;; it under the terms of the GNU General Public License as published by
662c9c64
GM
12;; the Free Software Foundation, either version 3 of the License, or
13;; (at your option) any later version.
7c671b23 14
136211a9 15;; GNU Emacs is distributed in the hope that it will be useful,
7c671b23
GM
16;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18;; GNU General Public License for more details.
19
20;; You should have received a copy of the GNU General Public License
662c9c64 21;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
136211a9 22
3132f345 23;;; Commentary:
136211a9 24
3132f345 25;;; Code:
136211a9
EZ
26
27;; This file is autoloaded from calc-ext.el.
136211a9 28
a2e360d6 29(require 'calc-ext)
136211a9
EZ
30(require 'calc-macs)
31
136211a9
EZ
32(defun calc-num-prefix (n)
33 "Use the number at the top of stack as the numeric prefix for the next command.
34With a prefix, push that prefix as a number onto the stack."
35 (interactive "P")
36 (calc-wrapper
37 (if n
38 (calc-enter-result 0 "" (prefix-numeric-value n))
39 (let ((num (calc-top 1)))
40 (if (math-messy-integerp num)
41 (setq num (math-trunc num)))
42 (or (integerp num)
43 (error "Argument must be a small integer"))
44 (calc-pop-stack 1)
45 (setq prefix-arg num)
bf77c646 46 (message "%d-" num))))) ; a (lame) simulation of the real thing...
136211a9
EZ
47
48
49(defun calc-more-recursion-depth (n)
50 (interactive "P")
51 (calc-wrapper
52 (if (calc-is-inverse)
53 (calc-less-recursion-depth n)
54 (let ((n (if n (prefix-numeric-value n) 2)))
55 (if (> n 1)
56 (setq max-specpdl-size (* max-specpdl-size n)
57 max-lisp-eval-depth (* max-lisp-eval-depth n))))
bf77c646 58 (message "max-lisp-eval-depth is now %d" max-lisp-eval-depth))))
136211a9
EZ
59
60(defun calc-less-recursion-depth (n)
61 (interactive "P")
62 (let ((n (if n (prefix-numeric-value n) 2)))
63 (if (> n 1)
64 (setq max-specpdl-size
65 (max (/ max-specpdl-size n) 600)
66 max-lisp-eval-depth
67 (max (/ max-lisp-eval-depth n) 200))))
bf77c646 68 (message "max-lisp-eval-depth is now %d" max-lisp-eval-depth))
136211a9
EZ
69
70
3132f345
CW
71(defvar calc-which-why nil)
72(defvar calc-last-why-command nil)
136211a9
EZ
73(defun calc-explain-why (why &optional more)
74 (if (eq (car why) '*)
75 (setq why (cdr why)))
76 (let* ((pred (car why))
77 (arg (nth 1 why))
78 (msg (cond ((not pred) "Wrong type of argument")
79 ((stringp pred) pred)
80 ((eq pred 'integerp) "Integer expected")
81 ((eq pred 'natnump)
82 (if (and arg (Math-objvecp arg) (not (Math-integerp arg)))
83 "Integer expected"
84 "Nonnegative integer expected"))
85 ((eq pred 'posintp)
86 (if (and arg (Math-objvecp arg) (not (Math-integerp arg)))
87 "Integer expected"
88 "Positive integer expected"))
89 ((eq pred 'fixnump)
90 (if (and arg (Math-integerp arg))
91 "Small integer expected"
92 "Integer expected"))
93 ((eq pred 'fixnatnump)
94 (if (and arg (Math-natnump arg))
95 "Small integer expected"
96 (if (and arg (Math-objvecp arg)
97 (not (Math-integerp arg)))
98 "Integer expected"
99 "Nonnegative integer expected")))
100 ((eq pred 'fixposintp)
101 (if (and arg (Math-integerp arg) (Math-posp arg))
102 "Small integer expected"
103 (if (and arg (Math-objvecp arg)
104 (not (Math-integerp arg)))
105 "Integer expected"
106 "Positive integer expected")))
107 ((eq pred 'posp) "Positive number expected")
108 ((eq pred 'negp) "Negative number expected")
109 ((eq pred 'nonzerop) "Nonzero number expected")
110 ((eq pred 'realp) "Real number expected")
111 ((eq pred 'anglep) "Real number expected")
112 ((eq pred 'hmsp) "HMS form expected")
113 ((eq pred 'datep)
114 (if (and arg (Math-objectp arg)
115 (not (Math-realp arg)))
116 "Real number or date form expected"
117 "Date form expected"))
118 ((eq pred 'numberp) "Number expected")
119 ((eq pred 'scalarp) "Number expected")
120 ((eq pred 'vectorp) "Vector or matrix expected")
121 ((eq pred 'numvecp) "Number or vector expected")
122 ((eq pred 'matrixp) "Matrix expected")
123 ((eq pred 'square-matrixp)
124 (if (and arg (math-matrixp arg))
125 "Square matrix expected"
126 "Matrix expected"))
127 ((eq pred 'objectp) "Number expected")
128 ((eq pred 'constp) "Constant expected")
129 ((eq pred 'range) "Argument out of range")
130 (t (format "%s expected" pred))))
131 (punc ": ")
132 (calc-can-abbrev-vectors t))
133 (while (setq why (cdr why))
134 (and (car why)
135 (setq msg (concat msg punc (if (stringp (car why))
136 (car why)
137 (math-format-flat-expr (car why) 0)))
138 punc ", ")))
bf77c646 139 (message "%s%s" msg (if more " [w=more]" ""))))
136211a9
EZ
140
141(defun calc-why ()
142 (interactive)
143 (if (not (eq this-command last-command))
144 (if (eq last-command calc-last-why-command)
145 (setq calc-which-why (cdr calc-why))
146 (setq calc-which-why calc-why)))
147 (if calc-which-why
148 (progn
149 (calc-explain-why (car calc-which-why) (cdr calc-which-why))
150 (setq calc-which-why (cdr calc-which-why)))
151 (if calc-why
152 (progn
153 (message "(No further explanations available)")
154 (setq calc-which-why calc-why))
bf77c646 155 (message "No explanations available"))))
136211a9 156
32bac5ed
JB
157;; The following caches are declared in other files, but are
158;; reset here.
159(defvar math-lud-cache) ; calc-mtx.el
160(defvar math-log2-cache) ; calc-bin.el
161(defvar math-radix-digits-cache) ; calc-bin.el
162(defvar math-radix-float-cache-tag) ; calc-bin.el
163(defvar math-random-cache) ; calc-comb.el
164(defvar math-max-digits-cache) ; calc-bin.el
165(defvar math-integral-cache) ; calcalg2.el
166(defvar math-units-table) ; calc-units.el
e206ee4c 167(defvar math-decls-cache-tag) ; calc-arith.el
32bac5ed
JB
168(defvar math-format-date-cache) ; calc-forms.el
169(defvar math-holidays-cache-tag) ; calc-forms.el
136211a9 170
9b08ce78
CW
171(defun calc-flush-caches (&optional inhibit-msg)
172 (interactive "P")
136211a9
EZ
173 (calc-wrapper
174 (setq math-lud-cache nil
175 math-log2-cache nil
176 math-radix-digits-cache nil
177 math-radix-float-cache-tag nil
178 math-random-cache nil
179 math-max-digits-cache nil
136211a9
EZ
180 math-integral-cache nil
181 math-units-table nil
182 math-decls-cache-tag nil
183 math-eval-rules-cache-tag t
136211a9
EZ
184 math-format-date-cache nil
185 math-holidays-cache-tag t)
4d2a9fe4 186 (mapc (function (lambda (x) (set x -100))) math-cache-list)
9b08ce78
CW
187 (unless inhibit-msg
188 (message "All internal calculator caches have been reset"))))
136211a9
EZ
189
190
191;;; Conversions.
192
193(defun calc-clean (n)
194 (interactive "P")
195 (calc-slow-wrapper
196 (calc-with-default-simplification
197 (let ((func (if (calc-is-hyperbolic) 'calcFunc-clean 'calcFunc-pclean)))
198 (calc-enter-result 1 "cln"
199 (if n
200 (let ((n (prefix-numeric-value n)))
201 (list func
202 (calc-top-n 1)
203 (if (<= n 0)
204 (+ n calc-internal-prec)
205 n)))
bf77c646 206 (list func (calc-top-n 1))))))))
136211a9
EZ
207
208(defun calc-clean-num (num)
209 (interactive "P")
210 (calc-clean (- (if num
a1506d29 211 (prefix-numeric-value num)
e93c003e
GM
212 (if (and (>= last-command-event ?0)
213 (<= last-command-event ?9))
214 (- last-command-event ?0)
bf77c646 215 (error "Number required"))))))
136211a9
EZ
216
217
3132f345 218(defvar math-chopping-small nil)
136211a9
EZ
219(defun calcFunc-clean (a &optional prec) ; [X X S] [Public]
220 (if prec
221 (cond ((Math-messy-integerp prec)
222 (calcFunc-clean a (math-trunc prec)))
223 ((or (not (integerp prec))
224 (< prec 3))
225 (calc-record-why "*Precision must be an integer 3 or above")
226 (list 'calcFunc-clean a prec))
227 ((not (Math-objvecp a))
228 (list 'calcFunc-clean a prec))
229 (t (let ((calc-internal-prec prec)
230 (math-chopping-small t))
231 (calcFunc-clean (math-normalize a)))))
232 (cond ((eq (car-safe a) 'polar)
233 (let ((theta (math-mod (nth 2 a)
234 (if (eq calc-angle-mode 'rad)
235 (math-two-pi)
236 360))))
237 (math-neg
238 (math-neg
239 (math-normalize
240 (list 'polar
241 (calcFunc-clean (nth 1 a))
242 (calcFunc-clean theta)))))))
243 ((memq (car-safe a) '(vec date hms))
244 (cons (car a) (mapcar 'calcFunc-clean (cdr a))))
245 ((memq (car-safe a) '(cplx mod sdev intv))
246 (math-normalize (cons (car a) (mapcar 'calcFunc-clean (cdr a)))))
247 ((eq (car-safe a) 'float)
248 (if math-chopping-small
249 (if (or (> (nth 2 a) (- calc-internal-prec))
250 (Math-lessp (- calc-internal-prec) (calcFunc-xpon a)))
251 (if (and (math-num-integerp a)
252 (math-lessp (calcFunc-xpon a) calc-internal-prec))
253 (math-trunc a)
254 a)
255 0)
256 a))
257 ((Math-objectp a) a)
258 ((math-infinitep a) a)
bf77c646 259 (t (list 'calcFunc-clean a)))))
136211a9
EZ
260
261(defun calcFunc-pclean (a &optional prec)
262 (math-map-over-constants (function (lambda (x) (calcFunc-clean x prec)))
bf77c646 263 a))
136211a9
EZ
264
265(defun calcFunc-pfloat (a)
bf77c646 266 (math-map-over-constants 'math-float a))
136211a9
EZ
267
268(defun calcFunc-pfrac (a &optional tol)
269 (math-map-over-constants (function (lambda (x) (calcFunc-frac x tol)))
bf77c646 270 a))
136211a9 271
32bac5ed
JB
272;; The variable math-moc-func is local to math-map-over-constants,
273;; but is used by math-map-over-constants-rec, which is called by
274;; math-map-over-constants.
275(defvar math-moc-func)
276
277(defun math-map-over-constants (math-moc-func expr)
bf77c646 278 (math-map-over-constants-rec expr))
136211a9
EZ
279
280(defun math-map-over-constants-rec (expr)
281 (cond ((or (Math-primp expr)
282 (memq (car expr) '(intv sdev)))
283 (or (and (Math-objectp expr)
32bac5ed 284 (funcall math-moc-func expr))
136211a9
EZ
285 expr))
286 ((and (memq (car expr) '(^ calcFunc-subscr))
32bac5ed 287 (eq math-moc-func 'math-float)
136211a9
EZ
288 (= (length expr) 3)
289 (Math-integerp (nth 2 expr)))
290 (list (car expr)
291 (math-map-over-constants-rec (nth 1 expr))
292 (nth 2 expr)))
bf77c646 293 (t (cons (car expr) (mapcar 'math-map-over-constants-rec (cdr expr))))))
136211a9 294
a2e360d6
JB
295(provide 'calc-stuff)
296
bf77c646 297;;; calc-stuff.el ends here