;;; calculator.el --- a [not so] simple calculator for Emacs
-;; Copyright (C) 1998, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
-;; 2008, 2009, 2010 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2000-2012 Free Software Foundation, Inc.
;; Author: Eli Barzilay <eli@barzilay.org>
;; Keywords: tools, convenience
(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
(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
Used for repeating operations in calculator-repR/L.")
(defvar calculator-registers ; use user-bindings first
- (append calculator-user-registers (list (cons ?e e) (cons ?p pi)))
+ (append calculator-user-registers
+ (list (cons ?e float-e) (cons ?p float-pi)))
"The association list of calculator register values.")
(defvar calculator-saved-global-map nil
;;;---------------------------------------------------------------------
;;; 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 (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 '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)
+ "---"
+ ["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))
(Electric-command-loop
'calculator-done
;; can't use 'noprompt, bug in electric.el
- '(lambda () 'noprompt)
+ (lambda () 'noprompt)
nil
(lambda (x y) (calculator-update-display))))
(and calculator-buffer
(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))
(calculator-funcall __f__ x y))))
(fset 'D (function
(lambda (x)
- (if calculator-deg (/ (* x 180) pi) 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)))))
(provide 'calculator)
-;; arch-tag: a1b9766c-af8a-4a74-b466-65ad8eeb0c73
;;; calculator.el ends here
HCoop / bpt / emacs.git / blobdiff