EDIT (February 10, 2014): Added a new function (i.e., lawlist-calculator-update-display
), which modifies the function calculator-update-display
. Each time the display updates during a series of calculations (e.g., each subtotal, prior to reaching the total), the display now mirrors the final total -- i.e., with comma separators, removing unwanted extra zeros, and rounding to the fourth decimal place. Added (message "Copied
%sto the kill-ring." s)
to lawlist-calculator-copy
.
The following modified code initially rounds on screen to 4 digits to the right of the decimal point; with comma separators every 3 digits to the left of the decimal point; and, removes any unwanted extra zeros to the right of the decimal point.
Using the function lawlist-calculator-copy
will copy into the kill-ring the result -- rounded to 2 digits to the right of the decimal point, and include comma separators every 3 digits to the left of the decimal point.
Here is a link to an article on rounding: http://www.mathsisfun.com/rounding-numbers.html
The number conversion that I prefer rounds up at 5 -- e.g., 1.555 will round up to 1.56 -- the function number-conversion
written by @abo-abo accomplishes this goal. Whereas, (format "%0.2f" 1.555)
would round down to 1.55 and should probably not be used when dealing with money in the U.S. (in my opinion).
(require 'calculator)
(setq calculator-prompt "Calculator: %s")
(setq calculator-number-digits 4)
(defalias 'calculator-get-prompt 'lawlist-calculator-get-prompt)
(defun lawlist-calculator-get-prompt ()
"Return a string to display.
The string is set not to exceed the screen width."
(let* ((calculator-prompt
(format calculator-prompt
(cond
((or calculator-output-radix calculator-input-radix)
(if (eq calculator-output-radix
calculator-input-radix)
(concat
(char-to-string
(car (rassq calculator-output-radix
calculator-char-radix)))
"=")
(concat
(if calculator-input-radix
(char-to-string
(car (rassq calculator-input-radix
calculator-char-radix)))
"=")
(char-to-string
(car (rassq calculator-output-radix
calculator-char-radix))))))
(calculator-deg "D=")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; REMOVE ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; (t "=="))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; REPLACE WITH ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(t ""))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(prompt
(concat calculator-prompt
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; REMOVE ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; (cdr calculator-stack-display)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; REPLACE WITH ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(if (floatp (car calculator-stack))
(group-number
(calculator-remove-zeros
;; round to 4 decimal points
;; The function number conversion will be used when copying.
(format "%.4f" (car calculator-stack))))
(cdr calculator-stack-display))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(cond (calculator-curnum
;; number being typed
(concat calculator-curnum "_"))
((and (= 1 (length calculator-stack))
calculator-display-fragile)
;; only the result is shown, next number will
;; restart
nil)
(t
;; waiting for a number or an operator
"?"))))
(trim (- (length prompt) (1- (window-width)))))
(if (<= trim 0)
prompt
(concat calculator-prompt
(substring prompt (+ trim (length calculator-prompt)))))))
(defalias 'calculator-update-display 'lawlist-calculator-update-display)
(defun lawlist-calculator-update-display (&optional force)
"Update the display.
If optional argument FORCE is non-nil, don't use the cached string."
(set-buffer calculator-buffer)
;; update calculator-stack-display
(if (or force
(not (eq (car calculator-stack-display) calculator-stack)))
(setq calculator-stack-display
(cons calculator-stack
(if calculator-stack
(concat
(let ((calculator-displayer
(if (and calculator-displayers
(= 1 (length calculator-stack)))
;; customizable display for a single value
(caar calculator-displayers)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; REMOVE ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; calculator-displayer
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; REPLACE WITH ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(calculator-remove-zeros
(group-number
(format "%.4f"
(string-to-number
(calculator-number-to-string calculator-stack)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
)))
(mapconcat 'calculator-number-to-string
(reverse calculator-stack)
" " ))
" "
(and calculator-display-fragile
calculator-saved-list
(= (car calculator-stack)
(nth calculator-saved-ptr
calculator-saved-list))
(if (= 0 calculator-saved-ptr)
(format "[%s]" (length calculator-saved-list))
(format "[%s/%s]"
(- (length calculator-saved-list)
calculator-saved-ptr)
(length calculator-saved-list)))))
""))))
(let ((inhibit-read-only t))
(erase-buffer)
(insert (calculator-get-prompt)))
(set-buffer-modified-p nil)
(if calculator-display-fragile
(goto-char (1+ (length calculator-prompt)))
(goto-char (1- (point)))))
(defun lawlist-calculator-copy ()
"Copy current number to the `kill-ring'."
(interactive)
(let ((calculator-displayer
(or calculator-copy-displayer calculator-displayer))
(calculator-displayers
(if calculator-copy-displayer nil calculator-displayers)))
(calculator-enter)
;; remove trailing spaces and an index
(let (
(s
(if (floatp (car calculator-stack))
(group-number
(number-conversion
(format "%s" (car calculator-stack))))
(cdr calculator-stack-display))) )
(and s
(if (string-match "^\\([^ ]+\\) *\\(\\[[0-9/]+\\]\\)? *$" s)
(setq s (match-string 1 s)))
(kill-new s)
(message "Copied `%s` to the kill-ring." s)))))
;; http://stackoverflow.com/a/20101269/2112489
;; @abo-abo
(defun number-conversion (str)
(let ((x (read str)))
(format "%0.2f" (* 0.01 (round (* 100 x)))) ))
;; http://www.emacswiki.org/emacs/ElispCookbook#toc23
(defun group-number (num &optional size char)
"Format NUM as string grouped to SIZE with CHAR."
;; Based on code for `math-group-float' in calc-ext.el
(let* ((size (or size 3))
(char (or char ","))
(str (if (stringp num)
num
(number-to-string num)))
(pt (or (string-match "[^0-9a-zA-Z]" str) (length str))))
(while (> pt size)
(setq str (concat (substring str 0 (- pt size))
char
(substring str (- pt size)))
pt (- pt size)))
str))