;;; calculator.el --- a [not so] simple calculator for Emacs
-;; Copyright (C) 1998, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
+;; 2008 Free Software Foundation, Inc.
;; Author: Eli Barzilay <eli@barzilay.org>
;; Keywords: tools, convenience
-;; Time-stamp: <2006-02-06 13:36:00 ttn>
;; 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
-;; Free Software Foundation; either version 3, or (at your option) any
-;; later version.
+;; 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.
-;; 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.
+;; 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.
;; 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., 51 Franklin Street, Fifth Floor, Boston,
-;; MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;;=====================================================================
;;; Commentary:
;;; 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))))
+(eval-when-compile (require 'cl))
;;;=====================================================================
;;; Customization:
("IC" acos (D (acos X)) x 6)
("IT" atan (D (atan X)) x 6)
("Q" sqrt sqrt x 7)
- ("^" ^ expt 2 7)
+ ("^" ^ calculator-expt 2 7)
("!" ! calculator-fact x 7)
(";" 1/ (/ 1 X) 1 7)
("_" - - 1 8)
`+' 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'
-will be the hexadecimal digit).
+will be the hexadecimal digit). If the result of a calculation is too
+large (out of range for Emacs), the value of \"inf\" is returned.
Here are the editing keys:
* `RET' `=' evaluate the current expression
(use-global-map calculator-saved-global-map))
(if (or (not calculator-electric-mode)
;; XEmacs has a problem with electric-describe-mode
- (string-match "XEmacs" (emacs-version)))
+ (featurep 'xemacs))
(describe-mode)
(electric-describe-mode))
(if calculator-electric-mode
(car calculator-last-opXY) (nth 1 calculator-last-opXY) x))
x))
+(defun calculator-integer-p (x)
+ "Non-nil if X is equal to an integer."
+ (condition-case nil
+ (= x (ftruncate x))
+ (error nil)))
+
+(defun calculator-expt (x y)
+ "Compute X^Y, dealing with errors appropriately."
+ (condition-case
+ nil
+ (expt x y)
+ (domain-error 0.0e+NaN)
+ (range-error
+ (cond
+ ((and (< x 1.0) (> x -1.0))
+ ;; For small x, the range error comes from large y.
+ 0.0)
+ ((and (> x 0.0) (< y 0.0))
+ ;; For large positive x and negative y, the range error
+ ;; comes from large negative y.
+ 0.0)
+ ((and (> x 0.0) (> y 0.0))
+ ;; For large positive x and positive y, the range error
+ ;; comes from large y.
+ 1.0e+INF)
+ ;; For the rest, x must be large and negative.
+ ;; The range errors come from large integer y.
+ ((< y 0.0)
+ 0.0)
+ ((eq (logand (truncate y) 1) 1) ; expansion of cl `oddp'
+ ;; If y is odd
+ -1.0e+INF)
+ (t
+ ;;
+ 1.0e+INF)))
+ (error 0.0e+NaN)))
+
(defun calculator-fact (x)
"Simple factorial of X."
- (let ((r (if (<= x 10) 1 1.0)))
- (while (> x 0)
- (setq r (* r (truncate x)))
- (setq x (1- x)))
- (+ 0.0 r)))
+ (if (and (>= x 0)
+ (calculator-integer-p x))
+ (if (= (calculator-expt (/ x 3.0) x) 1.0e+INF)
+ 1.0e+INF
+ (let ((r (if (<= x 10) 1 1.0)))
+ (while (> x 0)
+ (setq r (* r (truncate x)))
+ (setq x (1- x)))
+ (+ 0.0 r)))
+ (if (= x 1.0e+INF)
+ x
+ 0.0e+NaN)))
(defun calculator-truncate (n)
"Truncate N, return 0 in case of overflow."
(provide 'calculator)
-;;; arch-tag: a1b9766c-af8a-4a74-b466-65ad8eeb0c73
+;; arch-tag: a1b9766c-af8a-4a74-b466-65ad8eeb0c73
;;; calculator.el ends here