calculator.el 67.1 KB
Newer Older
1
;;; calculator.el --- a calculator for Emacs  -*- lexical-binding: t -*-
Gerd Moellmann's avatar
Gerd Moellmann committed
2

Paul Eggert's avatar
Paul Eggert committed
3
;; Copyright (C) 1998, 2000-2019 Free Software Foundation, Inc.
Gerd Moellmann's avatar
Gerd Moellmann committed
4

Dave Love's avatar
Dave Love committed
5
;; Author: Eli Barzilay <eli@barzilay.org>
Gerd Moellmann's avatar
Gerd Moellmann committed
6 7 8 9
;; Keywords: tools, convenience

;; This file is part of GNU Emacs.

10 11 12 13
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
Gerd Moellmann's avatar
Gerd Moellmann committed
14

15 16 17 18
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.
Gerd Moellmann's avatar
Gerd Moellmann committed
19 20

;; You should have received a copy of the GNU General Public License
21
;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
Gerd Moellmann's avatar
Gerd Moellmann committed
22

Gerd Moellmann's avatar
Gerd Moellmann committed
23
;;;=====================================================================
Gerd Moellmann's avatar
Gerd Moellmann committed
24 25
;;; Commentary:
;;
Dave Love's avatar
Dave Love committed
26
;; A calculator for Emacs.
Eli Zaretskii's avatar
Eli Zaretskii committed
27
;; Why should you reach for your mouse to get xcalc (calc.exe, gcalc or
Dave Love's avatar
Dave Love committed
28
;; whatever), when you have Emacs running already?
Gerd Moellmann's avatar
Gerd Moellmann committed
29 30 31 32
;;
;; If this is not part of your Emacs distribution, then simply bind
;; `calculator' to a key and make it an autoloaded function, e.g.:
;;   (autoload 'calculator "calculator"
Dave Love's avatar
Dave Love committed
33
;;     "Run the Emacs calculator." t)
Gerd Moellmann's avatar
Gerd Moellmann committed
34 35
;;   (global-set-key [(control return)] 'calculator)
;;
36
;; Written by Eli Barzilay, eli@barzilay.org
Gerd Moellmann's avatar
Gerd Moellmann committed
37 38
;;

Gerd Moellmann's avatar
Gerd Moellmann committed
39
;;;=====================================================================
Gerd Moellmann's avatar
Gerd Moellmann committed
40 41 42
;;; Customization:

(defgroup calculator nil
Dave Love's avatar
Dave Love committed
43
  "Simple Emacs calculator."
Gerd Moellmann's avatar
Gerd Moellmann committed
44
  :prefix "calculator"
Dave Love's avatar
Dave Love committed
45
  :version "21.1"
Gerd Moellmann's avatar
Gerd Moellmann committed
46
  :group 'tools
Chong Yidong's avatar
Chong Yidong committed
47
  :group 'applications)
Gerd Moellmann's avatar
Gerd Moellmann committed
48 49

(defcustom calculator-electric-mode nil
Lute Kamstra's avatar
Lute Kamstra committed
50
  "Run `calculator' electrically, in the echo area.
Dave Love's avatar
Dave Love committed
51 52
Electric mode saves some place but changes the way you interact with the
calculator."
Gerd Moellmann's avatar
Gerd Moellmann committed
53 54 55
  :type  'boolean
  :group 'calculator)

56
(defcustom calculator-use-menu t
Lute Kamstra's avatar
Lute Kamstra committed
57
  "Make `calculator' create a menu.
58 59 60 61
Note that this requires easymenu.  Must be set before loading."
  :type  'boolean
  :group 'calculator)

Gerd Moellmann's avatar
Gerd Moellmann committed
62
(defcustom calculator-bind-escape nil
Lute Kamstra's avatar
Lute Kamstra committed
63
  "If non-nil, set escape to exit the calculator."
Gerd Moellmann's avatar
Gerd Moellmann committed
64 65 66 67
  :type  'boolean
  :group 'calculator)

(defcustom calculator-unary-style 'postfix
68
  "Value is either `prefix' or `postfix'.
Gerd Moellmann's avatar
Gerd Moellmann committed
69 70 71 72
This determines the default behavior of unary operators."
  :type    '(choice (const prefix) (const postfix))
  :group   'calculator)

Dave Love's avatar
Dave Love committed
73
(defcustom calculator-prompt "Calc=%s> "
Lute Kamstra's avatar
Lute Kamstra committed
74
  "The prompt used by the Emacs calculator.
75
It should contain a \"%s\" somewhere that will indicate the i/o radixes;
76 77
this will be a two-character string as described in the documentation
for `calculator-mode'."
Gerd Moellmann's avatar
Gerd Moellmann committed
78 79 80
  :type  'string
  :group 'calculator)

Dave Love's avatar
Dave Love committed
81
(defcustom calculator-number-digits 3
Lute Kamstra's avatar
Lute Kamstra committed
82
  "The calculator's number of digits used for standard display.
Dave Love's avatar
Dave Love committed
83 84 85
Used by the `calculator-standard-display' function - it will use the
format string \"%.NC\" where this number is N and C is a character given
at runtime."
86
  :type  'integer
Gerd Moellmann's avatar
Gerd Moellmann committed
87 88
  :group 'calculator)

89
(defcustom calculator-radix-grouping-mode t
Lute Kamstra's avatar
Lute Kamstra committed
90
  "Use digit grouping in radix output mode.
91 92
If this is set, chunks of `calculator-radix-grouping-digits' characters
will be separated by `calculator-radix-grouping-separator' when in radix
93 94 95
output mode is active (determined by `calculator-output-radix')."
  :type  'boolean
  :group 'calculator)
96 97

(defcustom calculator-radix-grouping-digits 4
Lute Kamstra's avatar
Lute Kamstra committed
98
  "The number of digits used for grouping display in radix modes.
99 100 101
See `calculator-radix-grouping-mode'."
  :type  'integer
  :group 'calculator)
102 103

(defcustom calculator-radix-grouping-separator "'"
Lute Kamstra's avatar
Lute Kamstra committed
104
  "The separator used in radix grouping display.
105 106 107
See `calculator-radix-grouping-mode'."
  :type  'string
  :group 'calculator)
108

Dave Love's avatar
Dave Love committed
109
(defcustom calculator-remove-zeros t
Lute Kamstra's avatar
Lute Kamstra committed
110
  "Non-nil value means delete all redundant zero decimal digits.
111 112
If this value is not t and not nil, redundant zeros are removed except
for one.
Dave Love's avatar
Dave Love committed
113 114
Used by the `calculator-remove-zeros' function."
  :type  '(choice (const t) (const leave-decimal) (const nil))
Gerd Moellmann's avatar
Gerd Moellmann committed
115 116
  :group 'calculator)

Dave Love's avatar
Dave Love committed
117
(defcustom calculator-displayer '(std ?n)
Lute Kamstra's avatar
Lute Kamstra committed
118
  "A displayer specification for numerical values.
Dave Love's avatar
Dave Love committed
119 120 121 122 123 124 125 126
This is the displayer used to show all numbers in an expression.  Result
values will be displayed according to the first element of
`calculator-displayers'.

The displayer is a symbol, a string or an expression.  A symbol should
be the name of a one-argument function, a string is used with a single
argument and an expression will be evaluated with the variable `num'
bound to whatever should be displayed.  If it is a function symbol, it
127 128
should be able to handle special symbol arguments, currently `left' and
`right' which will be sent by special keys to modify display parameters
Dave Love's avatar
Dave Love committed
129 130 131
associated with the displayer function (for example to change the number
of digits displayed).

132 133 134 135 136 137 138
An exception to the above is the case of the list (std C [G]) where C is
a character and G is an optional boolean, in this case the
`calculator-standard-displayer' function will be used with these as
arguments."
  :type '(choice (function) (string) (sexp)
                 (list (const std) character)
                 (list (const std) character boolean))
139
  :group 'calculator)
Dave Love's avatar
Dave Love committed
140 141

(defcustom calculator-displayers
142
  '(((std ?n) "Standard display, decimal point or scientific")
Dave Love's avatar
Dave Love committed
143
    (calculator-eng-display "Eng display")
144
    ((std ?f t) "Standard display, decimal point with grouping")
145
    ((std ?e) "Standard display, scientific")
Dave Love's avatar
Dave Love committed
146
    ("%S"     "Emacs printer"))
Lute Kamstra's avatar
Lute Kamstra committed
147
  "A list of displayers.
Dave Love's avatar
Dave Love committed
148
Each element is a list of a displayer and a description string.  The
149 150 151 152
first element is the one which is currently used, this is for the
display of result values not values in expressions.  A displayer
specification is the same as the values that can be stored in
`calculator-displayer'.
Dave Love's avatar
Dave Love committed
153 154 155

`calculator-rotate-displayer' rotates this list."
  :type  'sexp
Gerd Moellmann's avatar
Gerd Moellmann committed
156 157
  :group 'calculator)

Dave Love's avatar
Dave Love committed
158
(defcustom calculator-paste-decimals t
Lute Kamstra's avatar
Lute Kamstra committed
159
  "If non-nil, convert pasted integers so they have a decimal point.
Dave Love's avatar
Dave Love committed
160 161
This makes it possible to paste big integers since they will be read as
floats, otherwise the Emacs reader will fail on them."
Gerd Moellmann's avatar
Gerd Moellmann committed
162 163
  :type  'boolean
  :group 'calculator)
164
(make-obsolete-variable 'calculator-paste-decimals
165
                        "it is no longer used." "26.1")
Gerd Moellmann's avatar
Gerd Moellmann committed
166

167
(defcustom calculator-copy-displayer nil
Lute Kamstra's avatar
Lute Kamstra committed
168
  "If non-nil, this is any value that can be used for
169 170
`calculator-displayer', to format a string before copying it with
`calculator-copy'.  If nil, then `calculator-displayer's normal value is
171 172 173
used."
  :type  'boolean
  :group 'calculator)
174

Gerd Moellmann's avatar
Gerd Moellmann committed
175
(defcustom calculator-2s-complement nil
Lute Kamstra's avatar
Lute Kamstra committed
176
  "If non-nil, show negative numbers in 2s complement in radix modes.
Gerd Moellmann's avatar
Gerd Moellmann committed
177 178 179 180 181
Otherwise show as a negative number."
  :type  'boolean
  :group 'calculator)

(defcustom calculator-mode-hook nil
Lute Kamstra's avatar
Lute Kamstra committed
182
  "List of hook functions for `calculator-mode' to run.
183
Note: if `calculator-electric-mode' is on, then this hook will get
184
activated in the minibuffer -- in that case it should not do much more
185 186
than local key settings and other effects that will change things
outside the scope of calculator related code."
Gerd Moellmann's avatar
Gerd Moellmann committed
187 188 189 190
  :type  'hook
  :group 'calculator)

(defcustom calculator-user-registers nil
Lute Kamstra's avatar
Lute Kamstra committed
191
  "An association list of user-defined register bindings.
Gerd Moellmann's avatar
Gerd Moellmann committed
192 193 194 195
Each element in this list is a list of a character and a number that
will be stored in that character's register.

For example, use this to define the golden ratio number:
Paul Eggert's avatar
Paul Eggert committed
196
  (setq calculator-user-registers \\='((?g .  1.61803398875)))
Dave Love's avatar
Dave Love committed
197
before you load calculator."
Gerd Moellmann's avatar
Gerd Moellmann committed
198
  :type  '(repeat (cons character number))
199
  :set   (lambda (_ val)
200 201 202
           (when (boundp 'calculator-registers)
             (setq calculator-registers
                   (append val calculator-registers)))
203
           (setq calculator-user-registers val))
Gerd Moellmann's avatar
Gerd Moellmann committed
204 205 206
  :group 'calculator)

(defcustom calculator-user-operators nil
Lute Kamstra's avatar
Lute Kamstra committed
207
  "A list of additional operators.
Gerd Moellmann's avatar
Gerd Moellmann committed
208 209 210 211 212 213 214
This is a list in the same format as specified in the documentation for
`calculator-operators', that you can use to bind additional calculator
operators.  It is probably not a good idea to modify this value with
`customize' since it is too complex...

Examples:

Dave Love's avatar
Dave Love committed
215 216
* A very simple one, adding a postfix \"x-to-y\" conversion keys, using
  t as a prefix key:
Gerd Moellmann's avatar
Gerd Moellmann committed
217 218

  (setq calculator-user-operators
Paul Eggert's avatar
Paul Eggert committed
219
        \\='((\"tf\" cl-to-fr (+ 32 (/ (* X 9) 5)) 1)
Gerd Moellmann's avatar
Gerd Moellmann committed
220 221 222 223 224 225
          (\"tc\" fr-to-cl (/ (* (- X 32) 5) 9) 1)
          (\"tp\" kg-to-lb (/ X 0.453592)       1)
          (\"tk\" lb-to-kg (* X 0.453592)       1)
          (\"tF\" mt-to-ft (/ X 0.3048)         1)
          (\"tM\" ft-to-mt (* X 0.3048)         1)))

226 227
* Using a function-like form is simple: use `X' for the argument (`Y'
  for a second one in case of a binary operator), `TX' is a truncated
228
  version of `X' and `F' for a recursive call.  Here is a [very
229
  inefficient] Fibonacci number operator:
Gerd Moellmann's avatar
Gerd Moellmann committed
230

Paul Eggert's avatar
Paul Eggert committed
231 232
  (add-to-list \\='calculator-user-operators
               \\='(\"F\" fib
233
                 (if (<= TX 1) 1 (+ (F (- TX 1)) (F (- TX 2))))))
Gerd Moellmann's avatar
Gerd Moellmann committed
234 235 236 237 238 239

  Note that this will be either postfix or prefix, according to
  `calculator-unary-style'."
  :type  '(repeat (list string symbol sexp integer integer))
  :group 'calculator)

Gerd Moellmann's avatar
Gerd Moellmann committed
240
;;;=====================================================================
Gerd Moellmann's avatar
Gerd Moellmann committed
241 242
;;; Code:

243 244
(eval-when-compile (require 'cl-lib))

Gerd Moellmann's avatar
Gerd Moellmann committed
245
;;;---------------------------------------------------------------------
Dave Love's avatar
Dave Love committed
246 247
;;; Variables

Gerd Moellmann's avatar
Gerd Moellmann committed
248
(defvar calculator-initial-operators
249
  '(;; "+"/"-" have keybindings of their own, not calculator-ops
250
    ("=" =     identity        1 -1)
Dave Love's avatar
Dave Love committed
251 252 253 254
    (nobind "+" +  +           2  4)
    (nobind "-" -  -           2  4)
    (nobind "+" +  +          -1  9)
    (nobind "-" -  -          -1  9)
255 256
    ("(" \(    identity       -1 -1)
    (")" \)    identity       +1 10)
Gerd Moellmann's avatar
Gerd Moellmann committed
257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272
    ;; normal keys
    ("|"  or   (logior TX TY)  2  2)
    ("#"  xor  (logxor TX TY)  2  2)
    ("&"  and  (logand TX TY)  2  3)
    ("*"  *    *               2  5)
    ("/"  /    /               2  5)
    ("\\" div  (/ TX TY)       2  5)
    ("%"  rem  (% TX TY)       2  5)
    ("L"  log  log             2  6)
    ("S"  sin  (sin DX)        x  6)
    ("C"  cos  (cos DX)        x  6)
    ("T"  tan  (tan DX)        x  6)
    ("IS" asin (D (asin X))    x  6)
    ("IC" acos (D (acos X))    x  6)
    ("IT" atan (D (atan X))    x  6)
    ("Q"  sqrt sqrt            x  7)
273
    ("^"  ^    calculator-expt 2  7)
Gerd Moellmann's avatar
Gerd Moellmann committed
274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294
    ("!"  !    calculator-fact x  7)
    (";"  1/   (/ 1 X)         1  7)
    ("_"  -    -               1  8)
    ("~"  ~    (lognot TX)     x  8)
    (">"  repR calculator-repR 1  8)
    ("<"  repL calculator-repL 1  8)
    ("v"  avg  (/ (apply '+ L) (length L)) 0 8)
    ("l"  tot  (apply '+ L)    0 8)
    )
  "A list of initial operators.
This is a list in the same format as `calculator-operators'.  Whenever
`calculator' starts, it looks at the value of this variable, and if it
is not empty, its contents is prepended to `calculator-operators' and
the appropriate key bindings are made.

This variable is then reset to nil.  Don't use this if you want to add
user-defined operators, use `calculator-user-operators' instead.")

(defvar calculator-operators nil
  "The calculator operators, each a list with:

295
1. The key(s) that is bound to for this operation, a string that is
296
   used with `kbd';
Gerd Moellmann's avatar
Gerd Moellmann committed
297 298 299 300 301 302 303 304

2. The displayed symbol for this function;

3. The function symbol, or a form that uses the variables `X' and `Y',
   (if it is a binary operator), `TX' and `TY' (truncated integer
   versions), `DX' (converted to radians if degrees mode is on), `D'
   (function for converting radians to degrees if deg mode is on), `L'
   (list of saved values), `F' (function for recursive iteration calls)
305
   and evaluates to the function value -- these variables are capital;
Gerd Moellmann's avatar
Gerd Moellmann committed
306

Dave Love's avatar
Dave Love committed
307
4. The function's arity, optional, one of: 2 => binary, -1 => prefix
308 309 310 311
   unary, +1 => postfix unary, 0 => a 0-arg operator func (note that
   using such a function replaces the currently entered number, if any),
   non-number (the default) => postfix or prefix as determined by
   `calculator-unary-style';
Gerd Moellmann's avatar
Gerd Moellmann committed
312

313
5. The function's precedence -- should be in the range of 1 (lowest) to
Dave Love's avatar
Dave Love committed
314
   9 (highest) (optional, defaults to 1);
Gerd Moellmann's avatar
Gerd Moellmann committed
315 316

It it possible have a unary prefix version of a binary operator if it
317
comes later in this list.  If the list begins with the symbol `nobind',
318 319
then no key binding will take place -- this is only used for predefined
keys.
Gerd Moellmann's avatar
Gerd Moellmann committed
320 321 322 323 324

Use `calculator-user-operators' to add operators to this list, see its
documentation for an example.")

(defvar calculator-stack nil
325
  "Stack contents -- operations and operands.")
Gerd Moellmann's avatar
Gerd Moellmann committed
326 327 328 329 330 331 332 333 334 335 336 337

(defvar calculator-curnum nil
  "Current number being entered (as a string).")

(defvar calculator-stack-display nil
  "Cons of the stack and its string representation.")

(defvar calculator-char-radix
  '((?D . nil) (?B . bin) (?O . oct) (?H . hex) (?X . hex))
  "A table to convert input characters to corresponding radix symbols.")

(defvar calculator-output-radix nil
338
  "The mode for display, one of: nil (decimal), `bin', `oct' or `hex'.")
Gerd Moellmann's avatar
Gerd Moellmann committed
339 340

(defvar calculator-input-radix nil
341
  "The mode for input, one of: nil (decimal), `bin', `oct' or `hex'.")
Gerd Moellmann's avatar
Gerd Moellmann committed
342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360

(defvar calculator-deg nil
  "Non-nil if trig functions operate on degrees instead of radians.")

(defvar calculator-saved-list nil
  "A list of saved values collected.")

(defvar calculator-saved-ptr 0
  "The pointer to the current saved number.")

(defvar calculator-add-saved nil
  "Bound to t when a value should be added to the saved-list.")

(defvar calculator-display-fragile nil
  "When non-nil, we see something that the next digit should replace.")

(defvar calculator-buffer nil
  "The current calculator buffer.")

Dave Love's avatar
Dave Love committed
361 362 363 364 365 366
(defvar calculator-eng-extra nil
  "Internal value used by `calculator-eng-display'.")

(defvar calculator-eng-tmp-show nil
  "Internal value used by `calculator-eng-display'.")

Gerd Moellmann's avatar
Gerd Moellmann committed
367 368 369 370 371
(defvar calculator-last-opXY nil
  "The last binary operation and its arguments.
Used for repeating operations in calculator-repR/L.")

(defvar calculator-registers ; use user-bindings first
372 373
  (append calculator-user-registers
          (list (cons ?e float-e) (cons ?p float-pi)))
Gerd Moellmann's avatar
Gerd Moellmann committed
374 375
  "The association list of calculator register values.")

376
(defvar calculator-restart-other-mode nil
Dave Love's avatar
Dave Love committed
377 378
  "Used to hack restarting with the electric mode changed.")

Gerd Moellmann's avatar
Gerd Moellmann committed
379
;;;---------------------------------------------------------------------
Dave Love's avatar
Dave Love committed
380
;;; Key bindings
381

382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414
(defun calculator-define-key (key cmd map)
  ;; Arranges for unbound alphabetic keys to be used as their un/shifted
  ;; versions if those are bound (mimics the usual Emacs global bindings).
  ;; FIXME: We should adjust Emacs's native "fallback to unshifted binding"
  ;; such that it can also be used here, rather than having to use a hack like
  ;; this one.
  (let* ((key  (if (stringp key) (kbd key) key))
         (omap (keymap-parent map)))
    (define-key map key cmd)
    ;; "other" map, used for case-flipped bindings
    (unless omap
      (setq omap (make-sparse-keymap))
      (suppress-keymap omap t)
      (set-keymap-parent map omap))
    (let ((m omap))
      ;; Bind all case-flipped versions.
      (dotimes (i (length key))
        (let* ((c (aref key i))
               (k (vector c))
               (b (lookup-key m k))
               (defkey (lambda (x)
                         (define-key m k x)
                         (when (and (characterp c)
                                    (or (<= ?A c ?Z) (<= ?a c ?z)))
                           (define-key m (vector (logxor 32 c)) x)))))
          (cond ((= i (1- (length key)))
                 ;; Prefer longer sequences.
                 (unless (keymapp b) (funcall defkey cmd)))
                ((keymapp b) (setq m b))
                (t (let ((sub (make-sparse-keymap)))
                     (funcall defkey sub)
                     (setq m sub)))))))))

415
(defvar calculator-mode-map
416
  (let ((map (make-sparse-keymap)))
Gerd Moellmann's avatar
Gerd Moellmann committed
417
    (suppress-keymap map t)
418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458
    (dolist (x '((calculator-digit
                  "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "a" "b" "c"
                  "d" "f" "<kp-0>" "<kp-1>" "<kp-2>" "<kp-3>" "<kp-4>"
                  "<kp-5>" "<kp-6>" "<kp-7>" "<kp-8>" "<kp-9>")
                 (calculator-open-paren  "[")
                 (calculator-close-paren "]")
                 (calculator-op-or-exp   "+" "-"
                                         "<kp-add>" "<kp-subtract>")
                 (calculator-op          "<kp-divide>" "<kp-multiply>")
                 (calculator-decimal     "." "<kp-decimal>")
                 (calculator-exp         "e")
                 (calculator-dec/deg-mode "D")
                 (calculator-set-register "s")
                 (calculator-get-register "g")
                 (calculator-radix-mode        "H" "X" "O" "B")
                 (calculator-radix-input-mode  "iD" "iH" "iX" "iO" "iB")
                 (calculator-radix-output-mode "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")
                 (calculator-quit         "q" "C-g")
                 (calculator-enter        "<enter>" "<linefeed>"
                                          "<kp-enter>" "<return>"
                                          "RET" "LFD")
                 (calculator-save-on-list "SPC" "<space>")
                 (calculator-clear-saved  "C-c" "<C-delete>")
                 (calculator-save-and-quit "<C-return>" "<C-kp-enter>")
                 (calculator-paste        "<insert>" "<S-insert>"
                                          "<paste>" "<mouse-2>" "C-y")
                 (calculator-clear        "<delete>" "DEL" "C-d")
                 (calculator-help         "h" "?" "<f1>" "<help>")
                 (calculator-copy         "<C-insert>" "<copy>")
                 (calculator-backspace    "<backspace>")
                 ))
      ;; reverse the keys so earlier definitions come last -- makes the
      ;; more sensible bindings visible in the menu
      (dolist (k (reverse (cdr x)))
        (calculator-define-key k (car x) map)))
Gerd Moellmann's avatar
Gerd Moellmann committed
459
    (if calculator-bind-escape
460 461 462
      (progn (calculator-define-key "ESC" 'calculator-quit map)
             (calculator-define-key "<escape>" 'calculator-quit map))
      (calculator-define-key "ESC ESC ESC" 'calculator-quit map))
Gerd Moellmann's avatar
Gerd Moellmann committed
463
    ;; make C-h work in text-mode
464
    (unless window-system
465
      (calculator-define-key "C-h" 'calculator-backspace map))
466
    ;; set up a menu
467
    (when (and calculator-use-menu (not (boundp 'calculator-menu)))
468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493
      (let ((radix-selectors
             (mapcar (lambda (x)
                       `([,(nth 0 x)
                          (calculator-radix-mode ,(nth 2 x))
                          :style radio
                          :keys ,(nth 2 x)
                          :selected
                          (and
                           (eq calculator-input-radix ',(nth 1 x))
                           (eq calculator-output-radix ',(nth 1 x)))]
                         [,(concat (nth 0 x) " Input")
                          (calculator-radix-input-mode ,(nth 2 x))
                          :keys ,(concat "i" (downcase (nth 2 x)))
                          :style radio
                          :selected
                          (eq calculator-input-radix ',(nth 1 x))]
                         [,(concat (nth 0 x) " Output")
                          (calculator-radix-output-mode ,(nth 2 x))
                          :keys ,(concat "o" (downcase (nth 2 x)))
                          :style radio
                          :selected
                          (eq calculator-output-radix ',(nth 1 x))]))
                     '(("Decimal"     nil "D")
                       ("Binary"      bin "B")
                       ("Octal"       oct "O")
                       ("Hexadecimal" hex "H"))))
494 495
            (op (lambda (name key)
                  `[,name (calculator-op ,key) :keys ,key])))
496
        (easy-menu-define
497 498 499 500 501 502 503 504
          calculator-menu map "Calculator menu."
          `("Calculator"
            ["Help"
             (let ((last-command 'calculator-help)) (calculator-help))
             :keys "?"]
            "---"
            ["Copy"  calculator-copy]
            ["Paste" calculator-paste]
505
            "---"
506 507 508
            ["Electric mode"
             (progn (calculator-quit)
                    (setq calculator-restart-other-mode t)
509
                    (run-with-timer 0.1 nil (lambda () (message nil)))
510 511 512 513 514 515 516 517
                    ;; the message from the menu will be visible,
                    ;; couldn't make it go away...
                    (calculator))
             :active (not calculator-electric-mode)]
            ["Normal mode"
             (progn (setq calculator-restart-other-mode t)
                    (calculator-quit))
             :active calculator-electric-mode]
518
            "---"
519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549
            ("Functions"
             ,(funcall op "Repeat-right" ">")
             ,(funcall op "Repeat-left"  "<")
             "------General------"
             ,(funcall op "Reciprocal"   ";")
             ,(funcall op "Log"          "L")
             ,(funcall op "Square-root"  "Q")
             ,(funcall op "Factorial"    "!")
             "------Trigonometric------"
             ,(funcall op "Sinus"        "S")
             ,(funcall op "Cosine"       "C")
             ,(funcall op "Tangent"      "T")
             ,(funcall op "Inv-Sinus"    "IS")
             ,(funcall op "Inv-Cosine"   "IC")
             ,(funcall op "Inv-Tangent"  "IT")
             "------Bitwise------"
             ,(funcall op "Or"           "|")
             ,(funcall op "Xor"          "#")
             ,(funcall op "And"          "&")
             ,(funcall op "Not"          "~"))
            ("Saved List"
             ["Eval+Save"      calculator-save-on-list]
             ["Prev number"    calculator-saved-up]
             ["Next number"    calculator-saved-down]
             ["Delete current" calculator-clear
              :active (and calculator-display-fragile
                           calculator-saved-list
                           (= (car calculator-stack)
                              (nth calculator-saved-ptr
                                   calculator-saved-list)))]
             ["Delete all" calculator-clear-saved]
550
             "---"
551 552 553 554 555 556 557 558
             ,(funcall op "List-total"   "l")
             ,(funcall op "List-average" "v"))
            ("Registers"
             ["Get register" calculator-get-register]
             ["Set register" calculator-set-register])
            ("Modes"
             ["Radians"
              (progn
559 560 561
                (when (or calculator-input-radix calculator-output-radix)
                  (calculator-radix-mode "D"))
                (when calculator-deg (calculator-dec/deg-mode)))
562 563 564 565 566 567 568
              :keys "D"
              :style radio
              :selected (not (or calculator-input-radix
                                 calculator-output-radix
                                 calculator-deg))]
             ["Degrees"
              (progn
569 570 571
                (when (or calculator-input-radix calculator-output-radix)
                  (calculator-radix-mode "D"))
                (unless calculator-deg (calculator-dec/deg-mode)))
572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591
              :keys "D"
              :style radio
              :selected (and calculator-deg
                             (not (or calculator-input-radix
                                      calculator-output-radix)))]
             "---"
             ,@(mapcar 'car radix-selectors)
             ("Separate I/O"
              ,@(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
                                 `(calculator-rotate-displayer ',d)))
                       calculator-displayers)
             "---"
             ["Change Prev Display" calculator-displayer-prev]
             ["Change Next Display" calculator-displayer-next])
Dave Love's avatar
Dave Love committed
592
            "---"
593 594 595 596
            ["Copy+Quit" calculator-save-and-quit]
            ["Quit"      calculator-quit]))))
    map)
  "The calculator key map.")
Gerd Moellmann's avatar
Gerd Moellmann committed
597

Gerd Moellmann's avatar
Gerd Moellmann committed
598
;;;---------------------------------------------------------------------
Dave Love's avatar
Dave Love committed
599 600
;;; Startup and mode stuff

601
(define-derived-mode calculator-mode fundamental-mode "Calculator"
Dave Love's avatar
Dave Love committed
602 603
  ;; this help is also used as the major help screen
  "A [not so] simple calculator for Emacs.
Gerd Moellmann's avatar
Gerd Moellmann committed
604 605

This calculator is used in the same way as other popular calculators
606
like xcalc or calc.exe -- but using an Emacs interface.
Gerd Moellmann's avatar
Gerd Moellmann committed
607 608 609 610 611 612 613 614

Expressions are entered using normal infix notation, parens are used as
normal.  Unary functions are usually postfix, but some depends on the
value of `calculator-unary-style' (if the style for an operator below is
specified, then it is fixed, otherwise it depends on this variable).
`+' and `-' can be used as either binary operators or prefix unary
operators.  Numbers can be entered with exponential notation using `e',
except when using a non-decimal radix mode for input (in this case `e'
615
will be the hexadecimal digit).
Gerd Moellmann's avatar
Gerd Moellmann committed
616 617 618 619

Here are the editing keys:
* `RET' `='      evaluate the current expression
* `C-insert'     copy the whole current expression to the `kill-ring'
620
* `C-return'     evaluate, save result the `kill-ring' and exit
Gerd Moellmann's avatar
Gerd Moellmann committed
621 622 623 624 625 626 627 628 629
* `insert'       paste a number if the one was copied (normally)
* `delete' `C-d' clear last argument or whole expression (hit twice)
* `backspace'    delete a digit or a previous expression element
* `h' `?'        pop-up a quick reference help
* `ESC' `q'      exit (`ESC' can be used if `calculator-bind-escape' is
                 non-nil, otherwise use three consecutive `ESC's)

These operators are pre-defined:
* `+' `-' `*' `/' the common binary operators
630
* `\\' `%'         integer division and remainder
Gerd Moellmann's avatar
Gerd Moellmann committed
631 632 633
* `_' `;'         postfix unary negation and reciprocal
* `^' `L'         binary operators for x^y and log(x) in base y
* `Q' `!'         unary square root and factorial
634 635
* `S' `C' `T'     unary trigonometric operators: sin, cos and tan
* `|' `#' `&' `~' bitwise operators: or, xor, and, not
Gerd Moellmann's avatar
Gerd Moellmann committed
636 637 638 639 640 641 642 643 644 645 646 647

The trigonometric functions can be inverted if prefixed with an `I', see
below for the way to use degrees instead of the default radians.

Two special postfix unary operators are `>' and `<': whenever a binary
operator is performed, it is remembered along with its arguments; then
`>' (`<') will apply the same operator with the same right (left)
argument.

hex/oct/bin modes can be set for input and for display separately.
Another toggle-able mode is for using degrees instead of radians for
trigonometric functions.
648
The keys to switch modes are (both `H' and `X' are for hex):
Gerd Moellmann's avatar
Gerd Moellmann committed
649 650 651 652 653
* `D'             switch to all-decimal mode, or toggle degrees/radians
* `B' `O' `H' `X' binary/octal/hexadecimal modes for input & display
* `i' `o'         followed by one of `D' `B' `O' `H' `X' (case
                  insensitive) sets only the input or display radix mode
The prompt indicates the current modes:
654 655 656 657 658
* \"==\": decimal mode (using radians);
* \"D=\": decimal mode using degrees;
* \"?=\": ? is B/O/H, the radix for both input and output;
* \"=?\": ? is B/O/H, the display radix (with decimal input);
* \"??\": ? is D/B/O/H, 1st char for input radix, 2nd for display.
Gerd Moellmann's avatar
Gerd Moellmann committed
659

660 661
Also, the quote key can be used to switch display modes for decimal
numbers (double-quote rotates back), and the two brace characters
662 663 664
\(\"{\" 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.
Dave Love's avatar
Dave Love committed
665

Gerd Moellmann's avatar
Gerd Moellmann committed
666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694
Values can be saved for future reference in either a list of saved
values, or in registers.

The list of saved values is useful for statistics operations on some
collected data.  It is possible to navigate in this list, and if the
value shown is the current one on the list, an indication is displayed
as \"[N]\" if this is the last number and there are N numbers, or
\"[M/N]\" if the M-th value is shown.
* `SPC'            evaluate the current value as usual, but also adds
                   the result to the list of saved values
* `l' `v'          computes total / average of saved values
* `up' `C-p'       browse to the previous value in the list
* `down' `C-n'     browse to the next value in the list
* `delete' `C-d'   remove current value from the list (if it is on it)
* `C-delete' `C-c' delete the whole list

Registers are variable-like place-holders for values:
* `s' followed by a character attach the current value to that character
* `g' followed by a character fetches the attached value

There are many variables that can be used to customize the calculator.
Some interesting customization variables are:
* `calculator-electric-mode'  use only the echo-area electrically.
* `calculator-unary-style'    set most unary ops to pre/postfix style.
* `calculator-user-registers' to define user-preset registers.
* `calculator-user-operators' to add user-defined operators.
See the documentation for these variables, and \"calculator.el\" for
more information.

695
\\{calculator-mode-map}")
Gerd Moellmann's avatar
Gerd Moellmann committed
696

Glenn Morris's avatar
Glenn Morris committed
697 698 699
(declare-function Electric-command-loop "electric"
                  (return-tag &optional prompt inhibit-quitting
                              loop-function loop-state))
Dave Love's avatar
Dave Love committed
700

Gerd Moellmann's avatar
Gerd Moellmann committed
701 702
;;;###autoload
(defun calculator ()
Dave Love's avatar
Dave Love committed
703
  "Run the Emacs calculator.
Gerd Moellmann's avatar
Gerd Moellmann committed
704 705
See the documentation for `calculator-mode' for more information."
  (interactive)
706
  (when calculator-restart-other-mode
707
    (setq calculator-electric-mode (not calculator-electric-mode)))
708 709 710 711 712 713
  (when calculator-initial-operators
    (calculator-add-operators calculator-initial-operators)
    (setq calculator-initial-operators nil)
    ;; don't change this since it is a customization variable,
    ;; its set function will add any new operators
    (calculator-add-operators calculator-user-operators))
714
  (setq calculator-buffer (get-buffer-create "*calculator*"))
Gerd Moellmann's avatar
Gerd Moellmann committed
715 716
  (if calculator-electric-mode
    (save-window-excursion
717
      (require 'electric) (message nil) ; hide load message
718
      (let ((old-buf (window-buffer (minibuffer-window)))
719
            (echo-keystrokes 0)
Gerd Moellmann's avatar
Gerd Moellmann committed
720
            (garbage-collection-messages nil)) ; no gc msg when electric
721
        (set-window-buffer (minibuffer-window) calculator-buffer)
Gerd Moellmann's avatar
Gerd Moellmann committed
722 723 724
        (select-window (minibuffer-window))
        (calculator-reset)
        (calculator-update-display)
725
        (use-local-map calculator-mode-map)
726
        (run-hooks 'calculator-mode-hook)
Gerd Moellmann's avatar
Gerd Moellmann committed
727 728 729 730 731
        (unwind-protect
            (catch 'calculator-done
              (Electric-command-loop
               'calculator-done
               ;; can't use 'noprompt, bug in electric.el
732
               (lambda () 'noprompt)
Gerd Moellmann's avatar
Gerd Moellmann committed
733
               nil
734
               (lambda (_x _y) (calculator-update-display))))
735
          (set-window-buffer (minibuffer-window) old-buf)
736
          (kill-buffer calculator-buffer))))
737
    (progn
738 739
      (cond
        ((not (get-buffer-window calculator-buffer))
740
         (let ((window-min-height 2))
741 742
           ;; maybe leave two lines for our window because of the
           ;; normal `raised' mode line
743 744
           (select-window (split-window-below
                           (if (calculator-need-3-lines) -3 -2)))
745 746 747
           (switch-to-buffer calculator-buffer)))
        ((not (eq (current-buffer) calculator-buffer))
         (select-window (get-buffer-window calculator-buffer))))
748 749 750 751
      (calculator-mode)
      (setq buffer-read-only t)
      (calculator-reset)
      (message "Hit `?' For a quick help screen.")))
752
  (when (and calculator-restart-other-mode calculator-electric-mode)
753
    (calculator)))
Gerd Moellmann's avatar
Gerd Moellmann committed
754

755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775
(defun calculator-need-3-lines ()
  ;; If the mode line might interfere with the calculator buffer, use 3
  ;; lines instead.
  (let* ((dh (face-attribute 'default :height))
         (mh (face-attribute 'mode-line :height)))
    ;; if the mode line is shorter than the default, stick with 2 lines
    ;; (it may be necessary to check how much shorter)
    (and (not (or (and (integerp dh) (integerp mh) (< mh dh))
                  (and (numberp mh) (not (integerp mh)) (< mh 1))))
         (or ;; if the mode line is taller than the default, use 3 lines
             (and (integerp dh) (integerp mh) (> mh dh))
             (and (numberp mh) (not (integerp mh)) (> mh 1))
             ;; if the mode line has a box with non-negative line-width,
             ;; use 3 lines
             (let* ((bx (face-attribute 'mode-line :box))
                    (lh (plist-get bx :line-width)))
               (and bx (or (not lh) (> lh 0))))
             ;; if the mode line has an overline, use 3 lines
             (not (memq (face-attribute 'mode-line :overline)
                        '(nil unspecified)))))))

776
(defun calculator-message (string &rest arguments)
777
  "Same as `message', but also handle electric mode."
778
  (apply 'message string arguments)
779
  (when calculator-electric-mode (sit-for 1) (message nil)))
780

Gerd Moellmann's avatar
Gerd Moellmann committed
781
;;;---------------------------------------------------------------------
782
;;; Operators
Dave Love's avatar
Dave Love committed
783

Gerd Moellmann's avatar
Gerd Moellmann committed
784
(defun calculator-op-arity (op)
785 786 787 788 789 790 791
  "Return OP's arity.
Current results are one of 2 (binary), +1 (postfix), -1 (prefix), or
0 (nullary)."
  (let ((arity (nth 3 op)))
    (cond ((numberp arity)                      arity)
          ((eq calculator-unary-style 'postfix) +1)
          (t                                    -1))))
Gerd Moellmann's avatar
Gerd Moellmann committed
792 793 794 795 796 797 798 799 800 801 802

(defun calculator-op-prec (op)
  "Return OP's precedence for reducing when inserting into the stack.
Defaults to 1."
  (or (nth 4 op) 1))

(defun calculator-add-operators (more-ops)
  "This function handles operator addition.
Adds MORE-OPS to `calculator-operator', called initially to handle
`calculator-initial-operators' and `calculator-user-operators'."
  (let ((added-ops nil))
803 804
    (dolist (op more-ops)
      (unless (eq (car op) 'nobind)
805
        (calculator-define-key (car op) 'calculator-op calculator-mode-map))
806 807
      (push (if (eq (car op) 'nobind) (cdr op) op)
            added-ops))
Gerd Moellmann's avatar
Gerd Moellmann committed
808 809 810 811
    ;; added-ops come first, but in correct order
    (setq calculator-operators
          (append (nreverse added-ops) calculator-operators))))

Gerd Moellmann's avatar
Gerd Moellmann committed
812
;;;---------------------------------------------------------------------
Dave Love's avatar
Dave Love committed
813 814
;;; Display stuff

Gerd Moellmann's avatar
Gerd Moellmann committed
815 816
(defun calculator-reset ()
  "Reset calculator variables."
817 818 819 820 821
  (unless calculator-restart-other-mode
    (setq calculator-stack           nil
          calculator-curnum          nil
          calculator-stack-display   nil
          calculator-display-fragile nil))
822
  (setq calculator-restart-other-mode nil)
Gerd Moellmann's avatar
Gerd Moellmann committed
823 824
  (calculator-update-display))

825
(defun calculator-get-display ()
Gerd Moellmann's avatar
Gerd Moellmann committed
826
  "Return a string to display.
827 828 829 830 831 832 833 834 835 836 837 838 839
The result should not exceed the screen width."
  (let* ((in-r  (and calculator-input-radix
                     (char-to-string
                      (car (rassq calculator-input-radix
                                  calculator-char-radix)))))
         (out-r (and calculator-output-radix
                     (char-to-string
                      (car (rassq calculator-output-radix
                                  calculator-char-radix)))))
         (prompt (format calculator-prompt
                         (cond ((or in-r out-r)
                                (concat (or in-r "=")
                                        (if (equal in-r out-r) "="
840
                                            (or out-r "D"))))
841 842 843 844
                               (calculator-deg "D=")
                               (t "=="))))
         (expr
          (concat (cdr calculator-stack-display)
Gerd Moellmann's avatar
Gerd Moellmann committed
845
                  (cond
846 847 848 849 850 851 852 853 854 855
                    ;; entering a number
                    (calculator-curnum (concat calculator-curnum "_"))
                    ;; showing a result
                    ((and (= 1 (length calculator-stack))
                          calculator-display-fragile)
                     nil)
                    ;; waiting for a number or an operator
                    (t "?"))))
         (trim (+ (length expr) (length prompt) 1 (- (window-width)))))
    (concat prompt (if (<= trim 0) expr (substring expr trim)))))
Gerd Moellmann's avatar
Gerd Moellmann committed
856

857 858 859
(defun calculator-string-to-number (str)
  "Convert the given STR to a number, according to the value of
`calculator-input-radix'."
Gerd Moellmann's avatar
Gerd Moellmann committed
860
  (if calculator-input-radix
861 862 863 864 865 866 867
    (string-to-number str (cadr (assq calculator-input-radix
                                      '((bin 2) (oct 8) (hex 16)))))
    (let* ((str (replace-regexp-in-string
                 "\\.\\([^0-9].*\\)?$" ".0\\1" str))
           (str (replace-regexp-in-string
                 "[eE][+-]?\\([^0-9].*\\)?$" "e0\\1" str)))
      (string-to-number str))))
868

869 870 871 872 873 874
(defun calculator-push-curnum ()
  "Push the numeric value of the displayed number to the stack."
  (when calculator-curnum
    (push (calculator-string-to-number calculator-curnum)
          calculator-stack)
    (setq calculator-curnum nil)))
Gerd Moellmann's avatar
Gerd Moellmann committed
875

Dave Love's avatar
Dave Love committed
876 877 878
(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
879 880
that argument.
If radix output mode is active, toggle digit grouping."
Dave Love's avatar
Dave Love committed
881
  (interactive)
882 883 884 885 886 887 888 889 890 891 892 893
  (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))
894
                 (push (pop calculator-displayers) tmp))
895 896 897 898 899 900
               (setq calculator-displayers
                     (nconc calculator-displayers (nreverse tmp))))
             (nconc (cdr calculator-displayers)
                    (list (car calculator-displayers)))))
     (calculator-message
      "Using %s." (cadr (car calculator-displayers)))))
Dave Love's avatar
Dave Love committed
901 902 903
  (calculator-enter))

(defun calculator-rotate-displayer-back ()
904 905
  "Like `calculator-rotate-displayer', but rotates modes back.
If radix output mode is active, toggle digit grouping."
Dave Love's avatar
Dave Love committed
906 907 908
  (interactive)
  (calculator-rotate-displayer (car (last calculator-displayers))))

909
(defun calculator-displayer-prev ()
910
  "Send the current displayer function a `left' argument.
Dave Love's avatar
Dave Love committed
911
This is used to modify display arguments (if the current displayer
912 913
function supports this).
If radix output mode is active, increase the grouping size."
Dave Love's avatar
Dave Love committed
914
  (interactive)
915 916 917 918
  (if calculator-output-radix
    (progn (setq calculator-radix-grouping-digits
                 (1+ calculator-radix-grouping-digits))
           (calculator-enter))
919 920 921 922 923
    (when (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)))))))
Dave Love's avatar
Dave Love committed
924

925
(defun calculator-displayer-next ()
926
  "Send the current displayer function a `right' argument.
Dave Love's avatar
Dave Love committed
927
This is used to modify display arguments (if the current displayer
928 929
function supports this).
If radix output mode is active, decrease the grouping size."
Dave Love's avatar
Dave Love committed
930
  (interactive)
931 932 933 934
  (if calculator-output-radix
    (progn (setq calculator-radix-grouping-digits
                 (max 2 (1- calculator-radix-grouping-digits)))
           (calculator-enter))
935 936 937 938 939
    (when (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)))))))
Dave Love's avatar
Dave Love committed
940 941

(defun calculator-remove-zeros (numstr)
942 943
  "Get a number string NUMSTR and remove unnecessary zeros.
The behavior of this function is controlled by
Dave Love's avatar
Dave Love committed
944
`calculator-remove-zeros'."
945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970
  (let* ((s (if (not (eq calculator-remove-zeros t)) numstr
                ;; remove all redundant zeros leaving an integer
                (replace-regexp-in-string
                 "\\.0+\\([eE].*\\)?$" "\\1" numstr)))
         (s (if (not calculator-remove-zeros) s
                ;; remove zeros, except for first after the "."
                (replace-regexp-in-string
                 "\\(\\..[0-9]*?\\)0+\\([eE].*\\)?$" "\\1\\2" s))))
    s))

(defun calculator-groupize-number (str n sep &optional fromleft)
  "Return the input string STR with occurrences of SEP that separate
every N characters starting from the right, or from the left if
FROMLEFT is true."
  (let* ((len (length str)) (i (/ len n)) (j (% len n))
         (r (if (or (not fromleft) (= j 0)) '()
                (list (substring str (- len j))))))
    (while (> i 0)
      (let* ((e (* i n)) (e (if fromleft e (+ e j))))
        (push (substring str (- e n) e) r))
      (setq i (1- i)))
    (when (and (not fromleft) (> j 0))
      (push (substring str 0 j) r))
    (mapconcat 'identity r sep)))

(defun calculator-standard-displayer (num &optional char group-p)
Dave Love's avatar
Dave Love committed
971 972 973 974 975 976
  "Standard display function, used to display NUM.
Its behavior is determined by `calculator-number-digits' and the given
CHAR argument (both will be used to compose a format string).  If the
char is \"n\" then this function will choose one between %f or %e, this
is a work around %g jumping to exponential notation too fast.

977 978
It will also split digit sequences into comma-separated groups
and/or remove redundant zeros.
Dave Love's avatar
Dave Love committed
979

980 981
The special `left' and `right' symbols will make it change the current
number of digits displayed (`calculator-number-digits')."
Dave Love's avatar
Dave Love committed
982 983
  (if (symbolp num)
    (cond ((eq num 'left)
984 985 986 987
           (when (> calculator-number-digits 0)
             (setq calculator-number-digits
                   (1- calculator-number-digits))
             (calculator-enter)))
Dave Love's avatar
Dave Love committed
988 989 990 991
          ((eq num 'right)
           (setq calculator-number-digits
                 (1+ calculator-number-digits))
           (calculator-enter)))
992 993 994 995 996 997 998 999
    (let* ((s (if (eq char ?n)
                (let ((n (abs num)))
                  (if (or (and (< 0 n) (< n 0.001)) (< 1e8 n)) ?e ?f))
                char))
           (s (format "%%.%s%c" calculator-number-digits s))
           (s (calculator-remove-zeros (format s num)))
           (s (if (or (not group-p) (string-match-p "[eE]" s)) s
                  (replace-regexp-in-string
1000 1001 1002
                   "\\([0-9]+\\)\\(?:\\..*\\|$\\)"
                   (lambda (_) (calculator-groupize-number
                                (match-string 1 s) 3 ","))
1003 1004
                   s nil nil 1))))
      s)))
Dave Love's avatar
Dave Love committed
1005 1006 1007 1008 1009

(defun calculator-eng-display (num)
  "Display NUM in engineering notation.
The number of decimal digits used is controlled by
`calculator-number-digits', so to change it at runtime you have to use
1010
the `left' or `right' when one of the standard modes is used."
Dave Love's avatar
Dave Love committed
1011 1012 1013
  (if (symbolp num)
    (cond ((eq num 'left)
           (setq calculator-eng-extra
1014
                 (if calculator-eng-extra (1+ calculator-eng-extra) 1))
Dave Love's avatar
Dave Love committed
1015 1016 1017
           (let ((calculator-eng-tmp-show t)) (calculator-enter)))
          ((eq num 'right)
           (setq calculator-eng-extra
1018
                 (if calculator-eng-extra (1- calculator-eng-extra) -1))
Dave Love's avatar
Dave Love committed
1019 1020
           (let ((calculator-eng-tmp-show t)) (calculator-enter))))
    (let ((exp 0))
1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034
      (unless (= 0 num)
        (while (< (abs num) 1.0)
          (setq num (* num 1000.0)) (setq exp (- exp 3)))
        (while (> (abs num) 999.0)
          (setq num (/ num 1000.0)) (setq exp (+ exp 3)))
        (when (and calculator-eng-tmp-show
                   (not (= 0 calculator-eng-extra)))
          (let ((i calculator-eng-extra))
            (while (> i 0)
              (setq num (* num 1000.0)) (setq exp (- exp 3))
              (setq i (1- i)))
            (while (< i 0)
              (setq num (/ num 1000.0)) (setq exp (+ exp 3))
              (setq i (1+ i))))))
1035
      (unless calculator-eng-tmp-show (setq calculator-eng-extra nil))
1036
      (let ((str (format (format "%%.%sf" calculator-number-digits)
Dave Love's avatar
Dave Love committed
1037 1038 1039 1040 1041 1042 1043
                         num)))
        (concat (let ((calculator-remove-zeros
                       ;; make sure we don't leave integers
                       (and calculator-remove-zeros 'x)))
                  (calculator-remove-zeros str))
                "e" (number-to-string exp))))))

1044
(defun calculator-number-to-string (num)
Gerd Moellmann's avatar
Gerd Moellmann committed
1045 1046
  "Convert NUM to a displayable string."
  (cond
1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080
    ;; operators are printed here, the rest is for numbers
    ((not (numberp num)) (prin1-to-string (nth 1 num) t))
    ;; %f/%e handle these, but avoid them in radix or in user displayers
    ((and (floatp num) (isnan num)) "NaN")
    ((<= 1.0e+INF num) "Inf")
    ((<= num -1.0e+INF) "-Inf")
    (calculator-output-radix
     ;; print with radix -- for binary, convert the octal number
     (let* ((fmt (if (eq calculator-output-radix 'hex) "%x" "%o"))
            (str (if calculator-2s-complement num (abs num)))
            (str (format fmt (calculator-truncate str)))
            (bins '((?0 "000") (?1 "001") (?2 "010") (?3 "011")
                    (?4 "100") (?5 "101") (?6 "110") (?7 "111")))
            (str (if (not (eq calculator-output-radix 'bin)) str
                     (replace-regexp-in-string
                      "^0+\\(.\\)" "\\1"
                      (apply 'concat (mapcar (lambda (c)
                                               (cadr (assq c bins)))
                                     str)))))
            (str (if (not calculator-radix-grouping-mode) str
                     (calculator-groupize-number
                      str calculator-radix-grouping-digits
                      calculator-radix-grouping-separator))))
       (upcase (if (or calculator-2s-complement (>= num 0)) str
                   (concat "-" str)))))
    ((stringp calculator-displayer) (format calculator-displayer num))
    ((symbolp calculator-displayer) (funcall calculator-displayer num))
    ((eq 'std (car-safe calculator-displayer))
     (apply 'calculator-standard-displayer
            num (cdr calculator-displayer)))
    ((listp calculator-displayer)
     (eval `(let ((num ',num)) ,calculator-displayer) t))
    ;; nil (or bad) displayer
    (t (prin1-to-string num t))))
Gerd Moellmann's avatar
Gerd Moellmann committed
1081 1082 1083 1084 1085 1086

(defun 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
1087 1088
  (when (or force (not (eq (car calculator-stack-display)
                           calculator-stack)))
Gerd Moellmann's avatar
Gerd Moellmann committed
1089 1090 1091 1092
    (setq calculator-stack-display
          (cons calculator-stack
                (if calculator-stack
                  (concat
1093 1094 1095 1096 1097 1098
                   (let ((calculator-displayer
                          (if (and calculator-displayers
                                   (= 1 (length calculator-stack)))
                            ;; customizable display for a single value
                            (caar calculator-displayers)
                            calculator-displayer)))
1099
                     (mapconcat 'calculator-number-to-string
1100 1101
                                (reverse calculator-stack)
                                " "))
Gerd Moellmann's avatar
Gerd Moellmann committed
1102 1103 1104
                   " "
                   (and calculator-display-fragile
                        calculator-saved-list
1105 1106 1107 1108 1109 1110 1111 1112 1113
                        ;; Hack: use `eq' to compare the number: it's a
                        ;; flonum, so `eq' means that its the actual
                        ;; number rather than a computation that had an
                        ;; equal result (eg, enter 1,3,2, use "v" to see
                        ;; the average -- it now shows "2" instead of
                        ;; "2 [3]").
                        (eq (car calculator-stack)
                            (nth calculator-saved-ptr
                                 calculator-saved-list))
Gerd Moellmann's avatar
Gerd Moellmann committed
1114 1115 1116 1117 1118 1119 1120 1121 1122
                        (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)
1123
    (insert (calculator-get-display)))
Gerd Moellmann's avatar
Gerd Moellmann committed
1124
  (set-buffer-modified-p nil)
1125 1126 1127
  (goto-char (if calculator-display-fragile
               (1+ (length calculator-prompt))
               (1- (point)))))
Gerd Moellmann's avatar
Gerd Moellmann committed
1128

Gerd Moellmann's avatar
Gerd Moellmann committed
1129
;;;---------------------------------------------------------------------
Dave Love's avatar
Dave Love committed
1130 1131
;;; Stack computations

1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160