1 |
;; Calculator for GNU Emacs, part II [calc-stuff.el] |
;; Calculator for GNU Emacs, part II [calc-stuff.el] |
2 |
;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc. |
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. |
3 |
;; Written by Dave Gillespie, daveg@synaptics.com. |
;; Written by Dave Gillespie, daveg@synaptics.com. |
4 |
|
|
5 |
;; This file is part of GNU Emacs. |
;; This file is part of GNU Emacs. |
43 |
(error "Argument must be a small integer")) |
(error "Argument must be a small integer")) |
44 |
(calc-pop-stack 1) |
(calc-pop-stack 1) |
45 |
(setq prefix-arg num) |
(setq prefix-arg num) |
46 |
(message "%d-" num)))) ; a (lame) simulation of the real thing... |
(message "%d-" num))))) ; a (lame) simulation of the real thing... |
|
) |
|
47 |
|
|
48 |
|
|
49 |
(defun calc-more-recursion-depth (n) |
(defun calc-more-recursion-depth (n) |
55 |
(if (> n 1) |
(if (> n 1) |
56 |
(setq max-specpdl-size (* max-specpdl-size n) |
(setq max-specpdl-size (* max-specpdl-size n) |
57 |
max-lisp-eval-depth (* max-lisp-eval-depth n)))) |
max-lisp-eval-depth (* max-lisp-eval-depth n)))) |
58 |
(message "max-lisp-eval-depth is now %d" max-lisp-eval-depth))) |
(message "max-lisp-eval-depth is now %d" max-lisp-eval-depth)))) |
|
) |
|
59 |
|
|
60 |
(defun calc-less-recursion-depth (n) |
(defun calc-less-recursion-depth (n) |
61 |
(interactive "P") |
(interactive "P") |
65 |
(max (/ max-specpdl-size n) 600) |
(max (/ max-specpdl-size n) 600) |
66 |
max-lisp-eval-depth |
max-lisp-eval-depth |
67 |
(max (/ max-lisp-eval-depth n) 200)))) |
(max (/ max-lisp-eval-depth n) 200)))) |
68 |
(message "max-lisp-eval-depth is now %d" max-lisp-eval-depth) |
(message "max-lisp-eval-depth is now %d" max-lisp-eval-depth)) |
|
) |
|
69 |
|
|
70 |
|
|
71 |
(defun calc-explain-why (why &optional more) |
(defun calc-explain-why (why &optional more) |
134 |
(car why) |
(car why) |
135 |
(math-format-flat-expr (car why) 0))) |
(math-format-flat-expr (car why) 0))) |
136 |
punc ", "))) |
punc ", "))) |
137 |
(message "%s%s" msg (if more " [w=more]" ""))) |
(message "%s%s" msg (if more " [w=more]" "")))) |
|
) |
|
138 |
|
|
139 |
(defun calc-why () |
(defun calc-why () |
140 |
(interactive) |
(interactive) |
150 |
(progn |
(progn |
151 |
(message "(No further explanations available)") |
(message "(No further explanations available)") |
152 |
(setq calc-which-why calc-why)) |
(setq calc-which-why calc-why)) |
153 |
(message "No explanations available"))) |
(message "No explanations available")))) |
|
) |
|
154 |
(setq calc-which-why nil) |
(setq calc-which-why nil) |
155 |
(setq calc-last-why-command nil) |
(setq calc-last-why-command nil) |
156 |
|
|
179 |
math-format-date-cache nil |
math-format-date-cache nil |
180 |
math-holidays-cache-tag t) |
math-holidays-cache-tag t) |
181 |
(mapcar (function (lambda (x) (set x -100))) math-cache-list) |
(mapcar (function (lambda (x) (set x -100))) math-cache-list) |
182 |
(message "All internal calculator caches have been reset.")) |
(message "All internal calculator caches have been reset."))) |
|
) |
|
183 |
|
|
184 |
|
|
185 |
;;; Conversions. |
;;; Conversions. |
197 |
(if (<= n 0) |
(if (<= n 0) |
198 |
(+ n calc-internal-prec) |
(+ n calc-internal-prec) |
199 |
n))) |
n))) |
200 |
(list func (calc-top-n 1))))))) |
(list func (calc-top-n 1)))))))) |
|
) |
|
201 |
|
|
202 |
(defun calc-clean-num (num) |
(defun calc-clean-num (num) |
203 |
(interactive "P") |
(interactive "P") |
206 |
(if (and (>= last-command-char ?0) |
(if (and (>= last-command-char ?0) |
207 |
(<= last-command-char ?9)) |
(<= last-command-char ?9)) |
208 |
(- last-command-char ?0) |
(- last-command-char ?0) |
209 |
(error "Number required"))))) |
(error "Number required")))))) |
|
) |
|
210 |
|
|
211 |
|
|
212 |
(defun calcFunc-clean (a &optional prec) ; [X X S] [Public] |
(defun calcFunc-clean (a &optional prec) ; [X X S] [Public] |
249 |
a)) |
a)) |
250 |
((Math-objectp a) a) |
((Math-objectp a) a) |
251 |
((math-infinitep a) a) |
((math-infinitep a) a) |
252 |
(t (list 'calcFunc-clean a)))) |
(t (list 'calcFunc-clean a))))) |
|
) |
|
253 |
(setq math-chopping-small nil) |
(setq math-chopping-small nil) |
254 |
|
|
255 |
(defun calcFunc-pclean (a &optional prec) |
(defun calcFunc-pclean (a &optional prec) |
256 |
(math-map-over-constants (function (lambda (x) (calcFunc-clean x prec))) |
(math-map-over-constants (function (lambda (x) (calcFunc-clean x prec))) |
257 |
a) |
a)) |
|
) |
|
258 |
|
|
259 |
(defun calcFunc-pfloat (a) |
(defun calcFunc-pfloat (a) |
260 |
(math-map-over-constants 'math-float a) |
(math-map-over-constants 'math-float a)) |
|
) |
|
261 |
|
|
262 |
(defun calcFunc-pfrac (a &optional tol) |
(defun calcFunc-pfrac (a &optional tol) |
263 |
(math-map-over-constants (function (lambda (x) (calcFunc-frac x tol))) |
(math-map-over-constants (function (lambda (x) (calcFunc-frac x tol))) |
264 |
a) |
a)) |
|
) |
|
265 |
|
|
266 |
(defun math-map-over-constants (func expr) |
(defun math-map-over-constants (func expr) |
267 |
(math-map-over-constants-rec expr) |
(math-map-over-constants-rec expr)) |
|
) |
|
268 |
|
|
269 |
(defun math-map-over-constants-rec (expr) |
(defun math-map-over-constants-rec (expr) |
270 |
(cond ((or (Math-primp expr) |
(cond ((or (Math-primp expr) |
279 |
(list (car expr) |
(list (car expr) |
280 |
(math-map-over-constants-rec (nth 1 expr)) |
(math-map-over-constants-rec (nth 1 expr)) |
281 |
(nth 2 expr))) |
(nth 2 expr))) |
282 |
(t (cons (car expr) (mapcar 'math-map-over-constants-rec (cdr expr))))) |
(t (cons (car expr) (mapcar 'math-map-over-constants-rec (cdr expr)))))) |
|
) |
|
|
|
|
|
|
|
|
|
|
283 |
|
|
284 |
|
;;; calc-stuff.el ends here |