EDIT (10 de fevereiro de 2014): adicionada uma nova função (por exemplo, lawlist-calculator-update-display ), que modifica a função calculator-update-display . Cada vez que o display é atualizado durante uma série de cálculos (por exemplo, cada subtotal, antes de atingir o total), o display agora espelha o total final - ou seja, com os separadores de vírgulas, removendo zeros extras indesejados e arredondando para a quarta casa decimal . Adicionado (message "Copied % to the kill-ring." s) a lawlist-calculator-copy .
O seguinte código modificado é inicialmente arredondado na tela para 4 dígitos à direita do ponto decimal; com separadores por vírgula a cada 3 dígitos à esquerda do ponto decimal; e remove quaisquer zeros extra indesejados à direita do ponto decimal.
Usando a função lawlist-calculator-copy copiará no kill-ring o resultado - arredondado para 2 dígitos à direita do ponto decimal, e incluirá separadores de vírgula a cada 3 dígitos à esquerda do ponto decimal.
Aqui está um link para um artigo sobre arredondamento: link
A conversão numérica que eu prefiro é arredondada para 5 - por exemplo, 1,555 será arredondada para 1,56 - a função number-conversion escrita por @ abo-abo realiza essa meta. Considerando que, (format "%0.2f" 1.555) seria arredondado para 1.55 e provavelmente não deveria ser usado quando se lida com dinheiro nos EUA ( na minha opinião ).
(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))