[Emacs-diffs] Changes to emacs/lisp/calculator.el

[Richard M . Stallman]

Index: emacs/lisp/calculator.el
diff -c emacs/lisp/calculator.el:1.14 emacs/lisp/calculator.el:1.15
*** emacs/lisp/calculator.el:1.14       Mon Sep  1 15:45:08 2003
--- emacs/lisp/calculator.el    Tue Dec 21 11:38:36 2004
***************
*** 4,9 ****
--- 4,10 ----
  
  ;; Author: Eli Barzilay <address@hidden>
  ;; Keywords: tools, convenience
+ ;; Time-stamp: <2002-07-13 01:14:35 eli>
  
  ;; This file is part of GNU Emacs.
  
***************
*** 100,105 ****
--- 101,120 ----
    :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,169 ****
    :group 'calculator)
  
  (defcustom calculator-mode-hook nil
!   "*List of hook functions for `calculator-mode' to run."
    :type  'hook
    :group 'calculator)
  
--- 178,188 ----
    :group 'calculator)
  
  (defcustom calculator-mode-hook nil
!   "*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,393 ****
                                             "oD" "oH" "oX" "oO" "oB")
               (calculator-rotate-displayer      "'")
               (calculator-rotate-displayer-back "\"")
!              (calculator-displayer-pref        "{")
               (calculator-displayer-next        "}")
               (calculator-saved-up      [up] [?\C-p])
               (calculator-saved-down    [down] [?\C-n])
--- 406,412 ----
                                             "oD" "oH" "oX" "oO" "oB")
               (calculator-rotate-displayer      "'")
               (calculator-rotate-displayer-back "\"")
!              (calculator-displayer-prev        "{")
               (calculator-displayer-next        "}")
               (calculator-saved-up      [up] [?\C-p])
               (calculator-saved-down    [down] [?\C-n])
***************
*** 399,408 ****
               (calculator-save-and-quit [(control return)]
                                         [(control kp-enter)])
               (calculator-paste         [insert] [(shift insert)]
!                                        [mouse-2])
               (calculator-clear         [delete] [?\C-?] [?\C-d])
               (calculator-help          [?h] [??] [f1] [help])
!              (calculator-copy          [(control insert)])
               (calculator-backspace     [backspace])
               )))
        (while p
--- 418,427 ----
               (calculator-save-and-quit [(control return)]
                                         [(control kp-enter)])
               (calculator-paste         [insert] [(shift insert)]
!                                        [paste] [mouse-2] [?\C-y])
               (calculator-clear         [delete] [?\C-?] [?\C-d])
               (calculator-help          [?h] [??] [f1] [help])
!              (calculator-copy          [(control insert)] [copy])
               (calculator-backspace     [backspace])
               )))
        (while p
***************
*** 536,542 ****
               ,@(mapcar (lambda (x) (nth 1 x)) radix-selectors)
               "---"
               ,@(mapcar (lambda (x) (nth 2 x)) radix-selectors)))
!            ("Decimal Dislpay"
              ,@(mapcar (lambda (d)
                          (vector (cadr d)
                                  ;; Note: inserts actual object here
--- 555,561 ----
               ,@(mapcar (lambda (x) (nth 1 x)) radix-selectors)
               "---"
               ,@(mapcar (lambda (x) (nth 2 x)) radix-selectors)))
!            ("Decimal Display"
              ,@(mapcar (lambda (d)
                          (vector (cadr d)
                                  ;; Note: inserts actual object here
***************
*** 611,620 ****
  * \"=?\": (? 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).
  
  Values can be saved for future reference in either a list of saved
  values, or in registers.
--- 630,640 ----
  * \"=?\": (? 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 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,688 ****
--- 703,709 ----
          (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,722 ****
--- 738,749 ----
    (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,899 ****
        (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."
    (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))))
        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"))))))
  
  (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."
    (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)))
    (calculator-enter))
  
  (defun calculator-rotate-displayer-back ()
!   "Like `calculator-rotate-displayer', but rotates modes back."
    (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)."
    (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)))))))
  
  (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)."
    (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)))))))
  
  (defun calculator-remove-zeros (numstr)
    "Get a number string NUMSTR and remove unnecessary zeroes.
--- 845,960 ----
        (concat calculator-prompt
                (substring prompt (+ trim (length calculator-prompt)))))))
  
! (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) (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 "." 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.
! If radix output mode is active, toggle digit grouping."
    (interactive)
!   (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.
! 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).
! If radix output mode is active, increase the grouping size."
    (interactive)
!   (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).
! If radix output mode is active, decrease the grouping size."
    (interactive)
!   (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,1001 ****
                    (calculator-remove-zeros str))
                  "e" (number-to-string exp))))))
  
! (defun calculator-num-to-string (num)
    "Convert NUM to a displayable string."
    (cond
      ((and (numberp num) calculator-output-radix)
--- 1056,1062 ----
                    (calculator-remove-zeros str))
                  "e" (number-to-string exp))))))
  
! (defun calculator-number-to-string (num)
    "Convert NUM to a displayable string."
    (cond
      ((and (numberp num) calculator-output-radix)
***************
*** 1015,1020 ****
--- 1076,1089 ----
                                          (?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,1057 ****
                              ;; customizable display for a single value
                              (caar calculator-displayers)
                              calculator-displayer)))
!                      (mapconcat 'calculator-num-to-string
                                  (reverse calculator-stack)
                                  " "))
                     " "
--- 1120,1126 ----
                              ;; customizable display for a single value
                              (caar calculator-displayers)
                              calculator-displayer)))
!                      (mapconcat 'calculator-number-to-string
                                  (reverse calculator-stack)
                                  " "))
                     " "
***************
*** 1319,1327 ****
            (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)))
                (throw 'op-error nil)))))
        (calculator-reduce-stack
         (cond ((eq (nth 1 op) '\() 10)
--- 1388,1395 ----
            (if (not (and op (= -1 (calculator-op-arity op))))
              ;;(error "Binary operator without a first operand")
              (progn
!               (calculator-message
!                "Binary operator without a first operand")
                (throw 'op-error nil)))))
        (calculator-reduce-stack
         (cond ((eq (nth 1 op) '\() 10)
***************
*** 1334,1342 ****
                     (not (numberp (car calculator-stack)))))
          ;;(error "Unterminated expression")
          (progn
!           (message "Unterminated expression")
!           (if calculator-electric-mode
!             (progn (sit-for 1) (message nil)))
            (throw 'op-error nil)))
        (setq calculator-stack (cons op calculator-stack))
        (calculator-reduce-stack (calculator-op-prec op))
--- 1402,1408 ----
                     (not (numberp (car calculator-stack)))))
          ;;(error "Unterminated expression")
          (progn
!           (calculator-message "Unterminated expression")
            (throw 'op-error nil)))
        (setq calculator-stack (cons op calculator-stack))
        (calculator-reduce-stack (calculator-op-prec op))
***************
*** 1540,1546 ****
        (setcdr as val)
        (setq calculator-registers
              (cons (cons reg val) calculator-registers)))
!     (message (format "[%c] := %S" reg val))))
  
  (defun calculator-put-value (val)
    "Paste VAL as if entered.
--- 1606,1612 ----
        (setcdr as val)
        (setq calculator-registers
              (cons (cons reg val) calculator-registers)))
!     (calculator-message "[%c] := %S" reg val)))
  
  (defun calculator-put-value (val)
    "Paste VAL as if entered.
***************
*** 1552,1575 ****
      (progn
        (calculator-clear-fragile)
        (setq calculator-curnum (let ((calculator-displayer "%S"))
!                                 (calculator-num-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
            (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)
                              (or (match-string 2 str) ".0")
!                             (match-string 3 str))))
!      (condition-case nil (car (read-from-string str))
         (error nil)))))
  
  (defun calculator-get-register (reg)
--- 1618,1643 ----
      (progn
        (calculator-clear-fragile)
        (setq calculator-curnum (let ((calculator-displayer "%S"))
!                                 (calculator-number-to-string val)))
        (calculator-update-display))))
  
  (defun calculator-paste ()
    "Paste a value from the `kill-ring'."
    (interactive)
    (calculator-put-value
!    (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 (or (match-string 1 str) "0")
                              (or (match-string 2 str) ".0")
!                             (or (match-string 3 str) ""))))
!      (condition-case nil (calculator-string-to-number str)
         (error nil)))))
  
  (defun calculator-get-register (reg)
***************
*** 1678,1684 ****
      (while (> x 0)
        (setq r (* r (truncate x)))
        (setq x (1- x)))
!     r))
  
  (defun calculator-truncate (n)
    "Truncate N, return 0 in case of overflow."
--- 1746,1752 ----
      (while (> x 0)
        (setq r (* r (truncate x)))
        (setq x (1- x)))
!     (+ 0.0 r)))
  
  (defun calculator-truncate (n)
    "Truncate N, return 0 in case of overflow."