/[emacs]/emacs/lisp/calc/calc-stuff.el
ViewVC logotype

Diff of /emacs/lisp/calc/calc-stuff.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by eliz, Tue Nov 6 18:59:06 2001 UTC revision 1.2 by walters, Wed Nov 14 09:07:22 2001 UTC
# Line 1  Line 1 
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.
# Line 43  With a prefix, push that prefix as a num Line 43  With a prefix, push that prefix as a num
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)
# Line 56  With a prefix, push that prefix as a num Line 55  With a prefix, push that prefix as a num
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")
# Line 67  With a prefix, push that prefix as a num Line 65  With a prefix, push that prefix as a num
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)
# Line 137  With a prefix, push that prefix as a num Line 134  With a prefix, push that prefix as a num
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)
# Line 154  With a prefix, push that prefix as a num Line 150  With a prefix, push that prefix as a num
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    
# Line 184  With a prefix, push that prefix as a num Line 179  With a prefix, push that prefix as a num
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.
# Line 203  With a prefix, push that prefix as a num Line 197  With a prefix, push that prefix as a num
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")
# Line 213  With a prefix, push that prefix as a num Line 206  With a prefix, push that prefix as a num
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]
# Line 257  With a prefix, push that prefix as a num Line 249  With a prefix, push that prefix as a num
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)
# Line 292  With a prefix, push that prefix as a num Line 279  With a prefix, push that prefix as a num
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

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26