-;;; 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-2012 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2000-2014 Free Software Foundation, Inc.
;; Author: Eli Barzilay <eli@barzilay.org>
;; Keywords: tools, convenience
;;; History:
;; I hate history.
-(eval-when-compile (require 'cl))
-
;;;=====================================================================
;;; Customization:
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).
An exception to the above is the case of the list (std C) where C is a
character, in this case the `calculator-standard-displayer' function
will be used with this character for a format string."
+ :type '(choice (function) (string) (list (const std) character) (sexp))
:group 'calculator)
(defcustom calculator-displayers
;;;=====================================================================
;;; Code:
+(eval-when-compile (require 'cl-lib))
+
;;;---------------------------------------------------------------------
;;; Variables
\\{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 ()
;; can't use 'noprompt, bug in electric.el
(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-below
- ;; If the modeline might interfere with the calculator buffer,
- ;; use 3 lines instead.
+ ;; 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 s (match-string 1 s)))
(kill-new s)))))
+;; FIXME this should use register-read-with-preview, but it
+;; uses calculator-registers rather than register-alist.
(defun calculator-set-register (reg)
"Set a register value for REG."
(interactive "cRegister to store into: ")
(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)))))
+;; FIXME this should use register-read-with-preview, but it
+;; uses calculator-registers rather than register-alist.
(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