emacs: lisp/calculator.el comparison

comparison lisp/calculator.el @ 33491:23166da66d5f

New maintainer version.

author	Dave Love <fx@gnu.org>
date	Tue, 14 Nov 2000 18:51:34 +0000
parents	5f9c434a6e88
children	dd42fdd51753

comparison

equal deleted inserted replaced

-:b714a06b99ec
+:23166da66d5f
-;;; 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 by Free Software Foundation, Inc.
-;; Author: Eli Barzilay <eli@lambda.cs.cornell.edu>
+;; Author: Eli Barzilay <eli@www.barzilay.org>
 ;; Keywords: tools, convenience
-;; Time-stamp: <2000-02-16 21:07:54 eli>
+;; Time-stamp: <2000-11-07 15:04:06 eli>
 ;; This file is part of GNU Emacs.
 ;; 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
 ;; 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.
+;;;============================================================================
 ;;; Commentary:
 ;;
-;; A simple pocket calculator for Emacs.
+;; A calculator for Emacs.
-;; Why touch your mouse to get xcalc (or calc.exe), when you have Emacs?
+;; Why should you each 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
+;; Written by Eli Barzilay: Maze is Life!  eli@barzilay.org
-;;                                         http://www.cs.cornell.edu/eli
+;;                                         http://www.barzilay.org/
 ;;
 ;; For latest version, check
-;;     http://www.cs.cornell.edu/eli/misc/calculator.el
+;;     http://www.barzilay.org/misc/calculator.el
 (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
+Electric mode saves some place but changes the way you interact with the
-conventional help keys."
+calculator."
 :type  'boolean
 :group 'calculator)
 (defcustom calculator-use-menu t
 "*Make `calculator' create a menu.
 "*Value is either 'prefix or 'postfix.
 This determines the default behavior of unary operators."
 :type    '(choice (const prefix) (const postfix))
 :group   'calculator)
-(defcustom calculator-prompt "Calculator=%s> "
+(defcustom calculator-prompt "Calc=%s> "
-"*The prompt used by the pocket calculator.
+"*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
+(defcustom calculator-number-digits 3
-"*A threshold for results.
+"*The calculator's number of digits used for standard display.
-If any result computed in `calculator-funcall' is smaller than this in
+Used by the `calculator-standard-display' function - it will use the
-its absolute value, then zero will be returned."
+format string \"%.NC\" where this number is N and C is a character given
-:type  'number
+at runtime."
-:group 'calculator)
-(defcustom calculator-number-format "%1.3f"
-"*The calculator's string used to display normal numbers."
 :type  'string
 :group 'calculator)
-(defcustom calculator-number-exp-ulimit 1e16
+(defcustom calculator-remove-zeros t
-"*The calculator's upper limit for normal numbers."
+"*Non-nil value means delete all redundant zero decimal digits.
-:type  'number
+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
+(defcustom calculator-displayer '(std ?n)
-"*The calculator's lower limit for normal numbers."
+"*A displayer specification for numerical values.
-:type  'number
+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.")
+(defcustom calculator-displayers
+'(((std ?n) "Standard dislpay, decimal point or scientific")
+(calculator-eng-display "Eng display")
+((std ?f) "Standard display, decimal point")
+((std ?e) "Standard dislpay, 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 curently 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-number-exp-format "%g"
+(defcustom calculator-paste-decimals t
-"*The calculator's string used to display exponential numbers."
+"*If non-nil, convert pasted integers so they have a decimal point.
-:type  'string
+This makes it possible to paste big integers since they will be read as
-:group 'calculator)
+floats, otherwise the Emacs reader will fail on them."
-(defcustom calculator-show-integers t
-"*Non-nil value means delete all zero digits after the decimal point."
 :type  'boolean
 :group 'calculator)
 (defcustom calculator-2s-complement nil
 "*If non-nil, show negative numbers in 2s complement in radix modes.
 Otherwise show as a negative number."
 :type  'boolean
 :group 'calculator)
 (defcustom calculator-mode-hook nil
-"*List of hook functions run by `calculator-mode'."
+"*List of hook functions for `calculator-mode' to run."
 :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)
 (setq calculator-registers
 (append val calculator-registers)))
 (setq calculator-user-registers val))
 :group 'calculator)
 (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
 `customize' since it is too complex...
 and F does a recursive call, Here is a [very inefficient] Fibonacci
 number calculation:
 (add-to-list 'calculator-user-operators
 '(\"F\" fib (if (<= TX 1)
 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
 '(;; "+"/"-" have keybindings of themselves, not calculator-ops
 ("=" =     identity        1 -1)
-(nobind "+" +  +         2  4)
+(nobind "+" +  +           2  4)
-(nobind "-" -  -         2  4)
+(nobind "-" -  -           2  4)
-(nobind "+" +  +        -1  9)
+(nobind "+" +  +          -1  9)
-(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)
 ("<"  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.
 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)
 and evaluates to the function value - these variables are capital;
-4. The function's arity, optional, one of: 2=binary, -1=prefix unary,
+4. The function's arity, optional, one of: 2 => binary, -1 => prefix
-+1=postfix unary, 0=a 0-arg operator func, non-number=postfix/prefix
+unary, +1 => postfix unary, 0 => a 0-arg operator func, non-number =>
-as determined by `calculator-unary-style' (the default);
+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,
 then no key binding will take place - this is only useful for predefined
 keys.
 "When non-nil, we see something that the next digit should replace.")
 (defvar calculator-buffer nil
 "The current calculator buffer.")
+(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.
 Used for repeating operations in calculator-repR/L.")
 (defvar calculator-registers ; use user-bindings first
 (defvar calculator-saved-global-map nil
 "Saved global key map.")
 (defvar calculator-restart-other-mode nil
-"Used to hack restarting with the mode electric mode changed.")
+"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)))
 (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-op-or-exp   "+" "-" [kp-add] [kp-subtract])
-(calculator-digit     "0" "1" "2" "3" "4" "5" "6" "7" "8"
+(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-op          [kp-divide] [kp-multiply])
-(calculator-decimal   "." [kp-decimal])
+(calculator-decimal     "." [kp-decimal])
-(calculator-exp       "e")
+(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-left        "{")
+(calculator-displayer-right       "}")
 (calculator-saved-up      [up] [?\C-p])
 (calculator-saved-down    [down] [?\C-n])
 (calculator-quit          "q" [?\C-g])
-("="                      [enter] [linefeed] [kp-enter]
+(calculator-enter         [enter] [linefeed] [kp-enter]
-[?\r] [?\n])
+[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)])
+(calculator-paste         [insert] [(shift insert)] [mouse-2])
 (calculator-clear         [delete] [?\C-?] [?\C-d])
 (calculator-help          [?h] [??] [f1] [help])
 (calculator-copy          [(control insert)])
 (calculator-backspace     [backspace])
 )))
 ,@(mapcar 'car radix-selectors)
 ("Seperate I/O"
 ,@(mapcar (lambda (x) (nth 1 x)) radix-selectors)
 "---"
 ,@(mapcar (lambda (x) (nth 2 x)) radix-selectors)))
+("Decimal Dislpay"
+,@(mapcar (lambda (d)
+(vector (cadr d)
+;; Note: inserts actual object here
+`(calculator-rotate-displayer ',d)))
+calculator-displayers)
+"---"
+["Change Display Left"  calculator-displayer-left]
+["Change Display Right" calculator-displayer-right])
 "---"
 ["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.
 Expressions are entered using normal infix notation, parens are used as
 * \"D=\": degrees mode;
 * \"?=\": (? is B/O/H) this is the radix for both input and output;
 * \"=?\": (? is B/O/H) the display radix (when input is decimal);
 * \"??\": (? is D/B/O/H) 1st char for input radix, 2nd for display.
+Also, the quote character can be used to switch display modes for
+decimal numbers (double-quote rotates back), and the two brace
+characters (\"{\" and \"}\" change display parameters that these
+displayers use (if they handle such).
 Values can be saved for future reference in either a list of saved
 values, or in registers.
 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
 (setq major-mode 'calculator-mode)
 (setq mode-name "Calculator")
 (use-local-map calculator-mode-map)
 (run-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-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)))
 (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)
 (if calculator-electric-mode
 (get-buffer-create "*calculator*")
 (let ((split-window-keep-point nil)
 (window-min-height 2))
 (select-window
-		     ;; Maybe leave two lines for our window because
+;; maybe leave two lines for our window because
-		     ;; of the normal `raised' modeline in Emacs 21.
+;; of the normal `raised' modeline in Emacs 21
 (split-window-vertically
-		      (- (window-height)
+(- (window-height)
-			 (if (plist-get (face-attr-construct 'modeline)
+(if (and
-					:box)
+(fboundp 'face-attr-construct)
-			     3
+(plist-get (face-attr-construct 'modeline)
-			   2))))
+:box))
+3
+2))))
 (switch-to-buffer
 (get-buffer-create "*calculator*"))))))
 (set-buffer 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)))
+;;;----------------------------------------------------------------------------
+;;; Operatos
 (defun calculator-op-arity (op)
 "Return OP's arity, 2, +1 or -1."
 (let ((arity (or (nth 3 op) 'x)))
 (if (numberp arity)
 added-ops))
 (setq more-ops (cdr more-ops)))
 ;; added-ops come first, but in correct order
 (setq calculator-operators
 (append (nreverse added-ops) calculator-operators))))
+;;;----------------------------------------------------------------------------
+;;; Display stuff
 (defun calculator-reset ()
 "Reset calculator variables."
 (or calculator-restart-other-mode
 (setq calculator-stack           nil
 ((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.
+;; do this because Emacs reads "23." as an integer
 (concat calculator-curnum "0"))
 ((stringp calculator-curnum)
 (concat calculator-curnum ".0"))
 (t "0.0"))))))
+(defun calculator-rotate-displayer (&optional new-disp)
+"Switch to the next displayer on the `calculator-displayers' list.
+Can be called with an optional argument NEW-DISP to force rotation to
+that argument."
+(interactive)
+(setq calculator-displayers
+(if (and new-disp (memq new-disp calculator-displayers))
+(let ((tmp nil))
+(while (not (eq (car calculator-displayers) new-disp))
+(setq tmp (cons (car calculator-displayers) tmp))
+(setq calculator-displayers (cdr calculator-displayers)))
+(setq calculator-displayers
+(nconc calculator-displayers (nreverse tmp))))
+(nconc (cdr calculator-displayers)
+(list (car calculator-displayers)))))
+(message "Using %s." (cadr (car calculator-displayers)))
+(if calculator-electric-mode
+(progn (sit-for 1) (message nil)))
+(calculator-enter))
+(defun calculator-rotate-displayer-back ()
+"Like `calculator-rotate-displayer', but rotates modes back."
+(interactive)
+(calculator-rotate-displayer (car (last calculator-displayers))))
+(defun calculator-displayer-left ()
+"Send the current displayer function a 'left argument.
+This is used to modify display arguments (if the current displayer
+function supports this)."
+(interactive)
+(and (car calculator-displayers)
+(let ((disp (caar calculator-displayers)))
+(cond ((symbolp disp) (funcall disp 'left))
+((and (consp disp) (eq 'std (car disp)))
+(calculator-standard-displayer 'left (cadr disp)))))))
+(defun calculator-displayer-right ()
+"Send the current displayer function a 'right argument.
+This is used to modify display arguments (if the current displayer
+function supports this)."
+(interactive)
+(and (car calculator-displayers)
+(let ((disp (caar calculator-displayers)))
+(cond ((symbolp disp) (funcall disp 'right))
+((and (consp disp) (eq 'std (car disp)))
+(calculator-standard-displayer 'right (cadr disp)))))))
+(defun calculator-remove-zeros (numstr)
+"Get a number string NUMSTR and remove unnecessary zeroes.
+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 (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 "%." 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-num-to-string (num)
 "Convert NUM to a displayable string."
 (cond
 ((and (numberp num) calculator-output-radix)
 (setq str (match-string 1 s))))
 (upcase
 (if (and (not calculator-2s-complement) (< num 0))
 (concat "-" str)
 str))))
-((and (numberp num)
+((and (numberp num) (car calculator-displayers))
-;; is this a normal-range number?
+(let ((disp (if (= 1 (length calculator-stack))
-(>= (abs num) calculator-number-exp-llimit)
+;; customizable display for a single value
-(< (abs num) calculator-number-exp-ulimit))
+(caar calculator-displayers)
-(let ((str (format calculator-number-format num)))
+calculator-displayer)))
-(cond
+(cond ((stringp disp) (format disp num))
-((and calculator-show-integers (string-match "\\.?0+$" str))
+((symbolp disp) (funcall disp num))
-;; remove all redundant zeros
+((and (consp disp)
-(substring str 0 (match-beginning 0)))
+(eq 'std (car disp)))
-((and (not calculator-show-integers)
+(calculator-standard-displayer
-(string-match "\\..\\(.*[^0]\\)?\\(0+\\)$" str))
+num (cadr disp)))
-;; remove zeros, except for first after the "."
+((listp disp)   (eval disp))
-(substring str 0 (match-beginning 2)))
+(t              (prin1-to-string num t)))))
-(t str))))
+;; operators are printed here
-((numberp num) (format calculator-number-exp-format num))
 (t (prin1-to-string (nth 1 num) t))))
 (defun calculator-update-display (&optional force)
 "Update the display.
 If optional argument FORCE is non-nil, don't use the cached string."
 (insert (calculator-get-prompt)))
 (set-buffer-modified-p nil)
 (if calculator-display-fragile
 (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."
 (while
 ;; needed for 0-ary ops that puts more values
 (setcdr calculator-stack (cdr (cdr calculator-stack))))
 (t ;; no more iterations
 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)))
 (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)))
+;;;----------------------------------------------------------------------------
+;;; Input interaction
 (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))))
 (while (< (setq i (1+ i)) (length inp))
 (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)))
+(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) ? )))
 (aset converted-str i k))
 converted-str))))
 (if (and calculator-display-fragile
 (or (not op)
 (= -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))
 (defun calculator-digit ()
 "Enter a single digit."
 ((not calculator-input-radix)     (<= inp ?9))
 ((eq calculator-input-radix 'bin) (<= inp ?1))
 ((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))))
 (if (equal calculator-curnum "0")
 (setq calculator-curnum nil))
 (or calculator-display-fragile
 (not (numberp (car calculator-stack))))
 (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") "."))
 (calculator-update-display))))
 (calculator-digit)
 (if (and (or calculator-display-fragile
 (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 (&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 keys))
+(catch 'op-error
-(op (assoc last-inp calculator-operators)))
+(let* ((last-inp (calculator-last-input keys))
-(calculator-clear-fragile op)
+(op (assoc last-inp calculator-operators)))
-(if (and calculator-curnum (/= (calculator-op-arity op) 0))
+(calculator-clear-fragile op)
-(setq calculator-stack
+(if (and calculator-curnum (/= (calculator-op-arity op) 0))
-(cons (calculator-curnum-value) calculator-stack)))
+(setq calculator-stack
-(setq calculator-curnum nil)
+(cons (calculator-curnum-value) calculator-stack)))
-(if (and (= 2 (calculator-op-arity op))
+(setq calculator-curnum nil)
-(not (and calculator-stack
+(if (and (= 2 (calculator-op-arity op))
-(numberp (nth 0 calculator-stack)))))
+(not (and calculator-stack
-;; we have a binary operator but no number - search for a prefix
+(numberp (nth 0 calculator-stack)))))
-;; version
+;; we have a binary operator but no number - search for a prefix
-(let ((rest-ops calculator-operators))
+;; version
-(while (not (equal last-inp (car (car rest-ops))))
+(let ((rest-ops calculator-operators))
-(setq rest-ops (cdr rest-ops)))
+(while (not (equal last-inp (car (car rest-ops))))
-(setq op (assoc last-inp (cdr rest-ops)))
+(setq rest-ops (cdr rest-ops)))
-(if (not (and op (= -1 (calculator-op-arity op))))
+(setq op (assoc last-inp (cdr rest-ops)))
-(error "Binary operator without a first operand"))))
+(if (not (and op (= -1 (calculator-op-arity op))))
-(calculator-reduce-stack
+;;(error "Binary operator without a first operand")
-(cond ((eq (nth 1 op) '\() 10)
+(progn
-((eq (nth 1 op) '\)) 0)
+(message "Binary operator without a first operand")
-(t (calculator-op-prec op))))
+(if calculator-electric-mode
-(if (or (and (= -1 (calculator-op-arity op))
+(progn (sit-for 1) (message nil)))
-(numberp (car calculator-stack)))
+(throw 'op-error nil)))))
-(and (/= (calculator-op-arity op) -1)
+(calculator-reduce-stack
-(/= (calculator-op-arity op) 0)
+(cond ((eq (nth 1 op) '\() 10)
-(not (numberp (car calculator-stack)))))
+((eq (nth 1 op) '\)) 0)
-(error "Unterminated expression"))
+(t (calculator-op-prec op))))
-(setq calculator-stack (cons op calculator-stack))
+(if (or (and (= -1 (calculator-op-arity op))
-(calculator-reduce-stack (calculator-op-prec op))
+(numberp (car calculator-stack)))
-(and (= (length calculator-stack) 1)
+(and (/= (calculator-op-arity op) -1)
-(numberp (nth 0 calculator-stack))
+(/= (calculator-op-arity op) 0)
-;; the display is fragile if it contains only one number
+(not (numberp (car calculator-stack)))))
-(setq calculator-display-fragile t)
+;;(error "Unterminated expression")
-;; add number to the saved-list
+(progn
-calculator-add-saved
+(message "Unterminated expression")
-(if (= 0 calculator-saved-ptr)
+(if calculator-electric-mode
-(setq calculator-saved-list
+(progn (sit-for 1) (message nil)))
-(cons (car calculator-stack) calculator-saved-list))
+(throw 'op-error nil)))
-(let ((p (nthcdr (1- calculator-saved-ptr)
+(setq calculator-stack (cons op calculator-stack))
-calculator-saved-list)))
+(calculator-reduce-stack (calculator-op-prec op))
-(setcdr p (cons (car calculator-stack) (cdr p))))))
+(and (= (length calculator-stack) 1)
-(calculator-update-display)))
+(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
 (string-match "[eE]$" 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)
 (if calculator-curnum
 (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)
 (let ((calculator-add-saved t)) ; marks the result to be added
 (calculator-enter)))
 (defun calculator-clear-saved ()
 "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)
 "Go N elements up the list of saved values."
 (interactive)
 (defun calculator-saved-down ()
 "Go down the list of saved values."
 (interactive)
 (calculator-saved-move -1))
+;;;----------------------------------------------------------------------------
+;;; Misc functions
 (defun calculator-open-paren ()
 "Equivalents of `(' use this."
 (interactive)
 (calculator-op "("))
 (defun calculator-copy ()
 "Copy current number to the `kill-ring'."
 (interactive)
 (calculator-enter)
-;; remove trailing .0 and spaces .0
+;; remove trailing spaces and and an index
 (let ((s (cdr calculator-stack-display)))
-(if (string-match "^\\(.*[^ ]\\) *$" 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."
 (defun calculator-paste ()
 "Paste a value from the `kill-ring'."
 (interactive)
 (calculator-put-value
-(condition-case nil (car (read-from-string (current-kill 0)))
+(let ((str (current-kill 0)))
-(error nil))))
+(if calculator-paste-decimals
+(progn
+(string-match "\\([0-9]+\\)\\(\\.[0-9]+\\)?\\(e[0-9]+\\)?" str)
+(if (or (match-string 1 str)
+(match-string 2 str)
+(match-string 3 str))
+(setq str (concat (match-string 1 str)
+(or (match-string 2 str) ".0")
+(match-string 3 str))))))
+(condition-case nil (car (read-from-string str))
+(error nil)))))
 (defun calculator-get-register (reg)
 "Get a value from a register REG."
 (interactive "cRegister to get value from: ")
 (calculator-put-value (cdr (assq reg calculator-registers))))
 "Quick reference:
 * numbers/operators/parens/./e - enter expressions
 + - * / \\(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
+* I inverses next trig function        * '/\"/{} - display/display args
-* D         - switch to all-decimal mode, or toggles deg/rad mode
+* 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
 (interactive)
 (calculator-enter)
 (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."
 (if calculator-last-opXY
 ;; avoid rebinding calculator-last-opXY

Mercurial > emacs

comparison lisp/calculator.el @ 33491:23166da66d5f