-;;; calculator.el --- A simple pocket calculator.
+;;; calculator.el --- a [not so] simple calculator for Emacs
-;; Copyright (C) 1998 by Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2000, 2001, 2002, 2003, 2004,
+;; 2005, 2006 Free Software Foundation, Inc.
-;; Author: Eli Barzilay <eli@lambda.cs.cornell.edu>
+;; Author: Eli Barzilay <eli@barzilay.org>
;; Keywords: tools, convenience
-;; Time-stamp: <2000-02-01 20:12:16 eli>
+;; Time-stamp: <2006-02-06 13:36:00 ttn>
;; This file is part of GNU Emacs.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-;; MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
+;; MA 02110-1301, USA.
+;;;=====================================================================
;;; Commentary:
;;
-;; A simple pocket calculator for Emacs.
-;; Why touch your mouse to get xcalc (or calc.exe), when you have Emacs?
+;; A calculator for Emacs.
+;; Why should you reach for your mouse to get xcalc (calc.exe, gcalc or
+;; whatever), when you have Emacs running already?
;;
;; 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"
-;; "Run the pocket calculator." t)
+;; "Run the Emacs calculator." t)
;; (global-set-key [(control return)] 'calculator)
;;
-;; Written by Eli Barzilay: Maze is Life! eli@cs.cornell.edu
-;; http://www.cs.cornell.edu/eli
+;; Written by Eli Barzilay: Maze is Life! eli@barzilay.org
+;; http://www.barzilay.org/
;;
;; For latest version, check
-;; http://www.cs.cornell.edu/eli/misc/calculator.el
+;; http://www.barzilay.org/misc/calculator.el
+;;
+;;; History:
+;; I hate history.
(eval-and-compile
(if (fboundp 'defgroup) nil
(defmacro defgroup (&rest forms) nil)
(defmacro defcustom (s v d &rest r) (list 'defvar s v d))))
+;;;=====================================================================
;;; Customization:
(defgroup calculator nil
- "Simple pocket calculator."
+ "Simple Emacs calculator."
:prefix "calculator"
+ :version "21.1"
:group 'tools
:group 'convenience)
(defcustom calculator-electric-mode nil
"*Run `calculator' electrically, in the echo area.
-Note that if you use electric-mode, you wouldn't be able to use
-conventional help keys."
+Electric mode saves some place but changes the way you interact with the
+calculator."
+ :type 'boolean
+ :group 'calculator)
+
+(defcustom calculator-use-menu t
+ "*Make `calculator' create a menu.
+Note that this requires easymenu. Must be set before loading."
:type 'boolean
:group 'calculator)
:type '(choice (const prefix) (const postfix))
:group 'calculator)
-(defcustom calculator-prompt "Calculator=%s> "
- "*The prompt used by the pocket calculator.
+(defcustom calculator-prompt "Calc=%s> "
+ "*The prompt used by the Emacs calculator.
It should contain a \"%s\" somewhere that will indicate the i/o radixes,
this string will be a two-character string as described in the
documentation for `calculator-mode'."
:type 'string
:group 'calculator)
-(defcustom calculator-epsilon 1e-15
- "*A threshold for results.
-If any result computed in `calculator-funcall' is smaller than this in
-its absolute value, then zero will be returned."
- :type 'number
+(defcustom calculator-number-digits 3
+ "*The calculator's number of digits used for standard display.
+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."
+ :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')."
+ :type 'boolean
+ :group 'calculator)
+
+(defcustom calculator-radix-grouping-digits 4
+ "*The number of digits used for grouping display in radix modes.
+See `calculator-radix-grouping-mode'."
+ :type 'integer
:group 'calculator)
-(defcustom calculator-number-format "%1.3f"
- "*The calculator's string used to display normal numbers."
+(defcustom calculator-radix-grouping-separator "'"
+ "*The separator used in radix grouping display.
+See `calculator-radix-grouping-mode'."
:type 'string
:group 'calculator)
-(defcustom calculator-number-exp-ulimit 1e16
- "*The calculator's upper limit for normal numbers."
- :type 'number
+(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
+for one and if it is nil, nothing is removed.
+Used by the `calculator-remove-zeros' function."
+ :type '(choice (const t) (const leave-decimal) (const nil))
:group 'calculator)
-(defcustom calculator-number-exp-llimit 0.001
- "*The calculator's lower limit for normal numbers."
- :type 'number
+(defcustom calculator-displayer '(std ?n)
+ "*A displayer specification for numerical values.
+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
+should be able to handle special symbol arguments, currently 'left and
+'right which will be sent by special keys to modify display parameters
+associated with the displayer function (for example to change the number
+of digits displayed).
+
+An exception to the above is the case of the list (std C) where C is a
+character, in this case the `calculator-standard-displayer' function
+will be used with this character for a format string."
:group 'calculator)
-(defcustom calculator-number-exp-format "%g"
- "*The calculator's string used to display exponential numbers."
- :type 'string
+(defcustom calculator-displayers
+ '(((std ?n) "Standard display, decimal point or scientific")
+ (calculator-eng-display "Eng display")
+ ((std ?f) "Standard display, decimal point")
+ ((std ?e) "Standard display, scientific")
+ ("%S" "Emacs printer"))
+ "*A list of displayers.
+Each element is a list of a displayer and a description string. The
+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'.
+
+`calculator-rotate-displayer' rotates this list."
+ :type 'sexp
:group 'calculator)
-(defcustom calculator-show-integers t
- "*Non-nil value means delete all zero digits after the decimal point."
+(defcustom calculator-paste-decimals t
+ "*If non-nil, convert pasted integers so they have a decimal point.
+This makes it possible to paste big integers since they will be read as
+floats, otherwise the Emacs reader will fail on them."
+ :type 'boolean
+ :group 'calculator)
+
+(defcustom calculator-copy-displayer nil
+ "*If non-nil, this is any value that can be used for
+`calculator-displayer', to format a string before copying it with
+`calculator-copy'. If nil, then `calculator-displayer's normal value is
+used."
:type 'boolean
:group 'calculator)
:group 'calculator)
(defcustom calculator-mode-hook nil
- "*List of hook functions run by `calculator-mode'."
+ "*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)
(defcustom calculator-user-registers nil
"*An association list of user-defined register bindings.
-
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:
- (setq calculator-user-registers '((?g . 1.61803398875)))"
+ (setq calculator-user-registers '((?g . 1.61803398875)))
+before you load calculator."
:type '(repeat (cons character number))
:set '(lambda (_ val)
(and (boundp 'calculator-registers)
(defcustom calculator-user-operators nil
"*A list of additional operators.
-
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
Examples:
-* A very simple one, adding a postfix \"x-to-y\" convertion keys, using
- `t' as a prefix key:
+* A very simple one, adding a postfix \"x-to-y\" conversion keys, using
+ t as a prefix key:
(setq calculator-user-operators
'((\"tf\" cl-to-fr (+ 32 (/ (* X 9) 5)) 1)
(add-to-list 'calculator-user-operators
'(\"F\" fib (if (<= TX 1)
- 1
- (+ (F (- TX 1)) (F (- TX 2)))) 0))
+ 1
+ (+ (F (- TX 1)) (F (- TX 2)))) 0))
Note that this will be either postfix or prefix, according to
`calculator-unary-style'."
:type '(repeat (list string symbol sexp integer integer))
:group 'calculator)
+;;;=====================================================================
;;; Code:
+;;;---------------------------------------------------------------------
+;;; Variables
+
(defvar calculator-initial-operators
- '(;; these have keybindings of themselves, not calculator-ops
- (nobind "=" = identity 1 -1)
- (nobind "+" + + 2 4)
- (nobind "-" - - 2 4)
- (nobind "+" + + -1 9)
- (nobind "-" - - -1 9)
- (nobind "(" \( identity -1 -1)
- (nobind ")" \) identity +1 10)
+ '(;; "+"/"-" have keybindings of themselves, not calculator-ops
+ ("=" = identity 1 -1)
+ (nobind "+" + + 2 4)
+ (nobind "-" - - 2 4)
+ (nobind "+" + + -1 9)
+ (nobind "-" - - -1 9)
+ ("(" \( identity -1 -1)
+ (")" \) identity +1 10)
;; normal keys
("|" or (logior TX TY) 2 2)
("#" xor (logxor TX TY) 2 2)
("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
(list of saved values), `F' (function for recursive iteration calls)
and evaluates to the function value - these variables are capital;
-4. The function's arity, optional, one of: 2=binary, -1=prefix unary,
- +1=postfix unary, 0=a 0-arg operator func, non-number=postfix/prefix
- as determined by `calculator-unary-style' (the default);
+4. The function's arity, optional, one of: 2 => binary, -1 => prefix
+ unary, +1 => postfix unary, 0 => a 0-arg operator func, non-number =>
+ postfix/prefix as determined by `calculator-unary-style' (the
+ default);
-5. The function's precedence - should be in the range of 1=lowest to
- 9=highest (optional, defaults to 1);
+5. The function's precedence - should be in the range of 1 (lowest) to
+ 9 (highest) (optional, defaults to 1);
It it possible have a unary prefix version of a binary operator if it
comes later in this list. If the list begins with the symbol 'nobind,
(defvar calculator-buffer nil
"The current calculator buffer.")
-(defvar calculator-forced-input nil
- "Used to make alias events, e.g., make Return equivalent to `='.")
+(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'.")
(defvar calculator-last-opXY nil
"The last binary operation and its arguments.
(defvar calculator-saved-global-map nil
"Saved global key map.")
+(defvar calculator-restart-other-mode nil
+ "Used to hack restarting with the electric mode changed.")
+
+;;;---------------------------------------------------------------------
+;;; Key bindings
+
(defvar calculator-mode-map nil
"The calculator key map.")
(or calculator-mode-map
- (let ((map (make-sparse-keymap "Calculator")))
+ (let ((map (make-sparse-keymap)))
(suppress-keymap map t)
(define-key map "i" nil)
(define-key map "o" nil)
- (let ((p '(calculator-open-paren "(" "[" "{"
- calculator-close-paren ")" "]" "}"
- calculator-op-or-exp "+" "-" [kp-add] [kp-subtract]
- 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-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"
- "iD" "iH" "iX" "iO" "iB"
- calculator-radix-output-mode "od" "oh" "ox" "oo" "ob"
- "oD" "oH" "oX" "oO" "oB"
- calculator-saved-up [?\C-p] [up]
- calculator-saved-down [?\C-n] [down]
- calculator-quit "q" [?\C-g]
- calculator-enter [enter] [linefeed] [kp-enter]
- [?\r] [?\n]
- calculator-save-on-list " " [space]
- calculator-clear-saved [?\C-c] [(control delete)]
- calculator-save-and-quit [(control return)]
- [(control kp-enter)]
- calculator-paste [insert] [(shift insert)]
- calculator-clear [delete] [?\C-?] [?\C-d]
- calculator-help [?h] [??] [f1] [help]
- calculator-copy [(control insert)]
- calculator-backspace [backspace]
- ))
- (f nil))
+ (let ((p
+ '((calculator-open-paren "[")
+ (calculator-close-paren "]")
+ (calculator-op-or-exp "+" "-" [kp-add] [kp-subtract])
+ (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-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"
+ "iD" "iH" "iX" "iO" "iB")
+ (calculator-radix-output-mode "od" "oh" "ox" "oo" "ob"
+ "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] [?\r] [?\n])
+ (calculator-save-on-list " " [space])
+ (calculator-clear-saved [?\C-c] [(control delete)])
+ (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
- (cond
- ((symbolp (car p)) (setq f (car p)))
- (p (define-key map (car p) f)))
+ ;; reverse the keys so first defs come last - makes the more
+ ;; sensible bindings visible in the menu
+ (let ((func (car (car p))) (keys (reverse (cdr (car p)))))
+ (while keys
+ (define-key map (car keys) func)
+ (setq keys (cdr keys))))
(setq p (cdr p))))
(if calculator-bind-escape
(progn (define-key map [?\e] 'calculator-quit)
(define-key map [?\e ?\e ?\e] 'calculator-quit))
;; make C-h work in text-mode
(or window-system (define-key map [?\C-h] 'calculator-backspace))
+ ;; set up a menu
+ (if (and calculator-use-menu (not (boundp 'calculator-menu)))
+ (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"))))
+ (op '(lambda (name key)
+ `[,name (calculator-op ,key) :keys ,key])))
+ (easy-menu-define
+ calculator-menu map "Calculator menu."
+ `("Calculator"
+ ["Help"
+ (let ((last-command 'calculator-help)) (calculator-help))
+ :keys "?"]
+ "---"
+ ["Copy" calculator-copy]
+ ["Paste" calculator-paste]
+ "---"
+ ["Electric mode"
+ (progn (calculator-quit)
+ (setq calculator-restart-other-mode t)
+ (run-with-timer 0.1 nil '(lambda () (message nil)))
+ ;; 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]
+ "---"
+ ("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]
+ "---"
+ ,(funcall op "List-total" "l")
+ ,(funcall op "List-average" "v"))
+ ("Registers"
+ ["Get register" calculator-get-register]
+ ["Set register" calculator-set-register])
+ ("Modes"
+ ["Radians"
+ (progn
+ (and (or calculator-input-radix calculator-output-radix)
+ (calculator-radix-mode "D"))
+ (and calculator-deg (calculator-dec/deg-mode)))
+ :keys "D"
+ :style radio
+ :selected (not (or calculator-input-radix
+ calculator-output-radix
+ calculator-deg))]
+ ["Degrees"
+ (progn
+ (and (or calculator-input-radix calculator-output-radix)
+ (calculator-radix-mode "D"))
+ (or calculator-deg (calculator-dec/deg-mode)))
+ :keys "D"
+ :style radio
+ :selected (and calculator-deg
+ (not (or calculator-input-radix
+ calculator-output-radix)))]
+ "---"
+ ,@(mapcar 'car radix-selectors)
+ ("Seperate 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])
+ "---"
+ ["Copy+Quit" calculator-save-and-quit]
+ ["Quit" calculator-quit]))))
(setq calculator-mode-map map)))
+;;;---------------------------------------------------------------------
+;;; Startup and mode stuff
+
(defun calculator-mode ()
- "A simple pocket calculator in Emacs.
+ ;; this help is also used as the major help screen
+ "A [not so] simple calculator for Emacs.
This calculator is used in the same way as other popular calculators
like xcalc or calc.exe - but using an Emacs interface.
Here are the editing keys:
* `RET' `=' evaluate the current expression
* `C-insert' copy the whole current expression to the `kill-ring'
-* `C-enter' evaluate, save result the `kill-ring' and exit
+* `C-return' evaluate, save result the `kill-ring' and exit
* `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
* \"=?\": (? 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.
(setq major-mode 'calculator-mode)
(setq mode-name "Calculator")
(use-local-map calculator-mode-map)
- (run-hooks 'calculator-mode-hook))
+ (run-mode-hooks 'calculator-mode-hook))
+
+(eval-when-compile (require 'electric) (require 'ehelp))
;;;###autoload
(defun calculator ()
- "Run the pocket calculator.
+ "Run the Emacs calculator.
See the documentation for `calculator-mode' for more information."
(interactive)
- (if calculator-electric-mode
- (progn (require 'electric)
- (message nil))) ; hide load message
- (setq calculator-buffer
- (or (and (bufferp calculator-buffer)
- (buffer-live-p calculator-buffer)
- calculator-buffer)
- (if calculator-electric-mode
- (get-buffer-create "*calculator*")
- (let ((split-window-keep-point nil)
- (window-min-height 2))
- (select-window
- (split-window-vertically (- (window-height) 2)))
- (switch-to-buffer
- (get-buffer-create "*calculator*"))))))
- (set-buffer calculator-buffer)
- (calculator-mode)
- (setq buffer-read-only t)
+ (if calculator-restart-other-mode
+ (setq calculator-electric-mode (not calculator-electric-mode)))
(if calculator-initial-operators
(progn (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.
+ ;; its set function will add any new operators
(calculator-add-operators calculator-user-operators)))
- (calculator-reset)
- (calculator-update-display)
+ (setq calculator-buffer (get-buffer-create "*calculator*"))
(if calculator-electric-mode
(save-window-excursion
+ (progn (require 'electric) (message nil)) ; hide load message
(let (old-g-map old-l-map (echo-keystrokes 0)
(garbage-collection-messages nil)) ; no gc msg when electric
- (kill-buffer calculator-buffer)
- ;; strange behavior in FSF: doesn't always select correct
- ;; minibuffer. I have no idea how to fix this
- (setq calculator-buffer (window-buffer (minibuffer-window)))
+ (set-window-buffer (minibuffer-window) calculator-buffer)
(select-window (minibuffer-window))
(calculator-reset)
(calculator-update-display)
(setq old-l-map (current-local-map))
(setq old-g-map (current-global-map))
(setq calculator-saved-global-map (current-global-map))
- (use-local-map calculator-mode-map)
+ (use-local-map nil)
(use-global-map calculator-mode-map)
+ (run-hooks 'calculator-mode-hook)
(unwind-protect
(catch 'calculator-done
(Electric-command-loop
;; can't use 'noprompt, bug in electric.el
'(lambda () 'noprompt)
nil
- (lambda (x y)
- (calculator-update-display))))
+ (lambda (x y) (calculator-update-display))))
(and calculator-buffer
(catch 'calculator-done (calculator-quit)))
(use-local-map old-l-map)
(use-global-map old-g-map))))
- (message "Hit `?' For a quick help screen.")))
+ (progn
+ (cond
+ ((not (get-buffer-window calculator-buffer))
+ (let ((split-window-keep-point nil)
+ (window-min-height 2))
+ ;; maybe leave two lines for our window because of the normal
+ ;; `raised' modeline in Emacs 21
+ (select-window
+ (split-window-vertically
+ (if (and (fboundp 'face-attr-construct)
+ (plist-get (face-attr-construct 'modeline) :box))
+ -3 -2)))
+ (switch-to-buffer calculator-buffer)))
+ ((not (eq (current-buffer) calculator-buffer))
+ (select-window (get-buffer-window calculator-buffer))))
+ (calculator-mode)
+ (setq buffer-read-only t)
+ (calculator-reset)
+ (message "Hit `?' For a quick help screen.")))
+ (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
(defun calculator-op-arity (op)
"Return OP's arity, 2, +1 or -1."
(setq calculator-operators
(append (nreverse added-ops) calculator-operators))))
+;;;---------------------------------------------------------------------
+;;; Display stuff
+
(defun calculator-reset ()
"Reset calculator variables."
- (setq calculator-stack nil
- calculator-curnum nil
- calculator-stack-display nil
- calculator-display-fragile nil)
+ (or calculator-restart-other-mode
+ (setq calculator-stack nil
+ calculator-curnum nil
+ calculator-stack-display nil
+ calculator-display-fragile nil))
+ (setq calculator-restart-other-mode nil)
(calculator-update-display))
(defun calculator-get-prompt ()
(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"))))))
-
-(defun calculator-num-to-string (num)
+ (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.
+the behavior of this function is controlled by
+`calculator-remove-zeros'."
+ (cond ((and (eq calculator-remove-zeros t)
+ (string-match "\\.0+\\([eE][+-]?[0-9]*\\)?$" numstr))
+ ;; remove all redundant zeros leaving an integer
+ (if (match-beginning 1)
+ (concat (substring numstr 0 (match-beginning 0))
+ (match-string 1 numstr))
+ (substring numstr 0 (match-beginning 0))))
+ ((and calculator-remove-zeros
+ (string-match
+ "\\..\\([0-9]*[1-9]\\)?\\(0+\\)\\([eE][+-]?[0-9]*\\)?$"
+ numstr))
+ ;; remove zeros, except for first after the "."
+ (if (match-beginning 3)
+ (concat (substring numstr 0 (match-beginning 2))
+ (match-string 3 numstr))
+ (substring numstr 0 (match-beginning 2))))
+ (t numstr)))
+
+(defun calculator-standard-displayer (num char)
+ "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.
+
+The special 'left and 'right symbols will make it change the current
+number of digits displayed (`calculator-number-digits').
+
+It will also remove redundant zeros from the result."
+ (if (symbolp num)
+ (cond ((eq num 'left)
+ (and (> calculator-number-digits 0)
+ (setq calculator-number-digits
+ (1- calculator-number-digits))
+ (calculator-enter)))
+ ((eq num 'right)
+ (setq calculator-number-digits
+ (1+ calculator-number-digits))
+ (calculator-enter)))
+ (let ((str (if (zerop num)
+ "0"
+ (format
+ (concat "%."
+ (number-to-string calculator-number-digits)
+ (if (eq char ?n)
+ (let ((n (abs num)))
+ (if (or (< n 0.001) (> n 1e8)) "e" "f"))
+ (string char)))
+ num))))
+ (calculator-remove-zeros str))))
+
+(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
+the 'left or 'right when one of the standard modes is used."
+ (if (symbolp num)
+ (cond ((eq num 'left)
+ (setq calculator-eng-extra
+ (if calculator-eng-extra
+ (1+ calculator-eng-extra)
+ 1))
+ (let ((calculator-eng-tmp-show t)) (calculator-enter)))
+ ((eq num 'right)
+ (setq calculator-eng-extra
+ (if calculator-eng-extra
+ (1- calculator-eng-extra)
+ -1))
+ (let ((calculator-eng-tmp-show t)) (calculator-enter))))
+ (let ((exp 0))
+ (and (not (= 0 num))
+ (progn
+ (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)))
+ (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)))))))
+ (or calculator-eng-tmp-show (setq calculator-eng-extra nil))
+ (let ((str (format (concat "%." (number-to-string
+ calculator-number-digits)
+ "f")
+ 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))))))
+
+(defun calculator-number-to-string (num)
"Convert NUM to a displayable string."
(cond
((and (numberp num) calculator-output-radix)
(?6 . "110") (?7 . "111")))))))
(string-match "^0*\\(.+\\)" s)
(setq str (match-string 1 s))))
+ (if calculator-radix-grouping-mode
+ (let ((d (/ (length str) calculator-radix-grouping-digits))
+ (r (% (length str) calculator-radix-grouping-digits)))
+ (while (>= (setq d (1- d)) (if (zerop r) 1 0))
+ (let ((i (+ r (* d calculator-radix-grouping-digits))))
+ (setq str (concat (substring str 0 i)
+ calculator-radix-grouping-separator
+ (substring str i)))))))
(upcase
(if (and (not calculator-2s-complement) (< num 0))
(concat "-" str)
str))))
- ((and (numberp num)
- ;; is this a normal-range number?
- (>= (abs num) calculator-number-exp-llimit)
- (< (abs num) calculator-number-exp-ulimit))
- (let ((str (format calculator-number-format num)))
- (cond
- ((and calculator-show-integers (string-match "\\.?0+$" str))
- ;; remove all redundant zeros
- (substring str 0 (match-beginning 0)))
- ((and (not calculator-show-integers)
- (string-match "\\..\\(.*[^0]\\)?\\(0+\\)$" str))
- ;; remove zeros, except for first after the "."
- (substring str 0 (match-beginning 2)))
- (t str))))
- ((numberp num) (format calculator-number-exp-format num))
+ ((and (numberp num) calculator-displayer)
+ (cond
+ ((stringp calculator-displayer)
+ (format calculator-displayer num))
+ ((symbolp calculator-displayer)
+ (funcall calculator-displayer num))
+ ((and (consp calculator-displayer)
+ (eq 'std (car calculator-displayer)))
+ (calculator-standard-displayer num (cadr calculator-displayer)))
+ ((listp calculator-displayer)
+ (eval calculator-displayer))
+ (t (prin1-to-string num t))))
+ ;; operators are printed here
(t (prin1-to-string (nth 1 num) t))))
(defun calculator-update-display (&optional force)
(cons calculator-stack
(if calculator-stack
(concat
- (mapconcat 'calculator-num-to-string
- (reverse calculator-stack)
- " ")
+ (let ((calculator-displayer
+ (if (and calculator-displayers
+ (= 1 (length calculator-stack)))
+ ;; customizable display for a single value
+ (caar calculator-displayers)
+ calculator-displayer)))
+ (mapconcat 'calculator-number-to-string
+ (reverse calculator-stack)
+ " "))
" "
(and calculator-display-fragile
calculator-saved-list
(goto-char (1+ (length calculator-prompt)))
(goto-char (1- (point)))))
+;;;---------------------------------------------------------------------
+;;; Stack computations
+
(defun calculator-reduce-stack (prec)
"Reduce the stack using top operator.
PREC is a precedence - reduce everything with higher precedence."
(t ;; no more iterations
nil))))
-(eval-when-compile ; silence the compiler
- (or (fboundp 'event-key)
- (defun event-key (&rest _) nil))
- (or (fboundp 'key-press-event-p)
- (defun key-press-event-p (&rest _) nil)))
+(defun calculator-funcall (f &optional X Y)
+ "If F is a symbol, evaluate (F X Y).
+Otherwise, it should be a list, evaluate it with X, Y bound to the
+arguments."
+ ;; remember binary ops for calculator-repR/L
+ (if Y (setq calculator-last-opXY (list f X Y)))
+ (condition-case nil
+ ;; there used to be code here that returns 0 if the result was
+ ;; smaller than calculator-epsilon (1e-15). I don't think this is
+ ;; necessary now.
+ (if (symbolp f)
+ (cond ((and X Y) (funcall f X Y))
+ (X (funcall f X))
+ (t (funcall f)))
+ ;; f is an expression
+ (let* ((__f__ f) ; so we can get this value below...
+ (TX (calculator-truncate X))
+ (TY (and Y (calculator-truncate Y)))
+ (DX (if calculator-deg (/ (* X pi) 180) X))
+ (L calculator-saved-list)
+ (Fbound (fboundp 'F))
+ (Fsave (and Fbound (symbol-function 'F)))
+ (Dbound (fboundp 'D))
+ (Dsave (and Dbound (symbol-function 'D))))
+ ;; a shortened version of flet
+ (fset 'F (function
+ (lambda (&optional x y)
+ (calculator-funcall __f__ x y))))
+ (fset 'D (function
+ (lambda (x)
+ (if calculator-deg (/ (* x 180) pi) x))))
+ (unwind-protect (eval f)
+ (if Fbound (fset 'F Fsave) (fmakunbound 'F))
+ (if Dbound (fset 'D Dsave) (fmakunbound 'D)))))
+ (error 0)))
+
+;;;---------------------------------------------------------------------
+;;; Input interaction
-(defun calculator-last-input ()
- "Last char (or event or event sequence) that was read."
- (let ((inp (or calculator-forced-input (this-command-keys))))
+(defun calculator-last-input (&optional keys)
+ "Last char (or event or event sequence) that was read.
+Optional string argument KEYS will force using it as the keys entered."
+ (let ((inp (or keys (this-command-keys))))
(if (or (stringp inp) (not (arrayp inp)))
inp
;; this translates kp-x to x and [tries to] create a string to
(setq k (aref inp i))
;; if Emacs will someday have a event-key, then this would
;; probably be modified anyway
- (and (fboundp 'event-key) (key-press-event-p k)
- (setq k (event-key k)))
+ (and (if (fboundp 'key-press-event-p) (key-press-event-p k))
+ (if (fboundp 'event-key)
+ (and (event-key k) (setq k (event-key k)))))
;; assume all symbols are translatable with an ascii-character
(and (symbolp k)
(setq k (or (get k 'ascii-character) ? )))
(= -1 (calculator-op-arity op))
(= 0 (calculator-op-arity op))))
;; reset if last calc finished, and now get a num or prefix or 0-ary
- ;; op.
+ ;; op
(calculator-reset))
(setq calculator-display-fragile nil))
((eq calculator-input-radix 'oct) (<= inp ?7))
(t t)))
;; enter digit if starting a new computation or have an op on the
- ;; stack.
+ ;; stack
(progn
(calculator-clear-fragile)
(let ((digit (upcase (char-to-string inp))))
(not (and calculator-curnum
(string-match "[.eE]" calculator-curnum))))
;; enter the period on the same condition as a digit, only if no
- ;; period or exponent entered yet.
+ ;; period or exponent entered yet
(progn
(calculator-clear-fragile)
(setq calculator-curnum (concat (or calculator-curnum "0") "."))
(not (numberp (car calculator-stack))))
(not (and calculator-curnum
(string-match "[eE]" calculator-curnum))))
- ;; same condition as above, also no E so far.
+ ;; same condition as above, also no E so far
(progn
(calculator-clear-fragile)
(setq calculator-curnum (concat (or calculator-curnum "1") "e"))
(calculator-update-display)))))
-(defun calculator-op ()
- "Enter an operator on the stack, doing all necessary reductions."
+(defun calculator-op (&optional keys)
+ "Enter an operator on the stack, doing all necessary reductions.
+Optional string argument KEYS will force using it as the keys entered."
(interactive)
- (let* ((last-inp (calculator-last-input))
- (op (assoc last-inp calculator-operators)))
- (calculator-clear-fragile op)
- (if (and calculator-curnum (/= (calculator-op-arity op) 0))
- (setq calculator-stack
- (cons (calculator-curnum-value) calculator-stack)))
- (setq calculator-curnum nil)
- (if (and (= 2 (calculator-op-arity op))
- (not (and calculator-stack
- (numberp (nth 0 calculator-stack)))))
- ;; we have a binary operator but no number - search for a prefix
- ;; version
- (let ((rest-ops calculator-operators))
- (while (not (equal last-inp (car (car rest-ops))))
- (setq rest-ops (cdr rest-ops)))
- (setq op (assoc last-inp (cdr rest-ops)))
- (if (not (and op (= -1 (calculator-op-arity op))))
- (error "Binary operator without a first operand"))))
- (calculator-reduce-stack
- (cond ((eq (nth 1 op) '\() 10)
- ((eq (nth 1 op) '\)) 0)
- (t (calculator-op-prec op))))
- (if (or (and (= -1 (calculator-op-arity op))
- (numberp (car calculator-stack)))
- (and (/= (calculator-op-arity op) -1)
- (/= (calculator-op-arity op) 0)
- (not (numberp (car calculator-stack)))))
- (error "Unterminated expression"))
- (setq calculator-stack (cons op calculator-stack))
- (calculator-reduce-stack (calculator-op-prec op))
- (and (= (length calculator-stack) 1)
- (numberp (nth 0 calculator-stack))
- ;; the display is fragile if it contains only one number
- (setq calculator-display-fragile t)
- ;; add number to the saved-list
- calculator-add-saved
- (if (= 0 calculator-saved-ptr)
- (setq calculator-saved-list
- (cons (car calculator-stack) calculator-saved-list))
- (let ((p (nthcdr (1- calculator-saved-ptr)
- calculator-saved-list)))
- (setcdr p (cons (car calculator-stack) (cdr p))))))
- (calculator-update-display)))
+ (catch 'op-error
+ (let* ((last-inp (calculator-last-input keys))
+ (op (assoc last-inp calculator-operators)))
+ (calculator-clear-fragile op)
+ (if (and calculator-curnum (/= (calculator-op-arity op) 0))
+ (setq calculator-stack
+ (cons (calculator-curnum-value) calculator-stack)))
+ (setq calculator-curnum nil)
+ (if (and (= 2 (calculator-op-arity op))
+ (not (and calculator-stack
+ (numberp (nth 0 calculator-stack)))))
+ ;; we have a binary operator but no number - search for a prefix
+ ;; version
+ (let ((rest-ops calculator-operators))
+ (while (not (equal last-inp (car (car rest-ops))))
+ (setq rest-ops (cdr rest-ops)))
+ (setq op (assoc last-inp (cdr rest-ops)))
+ (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)
+ ((eq (nth 1 op) '\)) 0)
+ (t (calculator-op-prec op))))
+ (if (or (and (= -1 (calculator-op-arity op))
+ (numberp (car calculator-stack)))
+ (and (/= (calculator-op-arity op) -1)
+ (/= (calculator-op-arity op) 0)
+ (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))
+ (and (= (length calculator-stack) 1)
+ (numberp (nth 0 calculator-stack))
+ ;; the display is fragile if it contains only one number
+ (setq calculator-display-fragile t)
+ ;; add number to the saved-list
+ calculator-add-saved
+ (if (= 0 calculator-saved-ptr)
+ (setq calculator-saved-list
+ (cons (car calculator-stack) calculator-saved-list))
+ (let ((p (nthcdr (1- calculator-saved-ptr)
+ calculator-saved-list)))
+ (setcdr p (cons (car calculator-stack) (cdr p))))))
+ (calculator-update-display))))
(defun calculator-op-or-exp ()
"Either enter an operator or a digit.
-Used with +/- for entering them as digits in numbers like 1e-3."
+Used with +/- for entering them as digits in numbers like 1e-3 (there is
+no need for negative numbers since these are handled by unary
+operators)."
(interactive)
(if (and (not calculator-display-fragile)
calculator-curnum
(calculator-digit)
(calculator-op)))
+;;;---------------------------------------------------------------------
+;;; Input/output modes (not display)
+
(defun calculator-dec/deg-mode ()
"Set decimal mode for display & input, if decimal, toggle deg mode."
(interactive)
(setq calculator-deg (not calculator-deg)))
(calculator-update-display t))
-(defun calculator-radix-mode ()
- "Set input and display radix modes."
+(defun calculator-radix-mode (&optional keys)
+ "Set input and display radix modes.
+Optional string argument KEYS will force using it as the keys entered."
(interactive)
- (calculator-radix-input-mode)
- (calculator-radix-output-mode))
+ (calculator-radix-input-mode keys)
+ (calculator-radix-output-mode keys))
-(defun calculator-radix-input-mode ()
- "Set input radix modes."
+(defun calculator-radix-input-mode (&optional keys)
+ "Set input radix modes.
+Optional string argument KEYS will force using it as the keys entered."
(interactive)
(if calculator-curnum
(setq calculator-stack
(cons (calculator-curnum-value) calculator-stack)))
(setq calculator-curnum nil)
(setq calculator-input-radix
- (let ((inp (calculator-last-input)))
+ (let ((inp (calculator-last-input keys)))
(cdr (assq (upcase (aref inp (1- (length inp))))
calculator-char-radix))))
(calculator-update-display))
-(defun calculator-radix-output-mode ()
- "Set display radix modes."
+(defun calculator-radix-output-mode (&optional keys)
+ "Set display radix modes.
+Optional string argument KEYS will force using it as the keys entered."
(interactive)
(if calculator-curnum
(setq calculator-stack
(cons (calculator-curnum-value) calculator-stack)))
(setq calculator-curnum nil)
(setq calculator-output-radix
- (let ((inp (calculator-last-input)))
+ (let ((inp (calculator-last-input keys)))
(cdr (assq (upcase (aref inp (1- (length inp))))
calculator-char-radix))))
(calculator-update-display t))
+;;;---------------------------------------------------------------------
+;;; Saved values list
+
(defun calculator-save-on-list ()
"Evaluate current expression, put result on the saved values list."
(interactive)
"Clear the list of saved values in `calculator-saved-list'."
(interactive)
(setq calculator-saved-list nil)
+ (setq calculator-saved-ptr 0)
(calculator-update-display t))
(defun calculator-saved-move (n)
(setq calculator-stack
(list (nth calculator-saved-ptr calculator-saved-list))
calculator-display-fragile t)
- (calculator-reset)))))
+ (calculator-reset))
+ (calculator-update-display))))
(defun calculator-saved-up ()
"Go up the list of saved values."
(interactive)
(calculator-saved-move -1))
+;;;---------------------------------------------------------------------
+;;; Misc functions
+
(defun calculator-open-paren ()
"Equivalents of `(' use this."
(interactive)
- (let ((calculator-forced-input "("))
- (calculator-op)))
+ (calculator-op "("))
(defun calculator-close-paren ()
"Equivalents of `)' use this."
(interactive)
- (let ((calculator-forced-input ")"))
- (calculator-op)))
+ (calculator-op ")"))
(defun calculator-enter ()
- "Make Enter equivalent to `='."
+ "Evaluate current expression."
(interactive)
- (let ((calculator-forced-input "="))
- (calculator-op)))
+ (calculator-op "="))
(defun calculator-backspace ()
"Backward delete a single digit or a stack element."
(defun calculator-copy ()
"Copy current number to the `kill-ring'."
(interactive)
- (calculator-enter)
- ;; remove trailing .0 and spaces .0
- (let ((s (cdr calculator-stack-display)))
- (if (string-match "^\\(.*[^ ]\\) *$" s)
- (setq s (match-string 1 s)))
- (kill-new s)))
+ (let ((calculator-displayer
+ (or calculator-copy-displayer calculator-displayer))
+ (calculator-displayers
+ (if calculator-copy-displayer nil calculator-displayers)))
+ (calculator-enter)
+ ;; remove trailing spaces and an index
+ (let ((s (cdr calculator-stack-display)))
+ (and s
+ (if (string-match "^\\([^ ]+\\) *\\(\\[[0-9/]+\\]\\)? *$" s)
+ (setq s (match-string 1 s)))
+ (kill-new s)))))
(defun calculator-set-register (reg)
"Set a register value for REG."
(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.
(not (numberp (car calculator-stack)))))
(progn
(calculator-clear-fragile)
- (setq calculator-curnum (calculator-num-to-string val))
+ (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
- (condition-case nil (car (read-from-string (current-kill 0)))
- (error nil))))
+ (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)
"Get a value from a register REG."
+ - * / \\(div) %(rem) _(-X,postfix) ;(1/X,postfix) ^(exp) L(og)
Q(sqrt) !(fact) S(in) C(os) T(an) |(or) #(xor) &(and) ~(not)
* >/< repeats last binary operation with its 2nd (1st) arg as postfix op
-* I inverses next trig function
-* D - switch to all-decimal mode, or toggles deg/rad mode
+* I inverses next trig function * '/\"/{} - display/display args
+* D - switch to all-decimal, or toggle deg/rad mode
* B/O/H/X - binary/octal/hex mode for i/o (X is a shortcut for H)
* i/o - prefix for d/b/o/x - set only input/output modes
* enter/= - evaluate current expr. * s/g - set/get a register
* space - evaluate & save on list * l/v - list total/average
* up/down/C-p/C-n - browse saved * C-delete - clear all saved
-* C-insert - copy whole expr. * C-enter - evaluate, copy, exit
+* C-insert - copy whole expr. * C-return - evaluate, copy, exit
* insert - paste a number * backspace- delete backwards
* delete - clear argument or list value or whole expression (twice)
* escape/q - exit."
(require 'ehelp)
(if calculator-electric-mode
(use-global-map calculator-saved-global-map))
- (electric-describe-mode)
+ (if (or (not calculator-electric-mode)
+ ;; XEmacs has a problem with electric-describe-mode
+ (string-match "XEmacs" (emacs-version)))
+ (describe-mode)
+ (electric-describe-mode))
(if calculator-electric-mode
(use-global-map g-map))
(select-window win) ; these are for XEmacs (also below)
(calculator-copy)
(calculator-quit))
-(defun calculator-funcall (f &optional X Y)
- "If F is a symbol, evaluate (F X Y).
-Otherwise, it should be a list, evaluate it with X, Y bound to the
-arguments."
- ;; remember binary ops for calculator-repR/L
- (if Y (setq calculator-last-opXY (list f X Y)))
- (condition-case nil
- (let ((result
- (if (symbolp f)
- (cond ((and X Y) (funcall f X Y))
- (X (funcall f X))
- (t (funcall f)))
- ;; f is an expression
- (let* ((__f__ f) ; so we can get this value below...
- (TX (calculator-truncate X))
- (TY (and Y (calculator-truncate Y)))
- (DX (if calculator-deg (/ (* X pi) 180) X))
- (L calculator-saved-list)
- (Fbound (fboundp 'F))
- (Fsave (and Fbound (symbol-function 'F)))
- (Dbound (fboundp 'D))
- (Dsave (and Dbound (symbol-function 'D))))
- ;; a shortened version of flet
- (fset 'F (function
- (lambda (&optional x y)
- (calculator-funcall __f__ x y))))
- (fset 'D (function
- (lambda (x)
- (if calculator-deg (/ (* x 180) pi) x))))
- (unwind-protect (eval f)
- (if Fbound (fset 'F Fsave) (fmakunbound 'F))
- (if Dbound (fset 'D Dsave) (fmakunbound 'D)))))))
- (if (< (abs result) calculator-epsilon)
- 0
- result))
- (error 0)))
-
(defun calculator-repR (x)
"Repeats the last binary operation with its second argument and X.
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."
(provide 'calculator)
+;;; arch-tag: a1b9766c-af8a-4a74-b466-65ad8eeb0c73
;;; calculator.el ends here