-;;; calculator.el --- a [not so] simple calculator for Emacs
+;;; calculator.el --- a [not so] simple calculator for Emacs -*- lexical-binding: t -*-
-;; Copyright (C) 1998, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
-;; 2008, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2000-2013 Free Software Foundation, Inc.
;; Author: Eli Barzilay <eli@barzilay.org>
;; Keywords: tools, convenience
;;; History:
;; I hate history.
-(eval-when-compile (require 'cl))
-
;;;=====================================================================
;;; Customization:
:prefix "calculator"
:version "21.1"
:group 'tools
- :group 'convenience)
+ :group 'applications)
(defcustom calculator-electric-mode nil
"Run `calculator' electrically, in the echo area.
(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;
+It should contain a \"%s\" somewhere that will indicate the i/o radices;
this will be a two-character string as described in the documentation
for `calculator-mode'."
:type 'string
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
+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).
(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))
+ :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
;;;=====================================================================
;;; Code:
+(eval-when-compile (require 'cl-lib))
+
;;;---------------------------------------------------------------------
;;; Variables
;;;---------------------------------------------------------------------
;;; Key bindings
-(defvar calculator-mode-map nil
- "The calculator key map.")
-
-(or calculator-mode-map
+(defvar calculator-mode-map
(let ((map (make-sparse-keymap)))
(suppress-keymap map t)
(define-key map "i" nil)
("Binary" bin "B")
("Octal" oct "O")
("Hexadecimal" hex "H"))))
- (op '(lambda (name key)
- `[,name (calculator-op ,key) :keys ,key])))
+ (op (lambda (name key)
+ `[,name (calculator-op ,key) :keys ,key])))
(easy-menu-define
- calculator-menu map "Calculator menu."
- `("Calculator"
- ["Help"
- (let ((last-command 'calculator-help)) (calculator-help))
- :keys "?"]
- "---"
- ["Copy" calculator-copy]
- ["Paste" calculator-paste]
- "---"
- ["Electric mode"
- (progn (calculator-quit)
- (setq calculator-restart-other-mode t)
- (run-with-timer 0.1 nil '(lambda () (message nil)))
- ;; the message from the menu will be visible,
- ;; couldn't make it go away...
- (calculator))
- :active (not calculator-electric-mode)]
- ["Normal mode"
- (progn (setq calculator-restart-other-mode t)
- (calculator-quit))
- :active calculator-electric-mode]
- "---"
- ("Functions"
- ,(funcall op "Repeat-right" ">")
- ,(funcall op "Repeat-left" "<")
- "------General------"
- ,(funcall op "Reciprocal" ";")
- ,(funcall op "Log" "L")
- ,(funcall op "Square-root" "Q")
- ,(funcall op "Factorial" "!")
- "------Trigonometric------"
- ,(funcall op "Sinus" "S")
- ,(funcall op "Cosine" "C")
- ,(funcall op "Tangent" "T")
- ,(funcall op "Inv-Sinus" "IS")
- ,(funcall op "Inv-Cosine" "IC")
- ,(funcall op "Inv-Tangent" "IT")
- "------Bitwise------"
- ,(funcall op "Or" "|")
- ,(funcall op "Xor" "#")
- ,(funcall op "And" "&")
- ,(funcall op "Not" "~"))
- ("Saved List"
- ["Eval+Save" calculator-save-on-list]
- ["Prev number" calculator-saved-up]
- ["Next number" calculator-saved-down]
- ["Delete current" calculator-clear
- :active (and calculator-display-fragile
- calculator-saved-list
- (= (car calculator-stack)
- (nth calculator-saved-ptr
- calculator-saved-list)))]
- ["Delete all" calculator-clear-saved]
+ calculator-menu map "Calculator menu."
+ `("Calculator"
+ ["Help"
+ (let ((last-command 'calculator-help)) (calculator-help))
+ :keys "?"]
"---"
- ,(funcall op "List-total" "l")
- ,(funcall op "List-average" "v"))
- ("Registers"
- ["Get register" calculator-get-register]
- ["Set register" calculator-set-register])
- ("Modes"
- ["Radians"
- (progn
- (and (or calculator-input-radix calculator-output-radix)
- (calculator-radix-mode "D"))
- (and calculator-deg (calculator-dec/deg-mode)))
- :keys "D"
- :style radio
- :selected (not (or calculator-input-radix
- calculator-output-radix
- calculator-deg))]
- ["Degrees"
- (progn
- (and (or calculator-input-radix calculator-output-radix)
- (calculator-radix-mode "D"))
- (or calculator-deg (calculator-dec/deg-mode)))
- :keys "D"
- :style radio
- :selected (and calculator-deg
- (not (or calculator-input-radix
- calculator-output-radix)))]
+ ["Copy" calculator-copy]
+ ["Paste" calculator-paste]
"---"
- ,@(mapcar 'car radix-selectors)
- ("Separate I/O"
- ,@(mapcar (lambda (x) (nth 1 x)) radix-selectors)
+ ["Electric mode"
+ (progn (calculator-quit)
+ (setq calculator-restart-other-mode t)
+ (run-with-timer 0.1 nil (lambda () (message nil)))
+ ;; the message from the menu will be visible,
+ ;; couldn't make it go away...
+ (calculator))
+ :active (not calculator-electric-mode)]
+ ["Normal mode"
+ (progn (setq calculator-restart-other-mode t)
+ (calculator-quit))
+ :active calculator-electric-mode]
+ "---"
+ ("Functions"
+ ,(funcall op "Repeat-right" ">")
+ ,(funcall op "Repeat-left" "<")
+ "------General------"
+ ,(funcall op "Reciprocal" ";")
+ ,(funcall op "Log" "L")
+ ,(funcall op "Square-root" "Q")
+ ,(funcall op "Factorial" "!")
+ "------Trigonometric------"
+ ,(funcall op "Sinus" "S")
+ ,(funcall op "Cosine" "C")
+ ,(funcall op "Tangent" "T")
+ ,(funcall op "Inv-Sinus" "IS")
+ ,(funcall op "Inv-Cosine" "IC")
+ ,(funcall op "Inv-Tangent" "IT")
+ "------Bitwise------"
+ ,(funcall op "Or" "|")
+ ,(funcall op "Xor" "#")
+ ,(funcall op "And" "&")
+ ,(funcall op "Not" "~"))
+ ("Saved List"
+ ["Eval+Save" calculator-save-on-list]
+ ["Prev number" calculator-saved-up]
+ ["Next number" calculator-saved-down]
+ ["Delete current" calculator-clear
+ :active (and calculator-display-fragile
+ calculator-saved-list
+ (= (car calculator-stack)
+ (nth calculator-saved-ptr
+ calculator-saved-list)))]
+ ["Delete all" calculator-clear-saved]
+ "---"
+ ,(funcall op "List-total" "l")
+ ,(funcall op "List-average" "v"))
+ ("Registers"
+ ["Get register" calculator-get-register]
+ ["Set register" calculator-set-register])
+ ("Modes"
+ ["Radians"
+ (progn
+ (and (or calculator-input-radix calculator-output-radix)
+ (calculator-radix-mode "D"))
+ (and calculator-deg (calculator-dec/deg-mode)))
+ :keys "D"
+ :style radio
+ :selected (not (or calculator-input-radix
+ calculator-output-radix
+ calculator-deg))]
+ ["Degrees"
+ (progn
+ (and (or calculator-input-radix calculator-output-radix)
+ (calculator-radix-mode "D"))
+ (or calculator-deg (calculator-dec/deg-mode)))
+ :keys "D"
+ :style radio
+ :selected (and calculator-deg
+ (not (or calculator-input-radix
+ calculator-output-radix)))]
+ "---"
+ ,@(mapcar 'car radix-selectors)
+ ("Separate I/O"
+ ,@(mapcar (lambda (x) (nth 1 x)) radix-selectors)
+ "---"
+ ,@(mapcar (lambda (x) (nth 2 x)) radix-selectors)))
+ ("Decimal Display"
+ ,@(mapcar (lambda (d)
+ (vector (cadr d)
+ ;; Note: inserts actual object here
+ `(calculator-rotate-displayer ',d)))
+ calculator-displayers)
"---"
- ,@(mapcar (lambda (x) (nth 2 x)) radix-selectors)))
- ("Decimal Display"
- ,@(mapcar (lambda (d)
- (vector (cadr d)
- ;; Note: inserts actual object here
- `(calculator-rotate-displayer ',d)))
- calculator-displayers)
+ ["Change Prev Display" calculator-displayer-prev]
+ ["Change Next Display" calculator-displayer-next])
"---"
- ["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)))
+ ["Copy+Quit" calculator-save-and-quit]
+ ["Quit" calculator-quit]))))
+ map)
+ "The calculator key map.")
;;;---------------------------------------------------------------------
;;; Startup and mode stuff
-(defun calculator-mode ()
+(define-derived-mode calculator-mode fundamental-mode "Calculator"
;; this help is also used as the major help screen
"A [not so] simple calculator for Emacs.
See the documentation for these variables, and \"calculator.el\" for
more information.
-\\{calculator-mode-map}"
- (interactive)
- (kill-all-local-variables)
- (setq major-mode 'calculator-mode)
- (setq mode-name "Calculator")
- (use-local-map calculator-mode-map)
- (run-mode-hooks 'calculator-mode-hook))
+\\{calculator-mode-map}")
-(eval-when-compile (require 'electric) (require 'ehelp))
+(declare-function Electric-command-loop "electric"
+ (return-tag &optional prompt inhibit-quitting
+ loop-function loop-state))
;;;###autoload
(defun calculator ()
(Electric-command-loop
'calculator-done
;; can't use 'noprompt, bug in electric.el
- '(lambda () 'noprompt)
+ (lambda () 'noprompt)
nil
- (lambda (x y) (calculator-update-display))))
+ (lambda (_x _y) (calculator-update-display))))
(and calculator-buffer
(catch 'calculator-done (calculator-quit)))
(use-local-map old-l-map)
(cond
((not (get-buffer-window calculator-buffer))
(let ((window-min-height 2))
- ;; maybe leave two lines for our window because of the normal
- ;; `raised' modeline in Emacs 21
+ ;; maybe leave two lines for our window because of the
+ ;; normal `raised' mode line
(select-window
- (split-window-vertically
- ;; If the modeline might interfere with the calculator buffer,
- ;; use 3 lines instead.
+ (split-window-below
+ ;; If the mode line might interfere with the calculator
+ ;; buffer, use 3 lines instead.
(if (and (fboundp 'face-attr-construct)
(let* ((dh (plist-get (face-attr-construct 'default) :height))
- (mf (face-attr-construct 'modeline))
+ (mf (face-attr-construct 'mode-line))
(mh (plist-get mf :height)))
- ;; If the modeline is shorter than the default,
+ ;; If the mode line is shorter than the default,
;; stick with 2 lines. (It may be necessary to
;; check how much shorter.)
(and
(not (integerp mh))
(< mh 1))))
(or
- ;; If the modeline is taller than the default,
+ ;; If the mode line is taller than the default,
;; use 3 lines.
(and (integerp dh)
(integerp mh)
(and (numberp mh)
(not (integerp mh))
(> mh 1))
- ;; If the modeline has a box with non-negative line-width,
+ ;; If the mode line has a box with non-negative line-width,
;; use 3 lines.
(let* ((bx (plist-get mf :box))
(lh (plist-get bx :line-width)))
(or
(not lh)
(> lh 0))))
- ;; If the modeline has an overline, use 3 lines.
- (plist-get (face-attr-construct 'modeline) :overline)))))
+ ;; If the mode line has an overline, use 3 lines.
+ (plist-get (face-attr-construct 'mode-line) :overline)))))
-3 -2)))
(switch-to-buffer calculator-buffer)))
((not (eq (current-buffer) calculator-buffer))
value)
(car (read-from-string
(cond ((equal "." str) "0.0")
- ((string-match "[eE][+-]?$" str) (concat str "0"))
- ((string-match "\\.[0-9]\\|[eE]" str) str)
- ((string-match "\\." str)
+ ((string-match-p "[eE][+-]?$" str) (concat str "0"))
+ ((string-match-p "\\.[0-9]\\|[eE]" str) str)
+ ((string-match-p "\\." str)
;; do this because Emacs reads "23." as an integer
(concat str "0"))
((stringp str) (concat str ".0"))
(format calculator-displayer num))
((symbolp calculator-displayer)
(funcall calculator-displayer num))
- ((and (consp calculator-displayer)
- (eq 'std (car calculator-displayer)))
+ ((eq 'std (car-safe calculator-displayer))
(calculator-standard-displayer num (cadr calculator-displayer)))
((listp calculator-displayer)
- (eval calculator-displayer))
+ (eval calculator-displayer `((num. ,num))))
(t (prin1-to-string num t))))
;; operators are printed here
(t (prin1-to-string (nth 1 num) t))))
;; 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)))
+ (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))
+ (let* ((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) float-pi) x))))
- (unwind-protect (eval f)
- (if Fbound (fset 'F Fsave) (fmakunbound 'F))
- (if Dbound (fset 'D Dsave) (fmakunbound 'D)))))
+ (L calculator-saved-list))
+ (cl-letf (((symbol-function 'F)
+ (lambda (&optional x y) (calculator-funcall f x y)))
+ ((symbol-function 'D)
+ (lambda (x) (if calculator-deg (/ (* x 180) float-pi) x))))
+ (eval f `((X . ,X)
+ (Y . ,Y)
+ (TX . ,TX)
+ (TY . ,TY)
+ (DX . ,DX)
+ (L . ,L))))))
(error 0)))
;;;---------------------------------------------------------------------
(or calculator-display-fragile
(not (numberp (car calculator-stack))))
(not (and calculator-curnum
- (string-match "[.eE]" calculator-curnum))))
+ (string-match-p "[.eE]" calculator-curnum))))
;; enter the period on the same condition as a digit, only if no
;; period or exponent entered yet
(progn
(if (and (or calculator-display-fragile
(not (numberp (car calculator-stack))))
(not (and calculator-curnum
- (string-match "[eE]" calculator-curnum))))
+ (string-match-p "[eE]" calculator-curnum))))
;; same condition as above, also no E so far
(progn
(calculator-clear-fragile)
(interactive)
(if (and (not calculator-display-fragile)
calculator-curnum
- (string-match "[eE]$" calculator-curnum))
+ (string-match-p "[eE]$" calculator-curnum))
(calculator-digit)
(calculator-op)))
(setq str (concat (or (match-string 1 str) "0")
(or (match-string 2 str) ".0")
(or (match-string 3 str) ""))))
- (condition-case nil (calculator-string-to-number str)
- (error nil)))))
+ (ignore-errors (calculator-string-to-number str)))))
(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))))
+(declare-function electric-describe-mode "ehelp" ())
+
(defun calculator-help ()
;; this is used as the quick reference screen you get with `h'
"Quick reference:
(if (or (not calculator-electric-mode)
;; XEmacs has a problem with electric-describe-mode
(featurep 'xemacs))
- (describe-mode)
+ (describe-mode)
(electric-describe-mode))
(if calculator-electric-mode
(use-global-map g-map))
(interactive)
(set-buffer calculator-buffer)
(let ((inhibit-read-only t)) (erase-buffer))
- (if (not calculator-electric-mode)
- (progn
- (condition-case nil
- (while (get-buffer-window calculator-buffer)
- (delete-window (get-buffer-window calculator-buffer)))
- (error nil))
- (kill-buffer calculator-buffer)))
+ (unless calculator-electric-mode
+ (ignore-errors
+ (while (get-buffer-window calculator-buffer)
+ (delete-window (get-buffer-window calculator-buffer))))
+ (kill-buffer calculator-buffer))
(setq calculator-buffer nil)
(message "Calculator done.")
(if calculator-electric-mode (throw 'calculator-done nil)))
(defun calculator-integer-p (x)
"Non-nil if X is equal to an integer."
- (condition-case nil
- (= x (ftruncate x))
- (error nil)))
+ (ignore-errors (= x (ftruncate x))))
(defun calculator-expt (x y)
"Compute X^Y, dealing with errors appropriately."
- (condition-case
- nil
+ (condition-case nil
(expt x y)
(domain-error 0.0e+NaN)
(range-error
(provide 'calculator)
-;; arch-tag: a1b9766c-af8a-4a74-b466-65ad8eeb0c73
;;; calculator.el ends here
HCoop / bpt / emacs.git / blobdiff