comparison lisp/calc/calc.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

calc-pop-above calc-power calc-roll-down calc-roll-up
calc-shift-Y-prefix-help calc-tutorial calcDigit-letter
report-calc-bug)

))

)

(calc-init-base)

		   (symbolp
		    (lookup-key calc-dispatch-map (substring keys 0 1)))
		   (define-key calc-dispatch-map (substring keys 0 1) nil))
	      (define-key calc-dispatch-map keys 'calc-same-interface))))
    (error nil))
  (calc-do-dispatch arg)
)

(defun calc-do-dispatch (arg)
  (let ((key (calc-read-key-sequence
	      (if calc-dispatch-help
		  "Calc options: Calc, Keypad, Quick, Embed; eXit; Info, Tutorial; Grab; ?=more"

    (message "")
    (if key
	(progn
	  (or (commandp key) (calc-extensions))
	  (call-interactively key))
      (beep)))
)
(setq calc-dispatch-help nil)

(defun calc-read-key-sequence (prompt map)
  (let ((prompt2 (format "%s " (key-description (this-command-keys))))
	(glob (current-global-map))

	     (if (commandp (key-binding (if calc-emacs-type-19
					    (vector (cdr key))
					  (char-to-string (cdr key)))))
		 "" prompt2)))
	(use-global-map glob)
	(use-local-map loc))))
)



(defun calc-mode ()
  "Calculator major mode.

	(message "Evaluating calc-defs...")
	(calc-need-macros)
	(eval (cons 'progn calc-defs))
	(setq calc-defs nil)
	(calc-set-mode-line)))
  (calc-check-defines)
)

(defun calc-check-defines ()
  (if (symbol-plist 'calc-define)
      (let ((plist (copy-sequence (symbol-plist 'calc-define))))
	(while (and plist (null (nth 1 plist)))

		(put 'calc-define (car plist) nil)
		(eval (nth 1 plist))
		(setq plist (cdr (cdr plist))))
	      ;; See if this has added any more calc-define properties.
	      (calc-check-defines))
	  (setplist 'calc-define nil))))
)
(setq calc-check-defines 'calc-check-defines)  ; suitable for run-hooks

(defun calc-trail-mode (&optional buf)
  "Calc Trail mode.
This mode is used by the *Calc Trail* buffer, which records all results

	(setq calc-main-buffer buf)))
  (if (= (buffer-size) 0)
      (let ((buffer-read-only nil))
	(insert "Emacs Calculator v" calc-version " by Dave Gillespie, "
		"installed " calc-installed-date "\n")))
  (run-hooks 'calc-trail-mode-hook)
)

(defun calc-create-buffer ()
  (set-buffer (get-buffer-create "*Calculator*"))
  (or (eq major-mode 'calc-mode)
      (calc-mode))

  (if calc-always-load-extensions
      (calc-extensions))
  (if calc-language
      (progn
	(calc-extensions)
	(calc-set-language calc-language calc-language-option t)))
)

;;;###autoload
(defun calc (&optional arg full-display interactive)
  "The Emacs Calculator.  Full documentation is listed under \"calc-mode\"."
  (interactive "P")

	(and calc-said-hello
	     (or (interactive-p) interactive)
	     (progn
	       (sit-for 2)
	       (message "")))
	(setq calc-said-hello t))))
)

;;;###autoload
(defun full-calc ()
  "Invoke the Calculator and give it a full-sized window."
  (interactive)
  (calc nil t (interactive-p))
)

(defun calc-same-interface (arg)
  "Invoke the Calculator using the most recent interface (calc or calc-keypad)."
  (interactive "P")
  (if (and (equal (buffer-name) "*Gnuplot Trail*")

	(calc-edit-finish arg)
      (if (eq major-mode 'MacEdit-mode)
	  (MacEdit-finish-edit)
	(if calc-was-keypad-mode
	    (calc-keypad)
	  (calc arg calc-full-mode t)))))
)


(defun calc-quit (&optional non-fatal)
  (interactive)
  (and calc-standalone-flag (not non-fatal)

	      (calc-delete-windows-keep buf kbuf)
	    (delete-windows-on buf)
	    (delete-windows-on kbuf))
	  (bury-buffer buf)
	  (bury-buffer calc-trail-buffer)
	  (and kbuf (bury-buffer kbuf))))))
)

;;;###autoload
(defun quick-calc ()
  "Do a quick calculation in the minibuffer without invoking full Calculator."
  (interactive)
  (calc-do-quick-calc)
)

;;;###autoload
(defun calc-eval (str &optional separator &rest args)
  "Do a quick calculation and return the result as a string.
Return value will either be the formatted result in string form,
or a list containing a character position and an error message in string form."
  (calc-do-calc-eval str separator args)
)

;;;###autoload
(defun calc-keypad ()
  "Invoke the Calculator in \"visual keypad\" mode.
This is most useful in the X window system.
In this mode, click on the Calc \"buttons\" using the left mouse button.
Or, position the cursor manually and do M-x calc-keypad-press."
  (interactive)
  (calc-extensions)
  (calc-do-keypad calc-full-mode (interactive-p))
)

;;;###autoload
(defun full-calc-keypad ()
  "Invoke the Calculator in full-screen \"visual keypad\" mode.
See calc-keypad for details."
  (interactive)
  (calc-extensions)
  (calc-do-keypad t (interactive-p))
)


;;; Note that modifications to this function may break calc-pass-errors.
(defun calc-do (do-body &optional do-slow)
  (calc-check-defines)

      (and (memq 'do-edit calc-command-flags)
	   (switch-to-buffer (get-buffer-create "*Calc Edit*")))
      (calc-set-mode-line)
      (and calc-embedded-info
	   (calc-embedded-finish-command))))
  (identity nil)  ; allow a GC after timing is done
)
(setq calc-aborted-prefix nil)
(setq calc-start-time nil)

(defun calc-set-command-flag (f)
  (if (not (memq f calc-command-flags))
      (setq calc-command-flags (cons f calc-command-flags)))
)

(defun calc-select-buffer ()
  (or (eq major-mode 'calc-mode)
      (if calc-main-buffer
	  (set-buffer calc-main-buffer)
	(let ((buf (get-buffer "*Calculator*")))
	  (if buf
	      (set-buffer buf)
	    (error "Calculator buffer not available")))))
)

(defun calc-cursor-stack-index (&optional index)
  (goto-char (point-max))
  (forward-line (- (calc-substack-height (or index 1))))
)

(defun calc-stack-size ()
  (- (length calc-stack) calc-stack-top)
)

(defun calc-substack-height (n)
  (let ((sum 0)
	(stack calc-stack))
    (setq n (+ n calc-stack-top))
    (while (and (> n 0) stack)
      (setq sum (+ sum (nth 1 (car stack)))
	    n (1- n)
	    stack (cdr stack)))
    sum)
)

(defun calc-set-mode-line ()
  (save-excursion
    (calc-select-buffer)
    (let* ((fmt (car calc-float-format))

		     (apply 'concat calc-other-modes)))))
      (if (equal new-mode-string mode-line-buffer-identification)
	  nil
	(setq mode-line-buffer-identification new-mode-string)
	(set-buffer-modified-p (buffer-modified-p))
	(and calc-embedded-info (calc-embedded-mode-line-change)))))
)

(defun calc-align-stack-window ()
  (if (eq major-mode 'calc-mode)
      (progn
	(let ((win (get-buffer-window (current-buffer))))

	(calc-cursor-stack-index 0)
	(if (looking-at " *\\.$")
	    (goto-char (1- (match-end 0)))))
    (save-excursion
      (calc-select-buffer)
      (calc-align-stack-window)))
)

(defun calc-check-stack (n)
  (if (> n (calc-stack-size))
      (error "Too few elements on stack"))
  (if (< n 0)
      (error "Invalid argument"))
)

(defun calc-push-list (vals &optional m sels)
  (while vals
    (if calc-executing-macro
	(calc-push-list-in-macro vals m sels)

	  (let ((buffer-read-only nil))
	    (insert (math-format-stack-value entry) "\n"))
	  (calc-record-undo (list 'push mm))
	  (calc-set-command-flag 'renum-stack))))
    (setq vals (cdr vals)
	  sels (cdr sels)))
)

(defun calc-pop-push-list (n vals &optional m sels)
  (if (and calc-any-selections (null sels))
      (calc-replace-selections n vals m)
    (calc-pop-stack n m sels)
    (calc-push-list vals m sels))
)

(defun calc-pop-push-record-list (n prefix vals &optional m sels)
  (or (and (consp vals)
	   (or (integerp (car vals))
	       (consp (car vals))))

  (calc-check-stack (+ n (or m 1) -1))
  (if prefix
      (if (cdr vals)
	  (calc-record-list vals prefix)
	(calc-record (car vals) prefix)))
  (calc-pop-push-list n vals m sels)
)

(defun calc-enter-result (n prefix vals &optional m)
  (setq calc-aborted-prefix prefix)
  (if (and (consp vals)
	   (or (integerp (car vals))

	       (consp (car vals))))
      (setq vals (list vals)))
  (if (equal vals '((nil)))
      (setq vals nil))
  (calc-pop-push-record-list n prefix vals m)
  (calc-handle-whys)
)

(defun calc-normalize (val)
  (if (memq calc-simplify-mode '(nil none num))
      (math-normalize val)
    (calc-extensions)
    (calc-normalize-fancy val))
)

(defun calc-handle-whys ()
  (if calc-next-why
      (calc-do-handle-whys))
)


(defun calc-pop-stack (&optional n m sel-ok)  ; pop N objs at level M of stack.
  (or n (setq n 1))
  (or m (setq m 1))

		    (setcdr (nthcdr (- mm 2) calc-stack)
			    (nthcdr (+ n mm -1) calc-stack)))
		(calc-cursor-stack-index n)
		(setq calc-stack (nthcdr n calc-stack))
		(delete-region (point) (point-max))))
	    (calc-set-command-flag 'renum-stack)))))
)

(defun calc-get-stack-element (x)
  (cond ((eq sel-mode 'entry)
	 x)
	((eq sel-mode 'sel)

	     (eq sel-mode 'full)
	     (not calc-use-selections))
	 (car x))
	(sel-mode
	 (calc-sel-error))
	(t (nth 2 x)))
)

;; Get the Nth element of the stack (N=1 is the top element).
(defun calc-top (&optional n sel-mode)
  (or n (setq n 1))
  (calc-check-stack n)
  (calc-get-stack-element (nth (+ n calc-stack-top -1) calc-stack))
)

(defun calc-top-n (&optional n sel-mode)    ; in case precision has changed
  (math-check-complete (calc-normalize (calc-top n sel-mode)))
)

(defun calc-top-list (&optional n m sel-mode)
  (or n (setq n 1))
  (or m (setq m 1))
  (calc-check-stack (+ n m -1))
  (and (> n 0)
       (let ((top (copy-sequence (nthcdr (+ m calc-stack-top -1)
					 calc-stack))))
	 (setcdr (nthcdr (1- n) top) nil)
	 (nreverse (mapcar 'calc-get-stack-element top))))
)

(defun calc-top-list-n (&optional n m sel-mode)
  (mapcar 'math-check-complete
	  (mapcar 'calc-normalize (calc-top-list n m sel-mode)))
)


(defun calc-renumber-stack ()
  (if calc-line-numbering
      (save-excursion

					calc-use-selections) "*" ":")
			(make-string (- 3 (length prefix)) 32))))
	    (beginning-of-line)
	    (setq lnum (1+ lnum)
		  stack (cdr stack))))))
  (and calc-embedded-info (calc-embedded-stack-change))
)

(defun calc-refresh (&optional align)
  (interactive)
  (and (eq major-mode 'calc-mode)
       (not calc-executing-macro)

	 (if save-mark (set-mark save-mark))))
  (and calc-embedded-info (not (eq major-mode 'calc-mode))
       (save-excursion
	 (set-buffer (aref calc-embedded-info 1))
	 (calc-refresh align)))
  (setq calc-refresh-count (1+ calc-refresh-count))
)


(defun calc-x-paste-text (arg)
  "Move point to mouse position and insert window system cut buffer contents.
If mouse is pressed in Calc window, push cut buffer contents onto the stack."

	       (progn
		 (setq val (math-read-exprs buf))
		 (if (eq (car-safe val) 'error)
		     (error "%s in yanked data" (nth 2 val)))))
	   (calc-enter-result 0 "Xynk" val))))
    (x-paste-text arg))
)



;;;; The Calc Trail buffer.

(defun calc-check-trail-aligned ()
  (save-excursion
    (let ((win (get-buffer-window (current-buffer))))
      (and win
	   (pos-visible-in-window-p (1- (point-max)) win))))
)

(defun calc-trail-buffer ()
  (and (or (null calc-trail-buffer)
	   (null (buffer-name calc-trail-buffer)))
       (save-excursion

	   (eq (marker-buffer calc-trail-pointer) calc-trail-buffer))
      (save-excursion
	(set-buffer calc-trail-buffer)
	(goto-line 2)
	(setq calc-trail-pointer (point-marker))))
  calc-trail-buffer
)

(defun calc-record (val &optional prefix)
  (setq calc-aborted-prefix nil)
  (or calc-executing-macro
      (let* ((mainbuf (current-buffer))

	    (insert fval "\n")
	    (let ((win (get-buffer-window buf)))
	      (if (and aligned win (not (memq 'hold-trail calc-command-flags)))
		  (calc-trail-here))
	      (goto-char (1- (point-max))))))))
  val
)


(defun calc-trail-display (flag &optional no-refresh)
  (interactive "P")
  (let ((win (get-buffer-window (calc-trail-buffer))))

	    (calc-wrapper
	     (or no-refresh
		 (if (interactive-p)
		     (calc-do-refresh)
		   (calc-refresh))))))))
  calc-trail-buffer
)

(defun calc-trail-here ()
  (interactive)
  (if (eq major-mode 'calc-trail-mode)
      (progn

		  (set-window-start win (point))
		  (set-window-point win (+ calc-trail-pointer 4))
		  (set-buffer calc-main-buffer)
		  (setq overlay-arrow-string calc-trail-overlay
			overlay-arrow-position calc-trail-pointer))))))
    (error "Not in Calc Trail buffer"))
)




;;;; The Undo list.

      (if (memq 'undo calc-command-flags)
	  (setq calc-undo-list (cons (cons rec (car calc-undo-list))
				     (cdr calc-undo-list)))
	(setq calc-undo-list (cons (list rec) calc-undo-list)
	      calc-redo-list nil)
	(calc-set-command-flag 'undo)))
)




;;; Arithmetic commands.

  (if (null arg)
      (calc-enter-result 2 name (cons (or func2 func)
				      (mapcar 'math-check-complete
					      (calc-top-list 2))))
    (calc-extensions)
    (calc-binary-op-fancy name func arg ident unary))
)

(defun calc-unary-op (name func arg &optional func2)
  (setq calc-aborted-prefix name)
  (if (null arg)
      (calc-enter-result 1 name (list (or func2 func)
				      (math-check-complete (calc-top 1))))
    (calc-extensions)
    (calc-unary-op-fancy name func arg))
)


(defun calc-plus (arg)
  (interactive "P")
  (calc-slow-wrapper
   (calc-binary-op "+" 'calcFunc-add arg 0 nil '+))
)

(defun calc-minus (arg)
  (interactive "P")
  (calc-slow-wrapper
   (calc-binary-op "-" 'calcFunc-sub arg 0 'neg '-))
)

(defun calc-times (arg)
  (interactive "P")
  (calc-slow-wrapper
   (calc-binary-op "*" 'calcFunc-mul arg 1 nil '*))
)

(defun calc-divide (arg)
  (interactive "P")
  (calc-slow-wrapper
   (calc-binary-op "/" 'calcFunc-div arg 0 'calcFunc-inv '/))
)


(defun calc-change-sign (arg)
  (interactive "P")
  (calc-wrapper
   (calc-unary-op "chs" 'neg arg))
)



;;; Stack management commands.

   (cond ((< n 0)
	  (calc-push-list (calc-top-list 1 (- n))))
	 ((= n 0)
	  (calc-push-list (calc-top-list (calc-stack-size))))
	 (t
	  (calc-push-list (calc-top-list n)))))
)


(defun calc-pop (n)
  (interactive "P")
  (calc-wrapper

	   (t
	    (if (and calc-any-selections
		     (= nn 1)
		     (calc-top-selected 1 1))
		(calc-delete-selection 1)
	      (calc-pop-stack nn))))))
)




;;;; Reading a number using the minibuffer.

	     (calc-push-list (list (calc-record (calc-normalize
						 calc-digit-value))))))
       (if (eq calc-prev-char 'dots)
	   (progn
	     (calc-extensions)
	     (calc-dots))))))
)

(defsubst calc-minibuffer-size ()
  (- (point-max) (minibuffer-prompt-end)))

(defun calcDigit-nondigit ()

	(progn (setq prefix-arg current-prefix-arg)
	       (calc-unread-command (if (and (eq last-command-char 27)
					     (>= last-input-char 128))
					last-input-char
				      nil))))
    (exit-minibuffer))
)


(defun calc-minibuffer-contains (rex)
  (save-excursion
    (goto-char (minibuffer-prompt-end))
    (looking-at rex))
)

(defun calcDigit-key ()
  (interactive)
  (goto-char (point-max))
  (if (or (and (memq last-command-char '(?+ ?-))

	      (calc-digit-dots))
	  (delete-backward-char 1)
	  (beep)
	  (calc-temp-minibuffer-message " [Bad format]"))))))
  (setq calc-prev-prev-char calc-prev-char
	calc-prev-char last-command-char)
)


(defun calcDigit-backspace ()
  (interactive)
  (goto-char (point-max))

	 (erase-buffer))
	(t (backward-delete-char 1)))
  (if (= (calc-minibuffer-size) 0)
      (progn
	(setq last-command-char 13)
	(calcDigit-nondigit)))
)

		       (setq var-EvalRules nil)
		       (math-normalize (cons (car a) args)))
		   (calc-record-why "*Variable is void" (nth 1 err)))))
	      (if (consp (car a))
		  (math-dimension-error)
		(cons (car a) args)))))))
)



;;; True if A is a floating-point real or complex number.  [P x] [Public]
(defun math-floatp (a)

	((memq (car-safe a) '(cplx polar mod sdev intv))
	 (or (math-floatp (nth 1 a))
	     (math-floatp (nth 2 a))
	     (and (eq (car a) 'intv) (math-floatp (nth 3 a)))))
	((eq (car-safe a) 'date)
	 (math-floatp (nth 1 a))))
)



;;; Verify that A is a complete object and return A.  [x x] [Public]
(defun math-check-complete (a)
  (cond ((integerp a) a)
	((eq (car-safe a) 'incomplete)
	 (calc-incomplete-error a))
	((consp a) a)
	(t (error "Invalid data object encountered")))
)



;;; Coerce integer A to be a bignum.  [B S]
(defun math-bignum (a)
  (if (>= a 0)
      (cons 'bigpos (math-bignum-big a))
    (cons 'bigneg (math-bignum-big (- a))))
)

(defun math-bignum-big (a)   ; [L s]
  (if (= a 0)
      nil
    (cons (% a 1000) (math-bignum-big (/ a 1000))))
)


;;; Build a normalized floating-point number.  [F I S]
(defun math-make-float (mant exp)
  (if (eq mant 0)

	     (<= (+ exp (math-numdigs mant) -1) -4000000))
	(signal 'math-underflow nil)
      (if (and (>= exp 3000000)
	       (>= (+ exp (math-numdigs mant) -1) 4000000))
	  (signal 'math-overflow nil)
	(list 'float mant exp))))
)

(defun math-div10-bignum (a)   ; [l l]
  (if (cdr a)
      (cons (+ (/ (car a) 10) (* (% (nth 1 a) 10) 100))
	    (math-div10-bignum (cdr a)))
    (list (/ (car a) 10)))
)

;;; Coerce A to be a float.  [F N; V V] [Public]
(defun math-float (a)
  (cond ((Math-integerp a) (math-make-float a 0))
	((eq (car a) 'frac) (math-div (math-float (nth 1 a)) (nth 2 a)))
	((eq (car a) 'float) a)
	((memq (car a) '(cplx polar vec hms date sdev mod))
	 (cons (car a) (mapcar 'math-float (cdr a))))
	(t (math-float-fancy a)))
)


(defun math-neg (a)
  (cond ((not (consp a)) (- a))
	((eq (car a) 'bigpos) (cons 'bigneg (cdr a)))
	((eq (car a) 'bigneg) (cons 'bigpos (cdr a)))
	((memq (car a) '(frac float))
	 (list (car a) (Math-integer-neg (nth 1 a)) (nth 2 a)))
	((memq (car a) '(cplx vec hms date calcFunc-idn))
	 (cons (car a) (mapcar 'math-neg (cdr a))))
	(t (math-neg-fancy a)))
)


;;; Compute the number of decimal digits in integer A.  [S I]
(defun math-numdigs (a)
  (if (consp a)

	  ((>= a 10) 2)
	  ((>= a 1) 1)
	  ((= a 0) 0)
	  ((> a -10) 1)
	  ((> a -100) 2)
	  (t (math-numdigs (- a)))))
)

;;; Multiply (with truncation toward 0) the integer A by 10^N.  [I i S]
(defun math-scale-int (a n)
  (cond ((= n 0) a)
	((> n 0) (math-scale-left a n))
	(t (math-normalize (math-scale-right a (- n)))))
)

(defun math-scale-left (a n)   ; [I I S]
  (if (= n 0)
      a
    (if (consp a)

	    (if (or (>= a 10000) (<= a -10000))
		(math-scale-left (math-bignum a) 2)
	      (* a 100))
	  (if (or (>= a 100000) (<= a -100000))
	      (math-scale-left (math-bignum a) 1)
	    (* a 10))))))
)

(defun math-scale-left-bignum (a n)
  (if (>= n 3)
      (while (>= (setq a (cons 0 a)
		       n (- n 3)) 3)))
  (if (> n 0)
      (math-mul-bignum-digit a (if (= n 2) 100 10) 0)
    a)
)

(defun math-scale-right (a n)   ; [i i S]
  (if (= n 0)
      a
    (if (consp a)

			(>= (setq n (- n 3)) 3))))
	(if (= n 2)
	    (/ a 100)
	  (if (= n 1)
	      (/ a 10)
	    a)))))
)

(defun math-scale-right-bignum (a n)   ; [L L S; l l S]
  (if (>= n 3)
      (setq a (nthcdr (/ n 3) a)
	    n (% n 3)))
  (if (> n 0)
      (cdr (math-mul-bignum-digit a (if (= n 2) 10 100) 0))
    a)
)

;;; Multiply (with rounding) the integer A by 10^N.   [I i S]
(defun math-scale-rounding (a n)
  (cond ((>= n 0)
	 (math-scale-left a n))

	(t
	 (if (< a 0)
	     (- (math-scale-rounding (- a) n))
	   (if (= n -1)
	       (/ (+ a 5) 10)
	     (/ (+ (math-scale-right a (- -1 n)) 5) 10)))))
)


;;; Compute the sum of A and B.  [O O O] [Public]
(defun math-add (a b)
  (or

		    (setq b (math-float b)))
		(math-add-float a b)))
	 (and (calc-extensions)
	      (math-add-objects-fancy a b))))
   (and (calc-extensions)
	(math-add-symb-fancy a b)))
)

(defun math-add-bignum (a b)   ; [L L L; l l l]
  (if a
      (if b
	  (let* ((a (copy-sequence a)) (aa a) (carry nil) sum)

		    (nconc a '(1))))
	      (if b
		  (nconc a b)
		a)))
	a)
    b)
)

(defun math-sub-bignum (a b)   ; [l l l]
  (if b
      (if a
	  (let* ((a (copy-sequence a)) (aa a) (borrow nil) sum)

		a)))
	(while (eq (car b) 0)
	  (setq b (cdr b)))
	(and b
	     'neg))
    a)
)

(defun math-add-float (a b)   ; [F F F]
  (let ((ediff (- (nth 2 a) (nth 2 b))))
    (if (>= ediff 0)
	(if (>= ediff (+ calc-internal-prec calc-internal-prec))

      (if (>= (setq ediff (- ediff))
	      (+ calc-internal-prec calc-internal-prec))
	  b
	(math-make-float (math-add (nth 1 a)
				   (math-scale-left (nth 1 b) ediff))
			 (nth 2 a)))))
)

;;; Compute the difference of A and B.  [O O O] [Public]
(defun math-sub (a b)
  (if (or (consp a) (consp b))
      (math-add a (math-neg b))
    (setq a (- a b))
    (if (or (<= a -1000000) (>= a 1000000))
	(math-bignum a)
      a))
)

(defun math-sub-float (a b)   ; [F F F]
  (let ((ediff (- (nth 2 a) (nth 2 b))))
    (if (>= ediff 0)
	(if (>= ediff (+ calc-internal-prec calc-internal-prec))

	      (+ calc-internal-prec calc-internal-prec))
	  b
	(math-make-float (math-add (nth 1 a)
				   (Math-integer-neg
				    (math-scale-left (nth 1 b) ediff)))
			 (nth 2 a)))))
)


;;; Compute the product of A and B.  [O O O] [Public]
(defun math-mul (a b)
  (or

		(math-make-float (math-mul (nth 1 a) (nth 1 b))
				 (+ (nth 2 a) (nth 2 b)))))
	 (and (calc-extensions)
	      (math-mul-objects-fancy a b))))
   (and (calc-extensions)
	(math-mul-symb-fancy a b)))
)

(defun math-infinitep (a &optional undir)
  (while (and (consp a) (memq (car a) '(* / neg)))
    (if (or (not (eq (car a) '*)) (math-infinitep (nth 1 a)))
	(setq a (nth 1 a))

  (and (consp a)
       (eq (car a) 'var)
       (memq (nth 2 a) '(var-inf var-uinf var-nan))
       (if (and undir (eq (nth 2 a) 'var-inf))
	   '(var uinf var-uinf)
	 a))
)

;;; Multiply digit lists A and B.  [L L L; l l l]
(defun math-mul-bignum (a b)
  (and a b
       (let* ((sum (if (<= (car b) 1)

		   ss (or (cdr ss) (setcdr ss (list 0)))))
	   (if (>= prod 1000)
	       (if (cdr ss)
		   (setcar (cdr ss) (+ (/ prod 1000) (car (cdr ss))))
		 (setcdr ss (list (/ prod 1000))))))
	 sum))
)

;;; Multiply digit list A by digit D.  [L L D D; l l D D]
(defun math-mul-bignum-digit (a d c)
  (if a
      (if (<= d 1)

		  c (/ prod 1000)))
	  (if (>= prod 1000)
	      (setcdr aa (list (/ prod 1000))))
	  a))
    (and (> c 0)
	 (list c)))
)


;;; Compute the integer (quotient . remainder) of A and B, which may be
;;; small or big integers.  Type and consistency of truncation is undefined
;;; if A or B is negative.  B must be nonzero.  [I.I I I] [Public]

	(let ((res (math-div-bignum (cdr a) (cdr b))))
	  (cons
	   (math-normalize (cons (if (eq (car a) (car b)) 'bigpos 'bigneg)
				 (car res)))
	   (math-normalize (cons (car a) (cdr res))))))
    (cons (/ a b) (% a b)))
)

(defun math-quotient (a b)   ; [I I I] [Public]
  (if (and (not (consp a)) (not (consp b)))
      (if (= b 0)
	  (math-reject-arg a "*Division by zero")

	     (d (/ 1000 (1+ (nth (1- blen) (cdr b)))))
	     (res (math-div-bignum-big (math-mul-bignum-digit (cdr a) d 0)
				       (math-mul-bignum-digit (cdr b) d 0)
				       alen blen)))
	(math-normalize (cons (if (eq (car a) (car b)) 'bigpos 'bigneg)
			      (car res))))))
)


;;; Divide a bignum digit list by another.  [l.l l L]
;;; The following division algorithm is borrowed from Knuth vol. II, sec. 4.3.1
(defun math-div-bignum (a b)

	(if (= d 1)
	    res
	  (cons (car res)
		(car (math-div-bignum-digit (cdr res) d)))))
    (let ((res (math-div-bignum-digit a (car b))))
      (cons (car res) (list (cdr res)))))
)

;;; Divide a bignum digit list by a digit.  [l.D l D]
(defun math-div-bignum-digit (a b)
  (if a
      (let* ((res (math-div-bignum-digit (cdr a) b))
	     (num (+ (* (cdr res) 1000) (car a))))
	(cons
	 (cons (/ num b) (car res))
	 (% num b)))
    '(nil . 0))
)

(defun math-div-bignum-big (a b alen blen)   ; [l.l l L]
  (if (< alen blen)
      (cons nil a)
    (let* ((res (math-div-bignum-big (cdr a) b (1- alen) blen))
	   (num (cons (car a) (cdr res)))
	   (res2 (math-div-bignum-part num b blen)))
      (cons
       (cons (car res2) (car res))
       (cdr res2))))
)

(defun math-div-bignum-part (a b blen)   ; a < b*1000  [D.l l L]
  (let* ((num (+ (* (or (nth blen a) 0) 1000) (or (nth (1- blen) a) 0)))
	 (den (nth (1- blen) b))
	 (guess (min (/ num den) 999)))
    (math-div-bignum-try a b (math-mul-bignum-digit b guess 0) guess))
)

(defun math-div-bignum-try (a b c guess)   ; [D.l l l D]
  (let ((rem (math-sub-bignum a c)))
    (if (eq rem 'neg)
	(math-div-bignum-try a b (math-sub-bignum c b) (1- guess))
      (cons guess rem)))
)


;;; Compute the quotient of A and B.  [O O N] [Public]
(defun math-div (a b)
  (or

		    (setq b (math-float b)))
		(math-div-float a b)))
	 (and (calc-extensions)
	      (math-div-objects-fancy a b))))
   (and (calc-extensions)
	(math-div-symb-fancy a b)))
)

(defun math-div-float (a b)   ; [F F F]
  (let ((ldiff (max (- (1+ calc-internal-prec)
		       (- (math-numdigs (nth 1 a)) (math-numdigs (nth 1 b))))
		    0)))
    (math-make-float (math-quotient (math-scale-int (nth 1 a) ldiff) (nth 1 b))
		     (- (- (nth 2 a) (nth 2 b)) ldiff)))
)

      (if calc-line-numbering
	  (progn
	    (aset s 0 ?1)
	    (aset s 1 ?:))))
    (setcar (cdr entry) (calc-count-lines s))
    s)
)

(defun math-stack-value-offset (c)
  (let* ((num (if calc-line-numbering 4 0))
	 (wid (calc-window-width))
	 off)

	  (math-stack-value-offset-fancy))
      (setq off (or calc-display-origin 0))
      (if (integerp calc-line-breaking)
	  (setq wid calc-line-breaking)))
    (cons (max (- off (length calc-left-label)) 0)
	  (+ wid num)))
)

(defun calc-count-lines (s)
  (let ((pos 0)
	(num 1))
    (while (setq newpos (string-match "\n" s pos))
      (setq pos (1+ newpos)
	    num (1+ num)))
    num)
)

(defun math-format-value (a &optional w)
  (if (and (Math-scalarp a)
	   (memq calc-language '(nil flat unform)))
      (math-format-number a)
    (calc-extensions)
    (let ((calc-line-breaking nil))
      (math-composition-to-string (math-compose-expr a 0) w)))
)

(defun calc-window-width ()
  (if calc-embedded-info
      (let ((win (get-buffer-window (aref calc-embedded-info 0))))
	(1- (if win (window-width win) (frame-width))))
    (- (window-width (get-buffer-window (current-buffer)))
       (if calc-line-numbering 5 1)))
)

(defun math-comp-concat (c1 c2)
  (if (and (stringp c1) (stringp c2))
      (concat c1 c2)
    (list 'horiz c1 c2))
)



;;; Format an expression as a one-line string suitable for re-reading.

	  (calc-hms-format "%s@ %s' %s\"")
	  (calc-language nil))
      (math-format-number a)))
   (t
    (calc-extensions)
    (math-format-flat-expr-fancy a prec)))
)



;;; Format a number as a string.
(defun math-format-number (a &optional prec)   ; [X N]   [Public]

				    "%se%d")
				  str (- eadj scale)))))))
	str)))
   (t
    (calc-extensions)
    (math-format-number-fancy a prec)))
)

(defun math-format-bignum (a)   ; [X L]
  (if (and (= calc-number-radix 10)
	   (not calc-leading-zeros)
	   (not calc-group-digits))
      (math-format-bignum-decimal a)
    (calc-extensions)
    (math-format-bignum-fancy a))
)

(defun math-format-bignum-decimal (a)   ; [X L]
  (if a
      (let ((s ""))
	(while (cdr (cdr a))
	  (setq s (concat (format "%06d" (+ (* (nth 1 a) 1000) (car a))) s)
		a (cdr (cdr a))))
	(concat (int-to-string (+ (* (or (nth 1 a) 0) 1000) (car a))) s))
    "0")
)



;;; Parse a simple number in string form.   [N X] [Public]
(defun math-read-number (s)

	 (and mant exp (Math-realp mant) (> exp -4000000) (< exp 4000000)
	      (let ((mant (math-float mant)))
		(list 'float (nth 1 mant) (+ (nth 2 mant) exp)))))))

    ;; Syntax error!
    (t nil)))
)

(defun math-match-substring (s n)
  (if (match-beginning n)
      (substring s (match-beginning n) (match-end n))
    "")
)

(defun math-read-bignum (s)   ; [l X]
  (if (> (length s) 3)
      (cons (string-to-int (substring s -3))
	    (math-read-bignum (substring s 0 -3)))
    (list (string-to-int s)))
)


(defconst math-tex-ignore-words
  '( ("\\hbox") ("\\mbox") ("\\text") ("\\left") ("\\right")
     ("\\,") ("\\>") ("\\:") ("\\;") ("\\!") ("\\ ")

;;;###autoload
(defun calc-grab-region (top bot arg)
  "Parse the region as a vector of numbers and push it on the Calculator stack."
  (interactive "r\nP")
  (calc-extensions)
  (calc-do-grab-region top bot arg)
)

;;;###autoload
(defun calc-grab-rectangle (top bot arg)
  "Parse a rectangle as a matrix of numbers and push it on the Calculator stack."
  (interactive "r\nP")
  (calc-extensions)
  (calc-do-grab-rectangle top bot arg)
)

(defun calc-grab-sum-down (top bot arg)
  "Parse a rectangle as a matrix of numbers and sum its columns."
  (interactive "r\nP")
  (calc-extensions)
  (calc-do-grab-rectangle top bot arg 'calcFunc-reduced)
)

(defun calc-grab-sum-across (top bot arg)
  "Parse a rectangle as a matrix of numbers and sum its rows."
  (interactive "r\nP")
  (calc-extensions)
  (calc-do-grab-rectangle top bot arg 'calcFunc-reducea)
)


;;;###autoload
(defun calc-embedded (arg &optional end obeg oend)
  "Start Calc Embedded mode on the formula surrounding point."
  (interactive "P")
  (calc-extensions)
  (calc-do-embedded arg end obeg oend)
)

;;;###autoload
(defun calc-embedded-activate (&optional arg cbuf)
  "Scan the current editing buffer for all embedded := and => formulas.
Also looks for the equivalent TeX words, \\gets and \\evalto."
  (interactive "P")
  (calc-do-embedded-activate arg cbuf)
)


(defun calc-user-invocation ()
  (interactive)
  (or (stringp calc-invocation-macro)
      (error "Use `Z I' inside Calc to define a `M-# Z' keyboard macro"))
  (execute-kbd-macro calc-invocation-macro nil)
)




;;; User-programmability.

;;;###autoload
(defmacro defmath (func args &rest body)   ;  [Public]
  (calc-extensions)
  (math-do-defmath func args body)
)


;;; Functions needed for Lucid Emacs support.

(defun calc-read-key (&optional optkey)

	(calc-emacs-type-gnu19
	 (let ((key (read-event)))
	   (cons key key)))
	(t
	 (let ((key (read-char)))
	   (cons key key))))
)

(defun calc-unread-command (&optional input)
  (if (featurep 'xemacs)
      (setq unread-command-event
	    (if (integerp input) (character-to-event input)

    (setq unread-command-events nil)))

(if calc-always-load-extensions
    (progn
      (calc-extensions)
      (calc-load-everything))
)


(run-hooks 'calc-load-hook)

41047:73f364fd8aaa

calc-pop-above calc-power calc-roll-down calc-roll-up
calc-shift-Y-prefix-help calc-tutorial calcDigit-letter
report-calc-bug)

))
)

(calc-init-base)

		   (symbolp
		    (lookup-key calc-dispatch-map (substring keys 0 1)))
		   (define-key calc-dispatch-map (substring keys 0 1) nil))
	      (define-key calc-dispatch-map keys 'calc-same-interface))))
    (error nil))
  (calc-do-dispatch arg))

(defun calc-do-dispatch (arg)
  (let ((key (calc-read-key-sequence
	      (if calc-dispatch-help
		  "Calc options: Calc, Keypad, Quick, Embed; eXit; Info, Tutorial; Grab; ?=more"

    (message "")
    (if key
	(progn
	  (or (commandp key) (calc-extensions))
	  (call-interactively key))
      (beep))))
(setq calc-dispatch-help nil)

(defun calc-read-key-sequence (prompt map)
  (let ((prompt2 (format "%s " (key-description (this-command-keys))))
	(glob (current-global-map))

	     (if (commandp (key-binding (if calc-emacs-type-19
					    (vector (cdr key))
					  (char-to-string (cdr key)))))
		 "" prompt2)))
	(use-global-map glob)
	(use-local-map loc)))))



(defun calc-mode ()
  "Calculator major mode.

	(message "Evaluating calc-defs...")
	(calc-need-macros)
	(eval (cons 'progn calc-defs))
	(setq calc-defs nil)
	(calc-set-mode-line)))
  (calc-check-defines))

(defun calc-check-defines ()
  (if (symbol-plist 'calc-define)
      (let ((plist (copy-sequence (symbol-plist 'calc-define))))
	(while (and plist (null (nth 1 plist)))

		(put 'calc-define (car plist) nil)
		(eval (nth 1 plist))
		(setq plist (cdr (cdr plist))))
	      ;; See if this has added any more calc-define properties.
	      (calc-check-defines))
	  (setplist 'calc-define nil)))))
(setq calc-check-defines 'calc-check-defines)  ; suitable for run-hooks

(defun calc-trail-mode (&optional buf)
  "Calc Trail mode.
This mode is used by the *Calc Trail* buffer, which records all results

	(setq calc-main-buffer buf)))
  (if (= (buffer-size) 0)
      (let ((buffer-read-only nil))
	(insert "Emacs Calculator v" calc-version " by Dave Gillespie, "
		"installed " calc-installed-date "\n")))
  (run-hooks 'calc-trail-mode-hook))

(defun calc-create-buffer ()
  (set-buffer (get-buffer-create "*Calculator*"))
  (or (eq major-mode 'calc-mode)
      (calc-mode))

  (if calc-always-load-extensions
      (calc-extensions))
  (if calc-language
      (progn
	(calc-extensions)
	(calc-set-language calc-language calc-language-option t))))

;;;###autoload
(defun calc (&optional arg full-display interactive)
  "The Emacs Calculator.  Full documentation is listed under \"calc-mode\"."
  (interactive "P")

	(and calc-said-hello
	     (or (interactive-p) interactive)
	     (progn
	       (sit-for 2)
	       (message "")))
	(setq calc-said-hello t)))))

;;;###autoload
(defun full-calc ()
  "Invoke the Calculator and give it a full-sized window."
  (interactive)
  (calc nil t (interactive-p)))

(defun calc-same-interface (arg)
  "Invoke the Calculator using the most recent interface (calc or calc-keypad)."
  (interactive "P")
  (if (and (equal (buffer-name) "*Gnuplot Trail*")

	(calc-edit-finish arg)
      (if (eq major-mode 'MacEdit-mode)
	  (MacEdit-finish-edit)
	(if calc-was-keypad-mode
	    (calc-keypad)
	  (calc arg calc-full-mode t))))))


(defun calc-quit (&optional non-fatal)
  (interactive)
  (and calc-standalone-flag (not non-fatal)

	      (calc-delete-windows-keep buf kbuf)
	    (delete-windows-on buf)
	    (delete-windows-on kbuf))
	  (bury-buffer buf)
	  (bury-buffer calc-trail-buffer)
	  (and kbuf (bury-buffer kbuf)))))))

;;;###autoload
(defun quick-calc ()
  "Do a quick calculation in the minibuffer without invoking full Calculator."
  (interactive)
  (calc-do-quick-calc))

;;;###autoload
(defun calc-eval (str &optional separator &rest args)
  "Do a quick calculation and return the result as a string.
Return value will either be the formatted result in string form,
or a list containing a character position and an error message in string form."
  (calc-do-calc-eval str separator args))

;;;###autoload
(defun calc-keypad ()
  "Invoke the Calculator in \"visual keypad\" mode.
This is most useful in the X window system.
In this mode, click on the Calc \"buttons\" using the left mouse button.
Or, position the cursor manually and do M-x calc-keypad-press."
  (interactive)
  (calc-extensions)
  (calc-do-keypad calc-full-mode (interactive-p)))

;;;###autoload
(defun full-calc-keypad ()
  "Invoke the Calculator in full-screen \"visual keypad\" mode.
See calc-keypad for details."
  (interactive)
  (calc-extensions)
  (calc-do-keypad t (interactive-p)))


;;; Note that modifications to this function may break calc-pass-errors.
(defun calc-do (do-body &optional do-slow)
  (calc-check-defines)

      (and (memq 'do-edit calc-command-flags)
	   (switch-to-buffer (get-buffer-create "*Calc Edit*")))
      (calc-set-mode-line)
      (and calc-embedded-info
	   (calc-embedded-finish-command))))
  (identity nil))  ; allow a GC after timing is done

(setq calc-aborted-prefix nil)
(setq calc-start-time nil)

(defun calc-set-command-flag (f)
  (if (not (memq f calc-command-flags))
      (setq calc-command-flags (cons f calc-command-flags))))

(defun calc-select-buffer ()
  (or (eq major-mode 'calc-mode)
      (if calc-main-buffer
	  (set-buffer calc-main-buffer)
	(let ((buf (get-buffer "*Calculator*")))
	  (if buf
	      (set-buffer buf)
	    (error "Calculator buffer not available"))))))

(defun calc-cursor-stack-index (&optional index)
  (goto-char (point-max))
  (forward-line (- (calc-substack-height (or index 1)))))

(defun calc-stack-size ()
  (- (length calc-stack) calc-stack-top))

(defun calc-substack-height (n)
  (let ((sum 0)
	(stack calc-stack))
    (setq n (+ n calc-stack-top))
    (while (and (> n 0) stack)
      (setq sum (+ sum (nth 1 (car stack)))
	    n (1- n)
	    stack (cdr stack)))
    sum))

(defun calc-set-mode-line ()
  (save-excursion
    (calc-select-buffer)
    (let* ((fmt (car calc-float-format))

		     (apply 'concat calc-other-modes)))))
      (if (equal new-mode-string mode-line-buffer-identification)
	  nil
	(setq mode-line-buffer-identification new-mode-string)
	(set-buffer-modified-p (buffer-modified-p))
	(and calc-embedded-info (calc-embedded-mode-line-change))))))

(defun calc-align-stack-window ()
  (if (eq major-mode 'calc-mode)
      (progn
	(let ((win (get-buffer-window (current-buffer))))

	(calc-cursor-stack-index 0)
	(if (looking-at " *\\.$")
	    (goto-char (1- (match-end 0)))))
    (save-excursion
      (calc-select-buffer)
      (calc-align-stack-window))))

(defun calc-check-stack (n)
  (if (> n (calc-stack-size))
      (error "Too few elements on stack"))
  (if (< n 0)
      (error "Invalid argument")))

(defun calc-push-list (vals &optional m sels)
  (while vals
    (if calc-executing-macro
	(calc-push-list-in-macro vals m sels)

	  (let ((buffer-read-only nil))
	    (insert (math-format-stack-value entry) "\n"))
	  (calc-record-undo (list 'push mm))
	  (calc-set-command-flag 'renum-stack))))
    (setq vals (cdr vals)
	  sels (cdr sels))))

(defun calc-pop-push-list (n vals &optional m sels)
  (if (and calc-any-selections (null sels))
      (calc-replace-selections n vals m)
    (calc-pop-stack n m sels)
    (calc-push-list vals m sels)))

(defun calc-pop-push-record-list (n prefix vals &optional m sels)
  (or (and (consp vals)
	   (or (integerp (car vals))
	       (consp (car vals))))

  (calc-check-stack (+ n (or m 1) -1))
  (if prefix
      (if (cdr vals)
	  (calc-record-list vals prefix)
	(calc-record (car vals) prefix)))
  (calc-pop-push-list n vals m sels))

(defun calc-enter-result (n prefix vals &optional m)
  (setq calc-aborted-prefix prefix)
  (if (and (consp vals)
	   (or (integerp (car vals))

	       (consp (car vals))))
      (setq vals (list vals)))
  (if (equal vals '((nil)))
      (setq vals nil))
  (calc-pop-push-record-list n prefix vals m)
  (calc-handle-whys))

(defun calc-normalize (val)
  (if (memq calc-simplify-mode '(nil none num))
      (math-normalize val)
    (calc-extensions)
    (calc-normalize-fancy val)))

(defun calc-handle-whys ()
  (if calc-next-why
      (calc-do-handle-whys)))


(defun calc-pop-stack (&optional n m sel-ok)  ; pop N objs at level M of stack.
  (or n (setq n 1))
  (or m (setq m 1))

		    (setcdr (nthcdr (- mm 2) calc-stack)
			    (nthcdr (+ n mm -1) calc-stack)))
		(calc-cursor-stack-index n)
		(setq calc-stack (nthcdr n calc-stack))
		(delete-region (point) (point-max))))
	    (calc-set-command-flag 'renum-stack))))))

(defun calc-get-stack-element (x)
  (cond ((eq sel-mode 'entry)
	 x)
	((eq sel-mode 'sel)

	     (eq sel-mode 'full)
	     (not calc-use-selections))
	 (car x))
	(sel-mode
	 (calc-sel-error))
	(t (nth 2 x))))

;; Get the Nth element of the stack (N=1 is the top element).
(defun calc-top (&optional n sel-mode)
  (or n (setq n 1))
  (calc-check-stack n)
  (calc-get-stack-element (nth (+ n calc-stack-top -1) calc-stack)))

(defun calc-top-n (&optional n sel-mode)    ; in case precision has changed
  (math-check-complete (calc-normalize (calc-top n sel-mode))))

(defun calc-top-list (&optional n m sel-mode)
  (or n (setq n 1))
  (or m (setq m 1))
  (calc-check-stack (+ n m -1))
  (and (> n 0)
       (let ((top (copy-sequence (nthcdr (+ m calc-stack-top -1)
					 calc-stack))))
	 (setcdr (nthcdr (1- n) top) nil)
	 (nreverse (mapcar 'calc-get-stack-element top)))))

(defun calc-top-list-n (&optional n m sel-mode)
  (mapcar 'math-check-complete
	  (mapcar 'calc-normalize (calc-top-list n m sel-mode))))


(defun calc-renumber-stack ()
  (if calc-line-numbering
      (save-excursion

					calc-use-selections) "*" ":")
			(make-string (- 3 (length prefix)) 32))))
	    (beginning-of-line)
	    (setq lnum (1+ lnum)
		  stack (cdr stack))))))
  (and calc-embedded-info (calc-embedded-stack-change)))

(defun calc-refresh (&optional align)
  (interactive)
  (and (eq major-mode 'calc-mode)
       (not calc-executing-macro)

	 (if save-mark (set-mark save-mark))))
  (and calc-embedded-info (not (eq major-mode 'calc-mode))
       (save-excursion
	 (set-buffer (aref calc-embedded-info 1))
	 (calc-refresh align)))
  (setq calc-refresh-count (1+ calc-refresh-count)))


(defun calc-x-paste-text (arg)
  "Move point to mouse position and insert window system cut buffer contents.
If mouse is pressed in Calc window, push cut buffer contents onto the stack."

	       (progn
		 (setq val (math-read-exprs buf))
		 (if (eq (car-safe val) 'error)
		     (error "%s in yanked data" (nth 2 val)))))
	   (calc-enter-result 0 "Xynk" val))))
    (x-paste-text arg)))



;;;; The Calc Trail buffer.

(defun calc-check-trail-aligned ()
  (save-excursion
    (let ((win (get-buffer-window (current-buffer))))
      (and win
	   (pos-visible-in-window-p (1- (point-max)) win)))))

(defun calc-trail-buffer ()
  (and (or (null calc-trail-buffer)
	   (null (buffer-name calc-trail-buffer)))
       (save-excursion

	   (eq (marker-buffer calc-trail-pointer) calc-trail-buffer))
      (save-excursion
	(set-buffer calc-trail-buffer)
	(goto-line 2)
	(setq calc-trail-pointer (point-marker))))
  calc-trail-buffer)

(defun calc-record (val &optional prefix)
  (setq calc-aborted-prefix nil)
  (or calc-executing-macro
      (let* ((mainbuf (current-buffer))

	    (insert fval "\n")
	    (let ((win (get-buffer-window buf)))
	      (if (and aligned win (not (memq 'hold-trail calc-command-flags)))
		  (calc-trail-here))
	      (goto-char (1- (point-max))))))))
  val)


(defun calc-trail-display (flag &optional no-refresh)
  (interactive "P")
  (let ((win (get-buffer-window (calc-trail-buffer))))

	    (calc-wrapper
	     (or no-refresh
		 (if (interactive-p)
		     (calc-do-refresh)
		   (calc-refresh))))))))
  calc-trail-buffer)

(defun calc-trail-here ()
  (interactive)
  (if (eq major-mode 'calc-trail-mode)
      (progn

		  (set-window-start win (point))
		  (set-window-point win (+ calc-trail-pointer 4))
		  (set-buffer calc-main-buffer)
		  (setq overlay-arrow-string calc-trail-overlay
			overlay-arrow-position calc-trail-pointer))))))
    (error "Not in Calc Trail buffer")))




;;;; The Undo list.

      (if (memq 'undo calc-command-flags)
	  (setq calc-undo-list (cons (cons rec (car calc-undo-list))
				     (cdr calc-undo-list)))
	(setq calc-undo-list (cons (list rec) calc-undo-list)
	      calc-redo-list nil)
	(calc-set-command-flag 'undo))))




;;; Arithmetic commands.

  (if (null arg)
      (calc-enter-result 2 name (cons (or func2 func)
				      (mapcar 'math-check-complete
					      (calc-top-list 2))))
    (calc-extensions)
    (calc-binary-op-fancy name func arg ident unary)))

(defun calc-unary-op (name func arg &optional func2)
  (setq calc-aborted-prefix name)
  (if (null arg)
      (calc-enter-result 1 name (list (or func2 func)
				      (math-check-complete (calc-top 1))))
    (calc-extensions)
    (calc-unary-op-fancy name func arg)))


(defun calc-plus (arg)
  (interactive "P")
  (calc-slow-wrapper
   (calc-binary-op "+" 'calcFunc-add arg 0 nil '+)))

(defun calc-minus (arg)
  (interactive "P")
  (calc-slow-wrapper
   (calc-binary-op "-" 'calcFunc-sub arg 0 'neg '-)))

(defun calc-times (arg)
  (interactive "P")
  (calc-slow-wrapper
   (calc-binary-op "*" 'calcFunc-mul arg 1 nil '*)))

(defun calc-divide (arg)
  (interactive "P")
  (calc-slow-wrapper
   (calc-binary-op "/" 'calcFunc-div arg 0 'calcFunc-inv '/)))


(defun calc-change-sign (arg)
  (interactive "P")
  (calc-wrapper
   (calc-unary-op "chs" 'neg arg)))



;;; Stack management commands.

   (cond ((< n 0)
	  (calc-push-list (calc-top-list 1 (- n))))
	 ((= n 0)
	  (calc-push-list (calc-top-list (calc-stack-size))))
	 (t
	  (calc-push-list (calc-top-list n))))))


(defun calc-pop (n)
  (interactive "P")
  (calc-wrapper

	   (t
	    (if (and calc-any-selections
		     (= nn 1)
		     (calc-top-selected 1 1))
		(calc-delete-selection 1)
	      (calc-pop-stack nn)))))))




;;;; Reading a number using the minibuffer.

	     (calc-push-list (list (calc-record (calc-normalize
						 calc-digit-value))))))
       (if (eq calc-prev-char 'dots)
	   (progn
	     (calc-extensions)
	     (calc-dots)))))))

(defsubst calc-minibuffer-size ()
  (- (point-max) (minibuffer-prompt-end)))

(defun calcDigit-nondigit ()

	(progn (setq prefix-arg current-prefix-arg)
	       (calc-unread-command (if (and (eq last-command-char 27)
					     (>= last-input-char 128))
					last-input-char
				      nil))))
    (exit-minibuffer)))


(defun calc-minibuffer-contains (rex)
  (save-excursion
    (goto-char (minibuffer-prompt-end))
    (looking-at rex)))

(defun calcDigit-key ()
  (interactive)
  (goto-char (point-max))
  (if (or (and (memq last-command-char '(?+ ?-))

	      (calc-digit-dots))
	  (delete-backward-char 1)
	  (beep)
	  (calc-temp-minibuffer-message " [Bad format]"))))))
  (setq calc-prev-prev-char calc-prev-char
	calc-prev-char last-command-char))


(defun calcDigit-backspace ()
  (interactive)
  (goto-char (point-max))

	 (erase-buffer))
	(t (backward-delete-char 1)))
  (if (= (calc-minibuffer-size) 0)
      (progn
	(setq last-command-char 13)
	(calcDigit-nondigit))))

		       (setq var-EvalRules nil)
		       (math-normalize (cons (car a) args)))
		   (calc-record-why "*Variable is void" (nth 1 err)))))
	      (if (consp (car a))
		  (math-dimension-error)
		(cons (car a) args))))))))



;;; True if A is a floating-point real or complex number.  [P x] [Public]
(defun math-floatp (a)

	((memq (car-safe a) '(cplx polar mod sdev intv))
	 (or (math-floatp (nth 1 a))
	     (math-floatp (nth 2 a))
	     (and (eq (car a) 'intv) (math-floatp (nth 3 a)))))
	((eq (car-safe a) 'date)
	 (math-floatp (nth 1 a)))))



;;; Verify that A is a complete object and return A.  [x x] [Public]
(defun math-check-complete (a)
  (cond ((integerp a) a)
	((eq (car-safe a) 'incomplete)
	 (calc-incomplete-error a))
	((consp a) a)
	(t (error "Invalid data object encountered"))))



;;; Coerce integer A to be a bignum.  [B S]
(defun math-bignum (a)
  (if (>= a 0)
      (cons 'bigpos (math-bignum-big a))
    (cons 'bigneg (math-bignum-big (- a)))))

(defun math-bignum-big (a)   ; [L s]
  (if (= a 0)
      nil
    (cons (% a 1000) (math-bignum-big (/ a 1000)))))


;;; Build a normalized floating-point number.  [F I S]
(defun math-make-float (mant exp)
  (if (eq mant 0)

	     (<= (+ exp (math-numdigs mant) -1) -4000000))
	(signal 'math-underflow nil)
      (if (and (>= exp 3000000)
	       (>= (+ exp (math-numdigs mant) -1) 4000000))
	  (signal 'math-overflow nil)
	(list 'float mant exp)))))

(defun math-div10-bignum (a)   ; [l l]
  (if (cdr a)
      (cons (+ (/ (car a) 10) (* (% (nth 1 a) 10) 100))
	    (math-div10-bignum (cdr a)))
    (list (/ (car a) 10))))

;;; Coerce A to be a float.  [F N; V V] [Public]
(defun math-float (a)
  (cond ((Math-integerp a) (math-make-float a 0))
	((eq (car a) 'frac) (math-div (math-float (nth 1 a)) (nth 2 a)))
	((eq (car a) 'float) a)
	((memq (car a) '(cplx polar vec hms date sdev mod))
	 (cons (car a) (mapcar 'math-float (cdr a))))
	(t (math-float-fancy a))))


(defun math-neg (a)
  (cond ((not (consp a)) (- a))
	((eq (car a) 'bigpos) (cons 'bigneg (cdr a)))
	((eq (car a) 'bigneg) (cons 'bigpos (cdr a)))
	((memq (car a) '(frac float))
	 (list (car a) (Math-integer-neg (nth 1 a)) (nth 2 a)))
	((memq (car a) '(cplx vec hms date calcFunc-idn))
	 (cons (car a) (mapcar 'math-neg (cdr a))))
	(t (math-neg-fancy a))))


;;; Compute the number of decimal digits in integer A.  [S I]
(defun math-numdigs (a)
  (if (consp a)

	  ((>= a 10) 2)
	  ((>= a 1) 1)
	  ((= a 0) 0)
	  ((> a -10) 1)
	  ((> a -100) 2)
	  (t (math-numdigs (- a))))))

;;; Multiply (with truncation toward 0) the integer A by 10^N.  [I i S]
(defun math-scale-int (a n)
  (cond ((= n 0) a)
	((> n 0) (math-scale-left a n))
	(t (math-normalize (math-scale-right a (- n))))))

(defun math-scale-left (a n)   ; [I I S]
  (if (= n 0)
      a
    (if (consp a)

	    (if (or (>= a 10000) (<= a -10000))
		(math-scale-left (math-bignum a) 2)
	      (* a 100))
	  (if (or (>= a 100000) (<= a -100000))
	      (math-scale-left (math-bignum a) 1)
	    (* a 10)))))))

(defun math-scale-left-bignum (a n)
  (if (>= n 3)
      (while (>= (setq a (cons 0 a)
		       n (- n 3)) 3)))
  (if (> n 0)
      (math-mul-bignum-digit a (if (= n 2) 100 10) 0)
    a))

(defun math-scale-right (a n)   ; [i i S]
  (if (= n 0)
      a
    (if (consp a)

			(>= (setq n (- n 3)) 3))))
	(if (= n 2)
	    (/ a 100)
	  (if (= n 1)
	      (/ a 10)
	    a))))))

(defun math-scale-right-bignum (a n)   ; [L L S; l l S]
  (if (>= n 3)
      (setq a (nthcdr (/ n 3) a)
	    n (% n 3)))
  (if (> n 0)
      (cdr (math-mul-bignum-digit a (if (= n 2) 10 100) 0))
    a))

;;; Multiply (with rounding) the integer A by 10^N.   [I i S]
(defun math-scale-rounding (a n)
  (cond ((>= n 0)
	 (math-scale-left a n))

	(t
	 (if (< a 0)
	     (- (math-scale-rounding (- a) n))
	   (if (= n -1)
	       (/ (+ a 5) 10)
	     (/ (+ (math-scale-right a (- -1 n)) 5) 10))))))


;;; Compute the sum of A and B.  [O O O] [Public]
(defun math-add (a b)
  (or

		    (setq b (math-float b)))
		(math-add-float a b)))
	 (and (calc-extensions)
	      (math-add-objects-fancy a b))))
   (and (calc-extensions)
	(math-add-symb-fancy a b))))

(defun math-add-bignum (a b)   ; [L L L; l l l]
  (if a
      (if b
	  (let* ((a (copy-sequence a)) (aa a) (carry nil) sum)

		    (nconc a '(1))))
	      (if b
		  (nconc a b)
		a)))
	a)
    b))

(defun math-sub-bignum (a b)   ; [l l l]
  (if b
      (if a
	  (let* ((a (copy-sequence a)) (aa a) (borrow nil) sum)

		a)))
	(while (eq (car b) 0)
	  (setq b (cdr b)))
	(and b
	     'neg))
    a))

(defun math-add-float (a b)   ; [F F F]
  (let ((ediff (- (nth 2 a) (nth 2 b))))
    (if (>= ediff 0)
	(if (>= ediff (+ calc-internal-prec calc-internal-prec))

      (if (>= (setq ediff (- ediff))
	      (+ calc-internal-prec calc-internal-prec))
	  b
	(math-make-float (math-add (nth 1 a)
				   (math-scale-left (nth 1 b) ediff))
			 (nth 2 a))))))

;;; Compute the difference of A and B.  [O O O] [Public]
(defun math-sub (a b)
  (if (or (consp a) (consp b))
      (math-add a (math-neg b))
    (setq a (- a b))
    (if (or (<= a -1000000) (>= a 1000000))
	(math-bignum a)
      a)))

(defun math-sub-float (a b)   ; [F F F]
  (let ((ediff (- (nth 2 a) (nth 2 b))))
    (if (>= ediff 0)
	(if (>= ediff (+ calc-internal-prec calc-internal-prec))

	      (+ calc-internal-prec calc-internal-prec))
	  b
	(math-make-float (math-add (nth 1 a)
				   (Math-integer-neg
				    (math-scale-left (nth 1 b) ediff)))
			 (nth 2 a))))))


;;; Compute the product of A and B.  [O O O] [Public]
(defun math-mul (a b)
  (or

		(math-make-float (math-mul (nth 1 a) (nth 1 b))
				 (+ (nth 2 a) (nth 2 b)))))
	 (and (calc-extensions)
	      (math-mul-objects-fancy a b))))
   (and (calc-extensions)
	(math-mul-symb-fancy a b))))

(defun math-infinitep (a &optional undir)
  (while (and (consp a) (memq (car a) '(* / neg)))
    (if (or (not (eq (car a) '*)) (math-infinitep (nth 1 a)))
	(setq a (nth 1 a))

  (and (consp a)
       (eq (car a) 'var)
       (memq (nth 2 a) '(var-inf var-uinf var-nan))
       (if (and undir (eq (nth 2 a) 'var-inf))
	   '(var uinf var-uinf)
	 a)))

;;; Multiply digit lists A and B.  [L L L; l l l]
(defun math-mul-bignum (a b)
  (and a b
       (let* ((sum (if (<= (car b) 1)

		   ss (or (cdr ss) (setcdr ss (list 0)))))
	   (if (>= prod 1000)
	       (if (cdr ss)
		   (setcar (cdr ss) (+ (/ prod 1000) (car (cdr ss))))
		 (setcdr ss (list (/ prod 1000))))))
	 sum)))

;;; Multiply digit list A by digit D.  [L L D D; l l D D]
(defun math-mul-bignum-digit (a d c)
  (if a
      (if (<= d 1)

		  c (/ prod 1000)))
	  (if (>= prod 1000)
	      (setcdr aa (list (/ prod 1000))))
	  a))
    (and (> c 0)
	 (list c))))


;;; Compute the integer (quotient . remainder) of A and B, which may be
;;; small or big integers.  Type and consistency of truncation is undefined
;;; if A or B is negative.  B must be nonzero.  [I.I I I] [Public]

	(let ((res (math-div-bignum (cdr a) (cdr b))))
	  (cons
	   (math-normalize (cons (if (eq (car a) (car b)) 'bigpos 'bigneg)
				 (car res)))
	   (math-normalize (cons (car a) (cdr res))))))
    (cons (/ a b) (% a b))))

(defun math-quotient (a b)   ; [I I I] [Public]
  (if (and (not (consp a)) (not (consp b)))
      (if (= b 0)
	  (math-reject-arg a "*Division by zero")

	     (d (/ 1000 (1+ (nth (1- blen) (cdr b)))))
	     (res (math-div-bignum-big (math-mul-bignum-digit (cdr a) d 0)
				       (math-mul-bignum-digit (cdr b) d 0)
				       alen blen)))
	(math-normalize (cons (if (eq (car a) (car b)) 'bigpos 'bigneg)
			      (car res)))))))


;;; Divide a bignum digit list by another.  [l.l l L]
;;; The following division algorithm is borrowed from Knuth vol. II, sec. 4.3.1
(defun math-div-bignum (a b)

	(if (= d 1)
	    res
	  (cons (car res)
		(car (math-div-bignum-digit (cdr res) d)))))
    (let ((res (math-div-bignum-digit a (car b))))
      (cons (car res) (list (cdr res))))))

;;; Divide a bignum digit list by a digit.  [l.D l D]
(defun math-div-bignum-digit (a b)
  (if a
      (let* ((res (math-div-bignum-digit (cdr a) b))
	     (num (+ (* (cdr res) 1000) (car a))))
	(cons
	 (cons (/ num b) (car res))
	 (% num b)))
    '(nil . 0)))

(defun math-div-bignum-big (a b alen blen)   ; [l.l l L]
  (if (< alen blen)
      (cons nil a)
    (let* ((res (math-div-bignum-big (cdr a) b (1- alen) blen))
	   (num (cons (car a) (cdr res)))
	   (res2 (math-div-bignum-part num b blen)))
      (cons
       (cons (car res2) (car res))
       (cdr res2)))))

(defun math-div-bignum-part (a b blen)   ; a < b*1000  [D.l l L]
  (let* ((num (+ (* (or (nth blen a) 0) 1000) (or (nth (1- blen) a) 0)))
	 (den (nth (1- blen) b))
	 (guess (min (/ num den) 999)))
    (math-div-bignum-try a b (math-mul-bignum-digit b guess 0) guess)))

(defun math-div-bignum-try (a b c guess)   ; [D.l l l D]
  (let ((rem (math-sub-bignum a c)))
    (if (eq rem 'neg)
	(math-div-bignum-try a b (math-sub-bignum c b) (1- guess))
      (cons guess rem))))


;;; Compute the quotient of A and B.  [O O N] [Public]
(defun math-div (a b)
  (or

		    (setq b (math-float b)))
		(math-div-float a b)))
	 (and (calc-extensions)
	      (math-div-objects-fancy a b))))
   (and (calc-extensions)
	(math-div-symb-fancy a b))))

(defun math-div-float (a b)   ; [F F F]
  (let ((ldiff (max (- (1+ calc-internal-prec)
		       (- (math-numdigs (nth 1 a)) (math-numdigs (nth 1 b))))
		    0)))
    (math-make-float (math-quotient (math-scale-int (nth 1 a) ldiff) (nth 1 b))
		     (- (- (nth 2 a) (nth 2 b)) ldiff))))

      (if calc-line-numbering
	  (progn
	    (aset s 0 ?1)
	    (aset s 1 ?:))))
    (setcar (cdr entry) (calc-count-lines s))
    s))

(defun math-stack-value-offset (c)
  (let* ((num (if calc-line-numbering 4 0))
	 (wid (calc-window-width))
	 off)

	  (math-stack-value-offset-fancy))
      (setq off (or calc-display-origin 0))
      (if (integerp calc-line-breaking)
	  (setq wid calc-line-breaking)))
    (cons (max (- off (length calc-left-label)) 0)
	  (+ wid num))))

(defun calc-count-lines (s)
  (let ((pos 0)
	(num 1))
    (while (setq newpos (string-match "\n" s pos))
      (setq pos (1+ newpos)
	    num (1+ num)))
    num))

(defun math-format-value (a &optional w)
  (if (and (Math-scalarp a)
	   (memq calc-language '(nil flat unform)))
      (math-format-number a)
    (calc-extensions)
    (let ((calc-line-breaking nil))
      (math-composition-to-string (math-compose-expr a 0) w))))

(defun calc-window-width ()
  (if calc-embedded-info
      (let ((win (get-buffer-window (aref calc-embedded-info 0))))
	(1- (if win (window-width win) (frame-width))))
    (- (window-width (get-buffer-window (current-buffer)))
       (if calc-line-numbering 5 1))))

(defun math-comp-concat (c1 c2)
  (if (and (stringp c1) (stringp c2))
      (concat c1 c2)
    (list 'horiz c1 c2)))



;;; Format an expression as a one-line string suitable for re-reading.

	  (calc-hms-format "%s@ %s' %s\"")
	  (calc-language nil))
      (math-format-number a)))
   (t
    (calc-extensions)
    (math-format-flat-expr-fancy a prec))))



;;; Format a number as a string.
(defun math-format-number (a &optional prec)   ; [X N]   [Public]

				    "%se%d")
				  str (- eadj scale)))))))
	str)))
   (t
    (calc-extensions)
    (math-format-number-fancy a prec))))

(defun math-format-bignum (a)   ; [X L]
  (if (and (= calc-number-radix 10)
	   (not calc-leading-zeros)
	   (not calc-group-digits))
      (math-format-bignum-decimal a)
    (calc-extensions)
    (math-format-bignum-fancy a)))

(defun math-format-bignum-decimal (a)   ; [X L]
  (if a
      (let ((s ""))
	(while (cdr (cdr a))
	  (setq s (concat (format "%06d" (+ (* (nth 1 a) 1000) (car a))) s)
		a (cdr (cdr a))))
	(concat (int-to-string (+ (* (or (nth 1 a) 0) 1000) (car a))) s))
    "0"))



;;; Parse a simple number in string form.   [N X] [Public]
(defun math-read-number (s)

	 (and mant exp (Math-realp mant) (> exp -4000000) (< exp 4000000)
	      (let ((mant (math-float mant)))
		(list 'float (nth 1 mant) (+ (nth 2 mant) exp)))))))

    ;; Syntax error!
    (t nil))))

(defun math-match-substring (s n)
  (if (match-beginning n)
      (substring s (match-beginning n) (match-end n))
    ""))

(defun math-read-bignum (s)   ; [l X]
  (if (> (length s) 3)
      (cons (string-to-int (substring s -3))
	    (math-read-bignum (substring s 0 -3)))
    (list (string-to-int s))))


(defconst math-tex-ignore-words
  '( ("\\hbox") ("\\mbox") ("\\text") ("\\left") ("\\right")
     ("\\,") ("\\>") ("\\:") ("\\;") ("\\!") ("\\ ")

;;;###autoload
(defun calc-grab-region (top bot arg)
  "Parse the region as a vector of numbers and push it on the Calculator stack."
  (interactive "r\nP")
  (calc-extensions)
  (calc-do-grab-region top bot arg))

;;;###autoload
(defun calc-grab-rectangle (top bot arg)
  "Parse a rectangle as a matrix of numbers and push it on the Calculator stack."
  (interactive "r\nP")
  (calc-extensions)
  (calc-do-grab-rectangle top bot arg))

(defun calc-grab-sum-down (top bot arg)
  "Parse a rectangle as a matrix of numbers and sum its columns."
  (interactive "r\nP")
  (calc-extensions)
  (calc-do-grab-rectangle top bot arg 'calcFunc-reduced))

(defun calc-grab-sum-across (top bot arg)
  "Parse a rectangle as a matrix of numbers and sum its rows."
  (interactive "r\nP")
  (calc-extensions)
  (calc-do-grab-rectangle top bot arg 'calcFunc-reducea))


;;;###autoload
(defun calc-embedded (arg &optional end obeg oend)
  "Start Calc Embedded mode on the formula surrounding point."
  (interactive "P")
  (calc-extensions)
  (calc-do-embedded arg end obeg oend))

;;;###autoload
(defun calc-embedded-activate (&optional arg cbuf)
  "Scan the current editing buffer for all embedded := and => formulas.
Also looks for the equivalent TeX words, \\gets and \\evalto."
  (interactive "P")
  (calc-do-embedded-activate arg cbuf))


(defun calc-user-invocation ()
  (interactive)
  (or (stringp calc-invocation-macro)
      (error "Use `Z I' inside Calc to define a `M-# Z' keyboard macro"))
  (execute-kbd-macro calc-invocation-macro nil))




;;; User-programmability.

;;;###autoload
(defmacro defmath (func args &rest body)   ;  [Public]
  (calc-extensions)
  (math-do-defmath func args body))


;;; Functions needed for Lucid Emacs support.

(defun calc-read-key (&optional optkey)

	(calc-emacs-type-gnu19
	 (let ((key (read-event)))
	   (cons key key)))
	(t
	 (let ((key (read-char)))
	   (cons key key)))))

(defun calc-unread-command (&optional input)
  (if (featurep 'xemacs)
      (setq unread-command-event
	    (if (integerp input) (character-to-event input)

    (setq unread-command-events nil)))

(if calc-always-load-extensions
    (progn
      (calc-extensions)
      (calc-load-everything)))


(run-hooks 'calc-load-hook)

;;; calc.el ends here