(calculator-radix-grouping-mode)

(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.

1 files changed, 144 insertions, 76 deletions

diff --git a/lisp/calculator.el b/lisp/calculator.el
index a9410ae961c..76ff4053c7f 100644
--- a/lisp/calculator.el
+++ b/lisp/calculator.el
@@ -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."