comparison lisp/calc/calc-stuff.el @ 41047:73f364fd8aaa

Style cleanup; don't put closing parens on their own line, add "foo.el ends here" to each file, and update copyright date.

41046:14b73d89514a

;; Calculator for GNU Emacs, part II [calc-stuff.el]
;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc.
;; Written by Dave Gillespie, [e-mail].

;; This file is part of GNU Emacs.

;; GNU Emacs is distributed in the hope that it will be useful,

	   (setq num (math-trunc num)))
       (or (integerp num)
	   (error "Argument must be a small integer"))
       (calc-pop-stack 1)
       (setq prefix-arg num)
       (message "%d-" num))))    ; a (lame) simulation of the real thing...
)


(defun calc-more-recursion-depth (n)
  (interactive "P")
  (calc-wrapper

       (calc-less-recursion-depth n)
     (let ((n (if n (prefix-numeric-value n) 2)))
       (if (> n 1)
	   (setq max-specpdl-size (* max-specpdl-size n)
		 max-lisp-eval-depth (* max-lisp-eval-depth n))))
     (message "max-lisp-eval-depth is now %d" max-lisp-eval-depth)))
)

(defun calc-less-recursion-depth (n)
  (interactive "P")
  (let ((n (if n (prefix-numeric-value n) 2)))
    (if (> n 1)
	(setq max-specpdl-size
	      (max (/ max-specpdl-size n) 600)
	      max-lisp-eval-depth
	      (max (/ max-lisp-eval-depth n) 200))))
  (message "max-lisp-eval-depth is now %d" max-lisp-eval-depth)
)


(defun calc-explain-why (why &optional more)
  (if (eq (car why) '*)
      (setq why (cdr why)))

      (and (car why)
	   (setq msg (concat msg punc (if (stringp (car why))
					  (car why)
					(math-format-flat-expr (car why) 0)))
		 punc ", ")))
    (message "%s%s" msg (if more "  [w=more]" "")))
)

(defun calc-why ()
  (interactive)
  (if (not (eq this-command last-command))
      (if (eq last-command calc-last-why-command)

	(setq calc-which-why (cdr calc-which-why)))
    (if calc-why
	(progn
	  (message "(No further explanations available)")
	  (setq calc-which-why calc-why))
      (message "No explanations available")))
)
(setq calc-which-why nil)
(setq calc-last-why-command nil)


(defun calc-version ()

	 math-graph-var-cache nil
	 math-graph-data-cache nil
	 math-format-date-cache nil
	 math-holidays-cache-tag t)
   (mapcar (function (lambda (x) (set x -100))) math-cache-list)
   (message "All internal calculator caches have been reset."))
)


;;; Conversions.

(defun calc-clean (n)

			       (list func
				     (calc-top-n 1)
				     (if (<= n 0)
					 (+ n calc-internal-prec)
				       n)))
			   (list func (calc-top-n 1)))))))
)

(defun calc-clean-num (num)
  (interactive "P")
  (calc-clean (- (if num
		     (prefix-numeric-value num) 
		   (if (and (>= last-command-char ?0)
			    (<= last-command-char ?9))
		       (- last-command-char ?0)
		     (error "Number required")))))
)


(defun calcFunc-clean (a &optional prec)   ; [X X S] [Public]
  (if prec
      (cond ((Math-messy-integerp prec)

		     a)
		 0)
	     a))
	  ((Math-objectp a) a)
	  ((math-infinitep a) a)
	  (t (list 'calcFunc-clean a))))
)
(setq math-chopping-small nil)

(defun calcFunc-pclean (a &optional prec)
  (math-map-over-constants (function (lambda (x) (calcFunc-clean x prec)))
			   a)
)

(defun calcFunc-pfloat (a)
  (math-map-over-constants 'math-float a)
)

(defun calcFunc-pfrac (a &optional tol)
  (math-map-over-constants (function (lambda (x) (calcFunc-frac x tol)))
			   a)
)

(defun math-map-over-constants (func expr)
  (math-map-over-constants-rec expr)
)

(defun math-map-over-constants-rec (expr)
  (cond ((or (Math-primp expr)
	     (memq (car expr) '(intv sdev)))
	 (or (and (Math-objectp expr)

	      (= (length expr) 3)
	      (Math-integerp (nth 2 expr)))
	 (list (car expr)
	       (math-map-over-constants-rec (nth 1 expr))
	       (nth 2 expr)))
	(t (cons (car expr) (mapcar 'math-map-over-constants-rec (cdr expr)))))
)

41047:73f364fd8aaa

;; Calculator for GNU Emacs, part II [calc-stuff.el]
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Written by Dave Gillespie, [e-mail].

;; This file is part of GNU Emacs.

;; GNU Emacs is distributed in the hope that it will be useful,

	   (setq num (math-trunc num)))
       (or (integerp num)
	   (error "Argument must be a small integer"))
       (calc-pop-stack 1)
       (setq prefix-arg num)
       (message "%d-" num)))))    ; a (lame) simulation of the real thing...


(defun calc-more-recursion-depth (n)
  (interactive "P")
  (calc-wrapper

       (calc-less-recursion-depth n)
     (let ((n (if n (prefix-numeric-value n) 2)))
       (if (> n 1)
	   (setq max-specpdl-size (* max-specpdl-size n)
		 max-lisp-eval-depth (* max-lisp-eval-depth n))))
     (message "max-lisp-eval-depth is now %d" max-lisp-eval-depth))))

(defun calc-less-recursion-depth (n)
  (interactive "P")
  (let ((n (if n (prefix-numeric-value n) 2)))
    (if (> n 1)
	(setq max-specpdl-size
	      (max (/ max-specpdl-size n) 600)
	      max-lisp-eval-depth
	      (max (/ max-lisp-eval-depth n) 200))))
  (message "max-lisp-eval-depth is now %d" max-lisp-eval-depth))


(defun calc-explain-why (why &optional more)
  (if (eq (car why) '*)
      (setq why (cdr why)))

      (and (car why)
	   (setq msg (concat msg punc (if (stringp (car why))
					  (car why)
					(math-format-flat-expr (car why) 0)))
		 punc ", ")))
    (message "%s%s" msg (if more "  [w=more]" ""))))

(defun calc-why ()
  (interactive)
  (if (not (eq this-command last-command))
      (if (eq last-command calc-last-why-command)

	(setq calc-which-why (cdr calc-which-why)))
    (if calc-why
	(progn
	  (message "(No further explanations available)")
	  (setq calc-which-why calc-why))
      (message "No explanations available"))))
(setq calc-which-why nil)
(setq calc-last-why-command nil)


(defun calc-version ()

	 math-graph-var-cache nil
	 math-graph-data-cache nil
	 math-format-date-cache nil
	 math-holidays-cache-tag t)
   (mapcar (function (lambda (x) (set x -100))) math-cache-list)
   (message "All internal calculator caches have been reset.")))


;;; Conversions.

(defun calc-clean (n)

			       (list func
				     (calc-top-n 1)
				     (if (<= n 0)
					 (+ n calc-internal-prec)
				       n)))
			   (list func (calc-top-n 1))))))))

(defun calc-clean-num (num)
  (interactive "P")
  (calc-clean (- (if num
		     (prefix-numeric-value num) 
		   (if (and (>= last-command-char ?0)
			    (<= last-command-char ?9))
		       (- last-command-char ?0)
		     (error "Number required"))))))


(defun calcFunc-clean (a &optional prec)   ; [X X S] [Public]
  (if prec
      (cond ((Math-messy-integerp prec)

		     a)
		 0)
	     a))
	  ((Math-objectp a) a)
	  ((math-infinitep a) a)
	  (t (list 'calcFunc-clean a)))))
(setq math-chopping-small nil)

(defun calcFunc-pclean (a &optional prec)
  (math-map-over-constants (function (lambda (x) (calcFunc-clean x prec)))
			   a))

(defun calcFunc-pfloat (a)
  (math-map-over-constants 'math-float a))

(defun calcFunc-pfrac (a &optional tol)
  (math-map-over-constants (function (lambda (x) (calcFunc-frac x tol)))
			   a))

(defun math-map-over-constants (func expr)
  (math-map-over-constants-rec expr))

(defun math-map-over-constants-rec (expr)
  (cond ((or (Math-primp expr)
	     (memq (car expr) '(intv sdev)))
	 (or (and (Math-objectp expr)

	      (= (length expr) 3)
	      (Math-integerp (nth 2 expr)))
	 (list (car expr)
	       (math-map-over-constants-rec (nth 1 expr))
	       (nth 2 expr)))
	(t (cons (car expr) (mapcar 'math-map-over-constants-rec (cdr expr))))))

;;; calc-stuff.el ends here