РЕДАКТИРОВАТЬ (10 февраля 2014 г.): добавлена новая функция (т.е. lawlist-calculator-update-display
), которая модифицирует функцию calculator-update-display
. Каждый раз, когда дисплей обновляется во время серии вычислений (например, каждый промежуточный итог до достижения итогового значения), дисплей теперь отображает итоговую итоговую сумму - то есть с разделителями запятых, удаляя ненужные лишние нули и округляя до четвертого десятичного знака. , Добавлено (message "Copied
% s to the kill-ring." s)
lawlist-calculator-copy
.
Следующий измененный код первоначально округляет на экране 4 цифры справа от десятичной точки; с разделителями-запятыми каждые 3 цифры слева от десятичной точки; и удаляет все ненужные лишние нули справа от десятичной точки.
Использование функции lawlist-calculator-copy
скопирует в список уничтожений результат - округленный до 2 цифр справа от десятичной точки и включающий разделители запятых через каждые 3 цифры слева от десятичной точки.
Вот ссылка на статью о округлении: http://www.mathsisfun.com/rounding-numbers.html
Преобразование чисел, которое я предпочитаю, округляется до 5 - например, 1,555 округляется до 1,56 - функция number-conversion
написанная @ abo-abo, достигает этой цели. Принимая во внимание, что (format "%0.2f" 1.555)
до 1.55 и, вероятно, не должен использоваться при работе с деньгами в США (на мой взгляд).
(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))