;;; calculator.el --- a [not so] simple calculator for Emacs
-;; Copyright (C) 1998, 2000, 2001 by Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2000, 2001, 2002, 2003, 2004,
+;; 2005, 2006, 2007 Free Software Foundation, Inc.
;; Author: Eli Barzilay <eli@barzilay.org>
;; Keywords: tools, convenience
-;; Time-stamp: <2002-07-13 01:14:35 eli>
+;; Time-stamp: <2007-08-31 03:00:11 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 2, or (at your option) any
+;; Free Software Foundation; either version 3, or (at your option) any
;; later version.
;; GNU Emacs is distributed in the hope that it will be useful, but
;; 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:
;;; History:
;; I hate history.
+(eval-when-compile (require 'cl))
(eval-and-compile
(if (fboundp 'defgroup) nil
(defmacro defgroup (&rest forms) nil)
(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'."
+It should contain a \"%s\" somewhere that will indicate the i/o radixes;
+this will be a two-character string as described in the documentation
+for `calculator-mode'."
:type 'string
:group 'calculator)
("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)
calculator-output-radix)))]
"---"
,@(mapcar 'car radix-selectors)
- ("Seperate I/O"
+ ("Separate I/O"
,@(mapcar (lambda (x) (nth 1 x)) radix-selectors)
"---"
,@(mapcar (lambda (x) (nth 2 x)) radix-selectors)))
`+' 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
(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))
;; `raised' modeline in Emacs 21
(select-window
(split-window-vertically
+ ;; If the modeline might interfere with the calculator buffer,
+ ;; use 3 lines instead.
(if (and (fboundp 'face-attr-construct)
- (plist-get (face-attr-construct 'modeline) :box))
+ (let* ((dh (plist-get (face-attr-construct 'default) :height))
+ (mf (face-attr-construct 'modeline))
+ (mh (plist-get mf :height)))
+ ;; If the modeline is shorter than the default,
+ ;; stick with 2 lines. (It may be necessary to
+ ;; check how much shorter.)
+ (and
+ (not
+ (or (and (integerp dh)
+ (integerp mh)
+ (< mh dh))
+ (and (numberp mh)
+ (not (integerp mh))
+ (< mh 1))))
+ (or
+ ;; If the modeline is taller than the default,
+ ;; use 3 lines.
+ (and (integerp dh)
+ (integerp mh)
+ (> mh dh))
+ (and (numberp mh)
+ (not (integerp mh))
+ (> mh 1))
+ ;; If the modeline has a box with non-negative line-width,
+ ;; use 3 lines.
+ (let* ((bx (plist-get mf :box))
+ (lh (plist-get bx :line-width)))
+ (and bx
+ (or
+ (not lh)
+ (> lh 0))))
+ ;; If the modeline has an overline, use 3 lines.
+ (plist-get (face-attr-construct 'modeline) :overline)))))
-3 -2)))
(switch-to-buffer calculator-buffer)))
((not (eq (current-buffer) calculator-buffer))
(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
(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)
- (event-key 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) ? )))
(calculator-displayers
(if calculator-copy-displayer nil calculator-displayers)))
(calculator-enter)
- ;; remove trailing spaces and and an index
+ ;; remove trailing spaces and an index
(let ((s (cdr calculator-stack-display)))
(and s
(if (string-match "^\\([^ ]+\\) *\\(\\[[0-9/]+\\]\\)? *$" s)
(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)
+ ((oddp (truncate y))
+ ;; 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."