Function: calc-do

calc-do is a byte-compiled function defined in calc.el.gz.

Signature

(calc-do DO-BODY &optional DO-SLOW)

Source Code

;; Defined in /usr/src/emacs/lisp/calc/calc.el.gz
;;; Note that modifications to this function may break calc-pass-errors.
(defun calc-do (do-body &optional do-slow)
  (calc-check-defines)
  (let* ((calc-command-flags nil)
	 (calc-start-time (and calc-timing (not calc-start-time)
			       (require 'calc-ext)
			       (current-time-string)))
	 (gc-cons-threshold (max gc-cons-threshold
				 (if calc-timing 2000000 100000)))
	 calc-final-point-line calc-final-point-column)
    (setq calc-aborted-prefix "")
    (unwind-protect
	(condition-case err
	    (save-excursion
	      (if calc-embedded-info
		  (calc-embedded-select-buffer)
		(calc-select-buffer))
	      (and (eq calc-algebraic-mode 'total)
		   (require 'calc-ext)
		   (use-local-map calc-alg-map))
	      (when (and do-slow calc-display-working-message)
		(message "Working...")
		(calc-set-command-flag 'clear-message))
	      (funcall do-body)
	      (setq calc-aborted-prefix nil)
	      (when (memq 'renum-stack calc-command-flags)
		(calc-renumber-stack))
	      (when (memq 'clear-message calc-command-flags)
		(message "")))
	  (error
	   (if (and (eq (car err) 'error)
		    (stringp (nth 1 err))
		    (string-search "max-lisp-eval-depth" (nth 1 err)))
               (error (substitute-command-keys
                       "Computation got stuck or ran too long.  Type \\`M' to increase the limit"))
	     (setq calc-aborted-prefix nil)
	     (signal (car err) (cdr err)))))
      (when calc-aborted-prefix
	(calc-record "<Aborted>" calc-aborted-prefix))
      (and calc-start-time
	   (let* ((calc-internal-prec 12)
		  (calc-date-format nil)
		  (end-time (current-time-string))
		  (time (if (equal calc-start-time end-time)
			    0
			  (math-sub
			   (calcFunc-unixtime (math-parse-date end-time) 0)
			   (calcFunc-unixtime (math-parse-date calc-start-time)
					      0)))))
	     (if (math-lessp 1 time)
		 (calc-record time "(t)"))))
      (or (memq 'no-align calc-command-flags)
	  (derived-mode-p 'calc-trail-mode)
	  (calc-align-stack-window))
      (and (memq 'position-point calc-command-flags)
	   (if (derived-mode-p 'calc-mode)
	       (progn
		 (goto-char (point-min))
		 (forward-line (1- calc-final-point-line))
		 (move-to-column calc-final-point-column))
	     (save-current-buffer
	       (calc-select-buffer)
	       (goto-char (point-min))
	       (forward-line (1- calc-final-point-line))
	       (move-to-column calc-final-point-column))))
      (unless (memq 'keep-flags calc-command-flags)
	(save-excursion
	  (calc-select-buffer)
	  (setq calc-inverse-flag nil
		calc-hyperbolic-flag nil
                calc-option-flag nil
		calc-keep-args-flag nil)))
      (when (memq 'do-edit calc-command-flags)
	(switch-to-buffer (get-buffer-create "*Calc Edit*")))
      (calc-set-mode-line)
      (when calc-embedded-info
	(calc-embedded-finish-command))))
  (identity nil))  ; allow a GC after timing is done