;; 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.
: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
: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)
"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])
(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
,@(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
* \"=?\": (? 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.
(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
(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
(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.
(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)
(?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)
;; customizable display for a single value
(caar calculator-displayers)
calculator-displayer)))
- (mapconcat 'calculator-num-to-string
+ (mapconcat 'calculator-number-to-string
(reverse calculator-stack)
" "))
" "
(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)
(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))
(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.
(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)
(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."
projects / emacs.git / commitdiff