-;;; calculator.el --- A [not so] simple calculator for Emacs.
+;;; calculator.el --- a [not so] simple calculator for Emacs
-;; Copyright (C) 1998, 2000 by Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2000, 2001 by Free Software Foundation, Inc.
-;; Author: Eli Barzilay <eli@www.barzilay.org>
+;; Author: Eli Barzilay <eli@barzilay.org>
;; Keywords: tools, convenience
-;; Time-stamp: <2000-11-07 15:04:06 eli>
+;; Time-stamp: <2001-10-11 16:18:29 eli>
;; This file is part of GNU Emacs.
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
;; MA 02111-1307, USA.
-;;;============================================================================
+;;;=====================================================================
;;; Commentary:
;;
;; A calculator for Emacs.
-;; Why should you each for your mouse to get xcalc (calc.exe, gcalc or
+;; 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
;;
;; For latest version, check
;; 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
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 'string
+ :type 'integer
:group 'calculator)
(defcustom calculator-remove-zeros t
: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.")
+
(defcustom calculator-2s-complement nil
"*If non-nil, show negative numbers in 2s complement in radix modes.
Otherwise show as a negative number."
:type '(repeat (list string symbol sexp integer integer))
:group 'calculator)
-;;;============================================================================
+;;;=====================================================================
;;; Code:
-;;;----------------------------------------------------------------------------
+;;;---------------------------------------------------------------------
;;; Variables
(defvar calculator-initial-operators
(defvar calculator-restart-other-mode nil
"Used to hack restarting with the electric mode changed.")
-;;;----------------------------------------------------------------------------
+;;;---------------------------------------------------------------------
;;; Key bindings
(defvar calculator-mode-map nil
"oD" "oH" "oX" "oO" "oB")
(calculator-rotate-displayer "'")
(calculator-rotate-displayer-back "\"")
- (calculator-displayer-left "{")
- (calculator-displayer-right "}")
+ (calculator-displayer-pref "{")
+ (calculator-displayer-next "}")
(calculator-saved-up [up] [?\C-p])
(calculator-saved-down [down] [?\C-n])
(calculator-quit "q" [?\C-g])
(calculator-clear-saved [?\C-c] [(control delete)])
(calculator-save-and-quit [(control return)]
[(control kp-enter)])
- (calculator-paste [insert] [(shift insert)] [mouse-2])
+ (calculator-paste [insert] [(shift insert)]
+ [mouse-2])
(calculator-clear [delete] [?\C-?] [?\C-d])
(calculator-help [?h] [??] [f1] [help])
(calculator-copy [(control insert)])
`(calculator-rotate-displayer ',d)))
calculator-displayers)
"---"
- ["Change Display Left" calculator-displayer-left]
- ["Change Display Right" calculator-displayer-right])
+ ["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 ()
(use-local-map old-l-map)
(use-global-map old-g-map))))
(progn
- (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
- ;; maybe leave two lines for our window because
- ;; of the normal `raised' modeline in Emacs 21
- (split-window-vertically
- (- (window-height)
- (if (and
- (fboundp 'face-attr-construct)
- (plist-get (face-attr-construct 'modeline)
- :box))
- 3
- 2))))
- (switch-to-buffer
- (get-buffer-create "*calculator*"))))))
- (set-buffer calculator-buffer)
+ (setq calculator-buffer (get-buffer-create "*calculator*"))
+ (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)
(if (and calculator-restart-other-mode calculator-electric-mode)
(calculator)))
-;;;----------------------------------------------------------------------------
+;;;---------------------------------------------------------------------
;;; Operatos
(defun calculator-op-arity (op)
(setq calculator-operators
(append (nreverse added-ops) calculator-operators))))
-;;;----------------------------------------------------------------------------
+;;;---------------------------------------------------------------------
;;; Display stuff
(defun calculator-reset ()
(interactive)
(calculator-rotate-displayer (car (last calculator-displayers))))
-(defun calculator-displayer-left ()
+(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)."
((and (consp disp) (eq 'std (car disp)))
(calculator-standard-displayer 'left (cadr disp)))))))
-(defun calculator-displayer-right ()
+(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)."
(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)))
+ (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)
(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")
+ (let ((str (format (concat "%." (number-to-string
+ calculator-number-digits)
+ "f")
num)))
(concat (let ((calculator-remove-zeros
;; make sure we don't leave integers
(if (and (not calculator-2s-complement) (< num 0))
(concat "-" str)
str))))
- ((and (numberp num) (car calculator-displayers))
- (let ((disp (if (= 1 (length calculator-stack))
- ;; customizable display for a single value
- (caar calculator-displayers)
- calculator-displayer)))
- (cond ((stringp disp) (format disp num))
- ((symbolp disp) (funcall disp num))
- ((and (consp disp)
- (eq 'std (car disp)))
- (calculator-standard-displayer
- num (cadr disp)))
- ((listp disp) (eval disp))
- (t (prin1-to-string num t)))))
+ ((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))))
(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-num-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)
(or (fboundp 'key-press-event-p)
(defun key-press-event-p (&rest _) nil)))
-;;;----------------------------------------------------------------------------
+;;;---------------------------------------------------------------------
;;; Input interaction
(defun calculator-last-input (&optional keys)
(calculator-digit)
(calculator-op)))
-;;;----------------------------------------------------------------------------
+;;;---------------------------------------------------------------------
;;; Input/output modes (not display)
(defun calculator-dec/deg-mode ()
calculator-char-radix))))
(calculator-update-display t))
-;;;----------------------------------------------------------------------------
+;;;---------------------------------------------------------------------
;;; Saved values list
(defun calculator-save-on-list ()
(interactive)
(calculator-saved-move -1))
-;;;----------------------------------------------------------------------------
+;;;---------------------------------------------------------------------
;;; Misc functions
(defun calculator-open-paren ()
(defun calculator-copy ()
"Copy current number to the `kill-ring'."
(interactive)
- (calculator-enter)
- ;; remove trailing spaces and and an index
- (let ((s (cdr calculator-stack-display)))
- (if (string-match "^\\([^ ]+\\) *\\(\\[[0-9/]+\\]\\)? *$" 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 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."
(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-num-to-string val)))
(calculator-update-display))))
(defun calculator-paste ()
(interactive)
(calculator-put-value
(let ((str (current-kill 0)))
- (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))))))
+ (and 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 (match-string 1 str)
+ (or (match-string 2 str) ".0")
+ (match-string 3 str))))
(condition-case nil (car (read-from-string str))
(error nil)))))
(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)