Function: math-format-number

math-format-number is a byte-compiled function defined in calc.el.gz.

Signature

(math-format-number A &optional PREC)

Source Code

;; Defined in /usr/src/emacs/lisp/calc/calc.el.gz
(defun math-format-number (a &optional prec)   ; [X N]   [Public]
  (cond
   ((eq calc-display-raw t) (format "%s" a))
   ((and calc-twos-complement-mode
         math-radix-explicit-format
         (Math-integerp a)
         (or (eq a 0)
             (and (Math-integer-posp a)
                  (Math-lessp a math-half-2-word-size))
             (and (Math-integer-negp a)
                  (require 'calc-ext)
                  (let ((comparison
                         (math-compare (Math-integer-neg a) math-half-2-word-size)))
                    (or (= comparison 0)
                        (= comparison -1))))))
    (require 'calc-bin)
    (math-format-twos-complement a))
   ((and (nth 1 calc-frac-format) (Math-integerp a))
    (require 'calc-ext)
    (math-format-number (math-adjust-fraction a)))
   ((integerp a)
    (if (not (or calc-group-digits calc-leading-zeros))
	(if (= calc-number-radix 10)
	    (int-to-string a)
	  (if (< a 0)
	      (concat "-" (math-format-number (- a)))
	    (require 'calc-ext)
	    (if math-radix-explicit-format
		(if calc-radix-formatter
		    (funcall calc-radix-formatter
			     calc-number-radix
			     (if (= calc-number-radix 2)
				 (math-format-binary a)
			       (math-format-radix a)))
		  (format "%d#%s" calc-number-radix
			  (if (= calc-number-radix 2)
			      (math-format-binary a)
			    (math-format-radix a))))
	      (math-format-radix a))))
      (require 'calc-ext)
      (declare-function math--format-integer-fancy "calc-ext" (a))
      (concat (if (< a 0) "-") (math--format-integer-fancy (abs a)))))
   ((stringp a) a)
   ((not (consp a)) (prin1-to-string a))
   ((and (eq (car a) 'float) (= calc-number-radix 10))
    (if (Math-integer-negp (nth 1 a))
	(concat "-" (math-format-number (math-neg a)))
      (let ((mant (nth 1 a))
	    (exp (nth 2 a))
	    (fmt (car calc-float-format))
	    (figs (nth 1 calc-float-format))
	    (point calc-point-char)
	    str)
	(if (and (eq fmt 'fix)
		 (or (and (< figs 0) (setq figs (- figs)))
		     (> (+ exp (math-numdigs mant)) (- figs))))
	    (progn
	      (setq mant (math-scale-rounding mant (+ exp figs))
		    str (int-to-string mant))
	      (if (<= (length str) figs)
		  (setq str (concat (make-string (1+ (- figs (length str))) ?0)
				    str)))
	      (if (> figs 0)
		  (setq str (concat (substring str 0 (- figs)) point
				    (substring str (- figs))))
		(setq str (concat str point)))
	      (when calc-group-digits
		(require 'calc-ext)
		(setq str (math-group-float str))))
	  (when (< figs 0)
	    (setq figs (+ calc-internal-prec figs)))
	  (when (> figs 0)
	    (let ((adj (- figs (math-numdigs mant))))
	      (when (< adj 0)
		(setq mant (math-scale-rounding mant adj)
		      exp (- exp adj)))))
	  (setq str (int-to-string mant))
	  (let* ((len (length str))
		 (dpos (+ exp len))
                 (trailing-0 (and calc-digit-after-point "0")))
	    (if (and (eq fmt 'float)
		     (<= dpos (+ calc-internal-prec calc-display-sci-high))
		     (>= dpos (+ calc-display-sci-low 2)))
		(progn
		  (cond
		   ((= dpos 0)
		    (setq str (concat "0" point str)))
		   ((and (<= exp 0) (> dpos 0))
		    (setq str (concat (substring str 0 dpos) point
				      (substring str dpos)
                                      (and (>= dpos len) trailing-0))))
		   ((> exp 0)
		    (setq str (concat str (make-string exp ?0)
                                      point trailing-0)))
		   (t   ; (< dpos 0)
		    (setq str (concat "0" point
				      (make-string (- dpos) ?0) str))))
		  (when calc-group-digits
		    (require 'calc-ext)
		    (setq str (math-group-float str))))
	      (let* ((eadj (+ exp len))
		     (scale (if (eq fmt 'eng)
				(1+ (math-mod (+ eadj 300002) 3))
			      1)))
		(if (> scale (length str))
		    (setq str (concat str (make-string (- scale (length str))
						       ?0))))
		(if (< scale (length str))
		    (setq str (concat (substring str 0 scale) point
				      (substring str scale))))
		(when calc-group-digits
		  (require 'calc-ext)
		  (setq str (math-group-float str)))
		(setq str (format (if (memq calc-language '(math maple))
				      (if (and prec (> prec 191))
					  "(%s*10.^%d)" "%s*10.^%d")
				    "%se%d")
				  str (- eadj scale)))))))
	str)))
   (t
    (require 'calc-ext)
    (math-format-number-fancy a prec))))