-;;; 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-19 20:59:59 eli>
;; This file is part of GNU Emacs.
;;
;; For latest version, check
;; http://www.barzilay.org/misc/calculator.el
+;;
+
+;;; History:
+;; I hate history.
(eval-and-compile
(if (fboundp 'defgroup) nil
will be used with this character for a format string.")
(defcustom calculator-displayers
- '(((std ?n) "Standard dislpay, decimal point or scientific")
+ '(((std ?n) "Standard display, decimal point or scientific")
(calculator-eng-display "Eng display")
((std ?f) "Standard display, decimal point")
- ((std ?e) "Standard dislpay, scientific")
+ ((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 curently used, this is for the display
+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'.
: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."
"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-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]))))
(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)
(calculator)))
;;;---------------------------------------------------------------------
-;;; Operatos
+;;; Operators
(defun calculator-op-arity (op)
"Return OP's arity, 2, +1 or -1."
(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
(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 ()
HCoop / bpt / emacs.git / blobdiff