andros/emacs-gpu
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

(calculator-radix-grouping-mode)

Browse source 
(calculator-radix-grouping-digits)
(calculator-radix-grouping-separator):
New defcustoms for the new radix grouping mode functionality.
(calculator-mode-hook): Now used in electric mode too.
(calculator-mode-map): Some new keys.
(calculator-message): New function.  Some new calls.
(calculator-string-to-number): New function,
(calculator-curnum-value): Use it.
(calculator-rotate-displayer, calculator-rotate-displayer-back)
(calculator-displayer-prev, calculator-displayer-next):
Change digit group size when in radix mode.
(calculator-number-to-string): Renamed from calculator-num-to-string.
Now deals with digit grouping in radix mode.
This commit is contained in:
Richard M. Stallman 2004-12-21 11:38:36 +00:00
parent b6e8e8e55d
commit 761d3eb391
1 changed files with 144 additions and 76 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

220
lisp/calculator.el
View file

@ -4,6 +4,7 @@
;; Author: Eli Barzilay <eli@barzilay.org>
;; Keywords: tools, convenience
;; Time-stamp: <2002-07-13 01:14:35 eli>
;; This file is part of GNU Emacs.
@ -100,6 +101,20 @@ at runtime."
:type 'integer
:group 'calculator)
(defcustom calculator-radix-grouping-mode t
"*Use digit grouping in radix output mode.
If this is set, chunks of `calculator-radix-grouping-digits' characters
will be separated by `calculator-radix-grouping-separator' when in radix
output mode is active (determined by `calculator-output-radix').")
(defcustom calculator-radix-grouping-digits 4
"*The number of digits used for grouping display in radix modes.
See `calculator-radix-grouping-mode'.")
(defcustom calculator-radix-grouping-separator "'"
"*The separator used in radix grouping display.
See `calculator-radix-grouping-mode'.")
(defcustom calculator-remove-zeros t
"*Non-nil value means delete all redundant zero decimal digits.
If this value is not t, and not nil, redundant zeros are removed except
@ -163,7 +178,11 @@ Otherwise show as a negative number."
:group 'calculator)
(defcustom calculator-mode-hook nil
"*List of hook functions for `calculator-mode' to run."
"*List of hook functions for `calculator-mode' to run.
Note: if `calculator-electric-mode' is on, then this hook will get
activated in the minibuffer - in that case it should not do much more
than local key settings and other effects that will change things
outside the scope of calculator related code."
:type 'hook
:group 'calculator)
@ -387,7 +406,7 @@ Used for repeating operations in calculator-repR/L.")
"oD" "oH" "oX" "oO" "oB")
(calculator-rotate-displayer "'")
(calculator-rotate-displayer-back "\"")
(calculator-displayer-pref "{")
(calculator-displayer-prev "{")
(calculator-displayer-next "}")
(calculator-saved-up [up] [?\C-p])
(calculator-saved-down [down] [?\C-n])
@ -399,10 +418,10 @@ Used for repeating operations in calculator-repR/L.")
(calculator-save-and-quit [(control return)]
[(control kp-enter)])
(calculator-paste [insert] [(shift insert)]
[mouse-2])
[paste] [mouse-2] [?\C-y])
(calculator-clear [delete] [?\C-?] [?\C-d])
(calculator-help [?h] [??] [f1] [help])
(calculator-copy [(control insert)])
(calculator-copy [(control insert)] [copy])
(calculator-backspace [backspace])
)))
(while p
@ -536,7 +555,7 @@ Used for repeating operations in calculator-repR/L.")
,@(mapcar (lambda (x) (nth 1 x)) radix-selectors)
"---"
,@(mapcar (lambda (x) (nth 2 x)) radix-selectors)))
("Decimal Dislpay"
("Decimal Display"
,@(mapcar (lambda (d)
(vector (cadr d)
;; Note: inserts actual object here
@ -611,10 +630,11 @@ The prompt indicates the current modes:
* \"=?\": (? is B/O/H) the display radix (when input is decimal);
* \"??\": (? is D/B/O/H) 1st char for input radix, 2nd for display.
Also, the quote character can be used to switch display modes for
decimal numbers (double-quote rotates back), and the two brace
characters (\"{\" and \"}\" change display parameters that these
displayers use (if they handle such).
Also, the quote key can be used to switch display modes for decimal
numbers (double-quote rotates back), and the two brace characters
\(\"{\" and \"}\" change display parameters that these displayers use (if
they handle such). If output is using any radix mode, then these keys
toggle digit grouping mode and the chunk size.
Values can be saved for future reference in either a list of saved
values, or in registers.
@ -683,6 +703,7 @@ See the documentation for `calculator-mode' for more information."
(setq calculator-saved-global-map (current-global-map))
(use-local-map nil)
(use-global-map calculator-mode-map)
(run-hooks 'calculator-mode-hook)
(unwind-protect
(catch 'calculator-done
(Electric-command-loop
@ -717,6 +738,12 @@ See the documentation for `calculator-mode' for more information."
(if (and calculator-restart-other-mode calculator-electric-mode)
(calculator)))
(defun calculator-message (string &rest arguments)
"Same as `message', but special handle of electric mode."
(apply 'message string arguments)
(if calculator-electric-mode
(progn (sit-for 1) (message nil))))
;;;---------------------------------------------------------------------
;;; Operators
@ -818,82 +845,116 @@ The string is set not to exceed the screen width."
(concat calculator-prompt
(substring prompt (+ trim (length calculator-prompt)))))))
(defun calculator-curnum-value ()
"Get the numeric value of the displayed number string as a float."
(defun calculator-string-to-number (str)
"Convert the given STR to a number, according to the value of
`calculator-input-radix'."
(if calculator-input-radix
(let ((radix
(cdr (assq calculator-input-radix
'((bin . 2) (oct . 8) (hex . 16)))))
(i -1) (value 0))
;; assume valid input (upcased & characters in range)
(while (< (setq i (1+ i)) (length calculator-curnum))
(setq value
(+ (let ((ch (aref calculator-curnum i)))
(- ch (if (<= ch ?9) ?0 (- ?A 10))))
(* radix value))))
(i -1) (value 0) (new-value 0))
;; assume mostly valid input (e.g., characters in range)
(while (< (setq i (1+ i)) (length str))
(setq new-value
(let* ((ch (upcase (aref str i)))
(n (cond ((< ch ?0) nil)
((<= ch ?9) (- ch ?0))
((< ch ?A) nil)
((<= ch ?Z) (- ch (- ?A 10)))
(t nil))))
(if (and n (<= 0 n) (< n radix))
(+ n (* radix value))
(progn
(calculator-message
"Warning: Ignoring bad input character `%c'." ch)
(sit-for 1)
value))))
(if (if (< new-value 0) (> value 0) (< value 0))
(calculator-message "Warning: Overflow in input."))
(setq value new-value))
value)
(car
(read-from-string
(cond
((equal "." calculator-curnum)
"0.0")
((string-match "[eE][+-]?$" calculator-curnum)
(concat calculator-curnum "0"))
((string-match "\\.[0-9]\\|[eE]" calculator-curnum)
calculator-curnum)
((string-match "\\." calculator-curnum)
;; do this because Emacs reads "23." as an integer
(concat calculator-curnum "0"))
((stringp calculator-curnum)
(concat calculator-curnum ".0"))
(t "0.0"))))))
(car (read-from-string
(cond ((equal "." str) "0.0")
((string-match "[eE][+-]?$" str) (concat str "0"))
((string-match "\\.[0-9]\\|[eE]" str) str)
((string-match "\\." str)
;; do this because Emacs reads "23." as an integer
(concat str "0"))
((stringp str) (concat str ".0"))
(t "0.0"))))))
(defun calculator-curnum-value ()
"Get the numeric value of the displayed number string as a float."
(calculator-string-to-number calculator-curnum))
(defun calculator-rotate-displayer (&optional new-disp)
"Switch to the next displayer on the `calculator-displayers' list.
Can be called with an optional argument NEW-DISP to force rotation to
that argument."
that argument.
If radix output mode is active, toggle digit grouping."
(interactive)
(setq calculator-displayers
(if (and new-disp (memq new-disp calculator-displayers))
(let ((tmp nil))
(while (not (eq (car calculator-displayers) new-disp))
(setq tmp (cons (car calculator-displayers) tmp))
(setq calculator-displayers (cdr calculator-displayers)))
(setq calculator-displayers
(nconc calculator-displayers (nreverse tmp))))
(nconc (cdr calculator-displayers)
(list (car calculator-displayers)))))
(message "Using %s." (cadr (car calculator-displayers)))
(if calculator-electric-mode
(progn (sit-for 1) (message nil)))
(cond
(calculator-output-radix
(setq calculator-radix-grouping-mode
(not calculator-radix-grouping-mode))
(calculator-message
"Digit grouping mode %s."
(if calculator-radix-grouping-mode "ON" "OFF")))
(t
(setq calculator-displayers
(if (and new-disp (memq new-disp calculator-displayers))
(let ((tmp nil))
(while (not (eq (car calculator-displayers) new-disp))
(setq tmp (cons (car calculator-displayers) tmp))
(setq calculator-displayers
(cdr calculator-displayers)))
(setq calculator-displayers
(nconc calculator-displayers (nreverse tmp))))
(nconc (cdr calculator-displayers)
(list (car calculator-displayers)))))
(calculator-message
"Using %s." (cadr (car calculator-displayers)))))
(calculator-enter))
(defun calculator-rotate-displayer-back ()
"Like `calculator-rotate-displayer', but rotates modes back."
"Like `calculator-rotate-displayer', but rotates modes back.
If radix output mode is active, toggle digit grouping."
(interactive)
(calculator-rotate-displayer (car (last calculator-displayers))))
(defun calculator-displayer-prev ()
"Send the current displayer function a 'left argument.
This is used to modify display arguments (if the current displayer
function supports this)."
function supports this).
If radix output mode is active, increase the grouping size."
(interactive)
(and (car calculator-displayers)
(let ((disp (caar calculator-displayers)))
(cond ((symbolp disp) (funcall disp 'left))
((and (consp disp) (eq 'std (car disp)))
(calculator-standard-displayer 'left (cadr disp)))))))
(if calculator-output-radix
(progn (setq calculator-radix-grouping-digits
(1+ calculator-radix-grouping-digits))
(calculator-enter))
(and (car calculator-displayers)
(let ((disp (caar calculator-displayers)))
(cond
((symbolp disp) (funcall disp 'left))
((and (consp disp) (eq 'std (car disp)))
(calculator-standard-displayer 'left (cadr disp))))))))
(defun calculator-displayer-next ()
"Send the current displayer function a 'right argument.
This is used to modify display arguments (if the current displayer
function supports this)."
function supports this).
If radix output mode is active, decrease the grouping size."
(interactive)
(and (car calculator-displayers)
(let ((disp (caar calculator-displayers)))
(cond ((symbolp disp) (funcall disp 'right))
((and (consp disp) (eq 'std (car disp)))
(calculator-standard-displayer 'right (cadr disp)))))))
(if calculator-output-radix
(progn (setq calculator-radix-grouping-digits
(max 2 (1- calculator-radix-grouping-digits)))
(calculator-enter))
(and (car calculator-displayers)
(let ((disp (caar calculator-displayers)))
(cond
((symbolp disp) (funcall disp 'right))
((and (consp disp) (eq 'std (car disp)))
(calculator-standard-displayer 'right (cadr disp))))))))
(defun calculator-remove-zeros (numstr)
"Get a number string NUMSTR and remove unnecessary zeroes.
@ -995,7 +1056,7 @@ the 'left or 'right when one of the standard modes is used."
(calculator-remove-zeros str))
"e" (number-to-string exp))))))
(defun calculator-num-to-string (num)
(defun calculator-number-to-string (num)
"Convert NUM to a displayable string."
(cond
((and (numberp num) calculator-output-radix)
@ -1015,6 +1076,14 @@ the 'left or 'right when one of the standard modes is used."
(?6 . "110") (?7 . "111")))))))
(string-match "^0*\\(.+\\)" s)
(setq str (match-string 1 s))))
(if calculator-radix-grouping-mode
(let ((d (/ (length str) calculator-radix-grouping-digits))
(r (% (length str) calculator-radix-grouping-digits)))
(while (>= (setq d (1- d)) (if (zerop r) 1 0))
(let ((i (+ r (* d calculator-radix-grouping-digits))))
(setq str (concat (substring str 0 i)
calculator-radix-grouping-separator
(substring str i)))))))
(upcase
(if (and (not calculator-2s-complement) (< num 0))
(concat "-" str)
@ -1051,7 +1120,7 @@ If optional argument FORCE is non-nil, don't use the cached string."
;; customizable display for a single value
(caar calculator-displayers)
calculator-displayer)))
(mapconcat 'calculator-num-to-string
(mapconcat 'calculator-number-to-string
(reverse calculator-stack)
" "))
" "
@ -1319,9 +1388,8 @@ Optional string argument KEYS will force using it as the keys entered."
(if (not (and op (= -1 (calculator-op-arity op))))
;;(error "Binary operator without a first operand")
(progn
(message "Binary operator without a first operand")
(if calculator-electric-mode
(progn (sit-for 1) (message nil)))
(calculator-message
"Binary operator without a first operand")
(throw 'op-error nil)))))
(calculator-reduce-stack
(cond ((eq (nth 1 op) '\() 10)
@ -1334,9 +1402,7 @@ Optional string argument KEYS will force using it as the keys entered."
(not (numberp (car calculator-stack)))))
;;(error "Unterminated expression")
(progn
(message "Unterminated expression")
(if calculator-electric-mode
(progn (sit-for 1) (message nil)))
(calculator-message "Unterminated expression")
(throw 'op-error nil)))
(setq calculator-stack (cons op calculator-stack))
(calculator-reduce-stack (calculator-op-prec op))
@ -1540,7 +1606,7 @@ Optional string argument KEYS will force using it as the keys entered."
(setcdr as val)
(setq calculator-registers
(cons (cons reg val) calculator-registers)))
(message (format "[%c] := %S" reg val))))
(calculator-message "[%c] := %S" reg val)))
(defun calculator-put-value (val)
"Paste VAL as if entered.
@ -1552,24 +1618,26 @@ Used by `calculator-paste' and `get-register'."
(progn
(calculator-clear-fragile)
(setq calculator-curnum (let ((calculator-displayer "%S"))
(calculator-num-to-string val)))
(calculator-number-to-string val)))
(calculator-update-display))))
(defun calculator-paste ()
"Paste a value from the `kill-ring'."
(interactive)
(calculator-put-value
(let ((str (current-kill 0)))
(and calculator-paste-decimals
(let ((str (replace-regexp-in-string
"^ *\\(.+[^ ]\\) *$" "\\1" (current-kill 0))))
(and (not calculator-input-radix)
calculator-paste-decimals
(string-match "\\([0-9]+\\)\\(\\.[0-9]+\\)?\\(e[0-9]+\\)?"
str)
(or (match-string 1 str)
(match-string 2 str)
(match-string 3 str))
(setq str (concat (match-string 1 str)
(setq str (concat (or (match-string 1 str) "0")
(or (match-string 2 str) ".0")
(match-string 3 str))))
(condition-case nil (car (read-from-string str))
(or (match-string 3 str) ""))))
(condition-case nil (calculator-string-to-number str)
(error nil)))))
(defun calculator-get-register (reg)
@ -1678,7 +1746,7 @@ To use this, apply a binary operator (evaluate it), then call this."
(while (> x 0)
(setq r (* r (truncate x)))
(setq x (1- x)))
r))
(+ 0.0 r)))
(defun calculator-truncate (n)
"Truncate N, return 0 in case of overflow."