;;; calc.el --- the GNU Emacs calculator
-;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2014 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
(declare-function calc-set-language "calc-lang" (lang &optional option no-refresh))
(declare-function calc-edit-finish "calc-yank" (&optional keep))
(declare-function calc-edit-cancel "calc-yank" ())
-(declare-function calc-do-quick-calc "calc-aent" ())
+(declare-function calc-locate-cursor-element "calc-yank" (pt))
+(declare-function calc-do-quick-calc "calc-aent" (&optional insert))
(declare-function calc-do-calc-eval "calc-aent" (str separator args))
(declare-function calc-do-keypad "calc-keypd" (&optional full-display interactive))
(declare-function calcFunc-unixtime "calc-forms" (date &optional zone))
:version "24.3"
:type 'boolean)
+(defcustom calc-context-sensitive-enter
+ nil
+ "If non-nil, the stack element under the cursor will be copied by `calc-enter'
+and deleted by `calc-pop'."
+ :group 'calc
+ :version "24.4"
+ :type 'boolean)
+
(defcustom calc-undo-length
100
"The number of undo steps that will be preserved when Calc is quit."
(put 'calc-mode 'mode-class 'special)
(put 'calc-trail-mode 'mode-class 'special)
-;; Define "inexact-result" as an e-lisp error symbol.
-(put 'inexact-result 'error-conditions '(error inexact-result calc-error))
-(put 'inexact-result 'error-message "Calc internal error (inexact-result)")
+(define-error 'calc-error "Calc internal error")
+(define-error 'inexact-result
+ "Calc internal error (inexact-result)" 'calc-error)
-;; Define "math-overflow" and "math-underflow" as e-lisp error symbols.
-(put 'math-overflow 'error-conditions '(error math-overflow calc-error))
-(put 'math-overflow 'error-message "Floating-point overflow occurred")
-(put 'math-underflow 'error-conditions '(error math-underflow calc-error))
-(put 'math-underflow 'error-message "Floating-point underflow occurred")
+(define-error 'math-overflow "Floating-point overflow occurred" 'calc-error)
+(define-error 'math-underflow "Floating-point underflow occurred" 'calc-error)
(defvar calc-trail-pointer nil
"The \"current\" entry in trail buffer.")
(calc-check-defines))
(setplist 'calc-define nil)))))
-(defun calc-trail-mode (&optional buf)
+(defvar calc-trail-mode-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map calc-mode-map)
+ map))
+
+(define-derived-mode calc-trail-mode fundamental-mode "Calc Trail"
"Calc Trail mode.
This mode is used by the *Calc Trail* buffer, which records all results
obtained by the GNU Emacs Calculator.
This buffer uses the same key map as the *Calculator* buffer; calculator
commands given here will actually operate on the *Calculator* stack."
- (interactive)
- (fundamental-mode)
- (use-local-map calc-mode-map)
- (setq major-mode 'calc-trail-mode)
- (setq mode-name "Calc Trail")
(setq truncate-lines t)
(setq buffer-read-only t)
(make-local-variable 'overlay-arrow-position)
(make-local-variable 'overlay-arrow-string)
- (when buf
- (set (make-local-variable 'calc-main-buffer) buf))
(when (= (buffer-size) 0)
(let ((buffer-read-only nil))
- (insert (propertize "Emacs Calculator Trail\n" 'face 'italic))))
- (run-mode-hooks 'calc-trail-mode-hook))
+ (insert (propertize "Emacs Calculator Trail\n" 'face 'italic)))))
(defun calc-create-buffer ()
"Create and initialize a buffer for the Calculator."
(set-buffer (get-buffer-create "*Calculator*"))
- (or (eq major-mode 'calc-mode)
+ (or (derived-mode-p 'calc-mode)
(calc-mode))
(setq max-lisp-eval-depth (max max-lisp-eval-depth 1000))
(when calc-always-load-extensions
(calc-keypad))))
(when (get-buffer-window "*Calc Keypad*")
(calc-keypad)
- (set-buffer (window-buffer (selected-window))))
- (if (eq major-mode 'calc-mode)
+ (set-buffer (window-buffer)))
+ (if (derived-mode-p 'calc-mode)
(calc-quit)
(let ((oldbuf (current-buffer)))
(calc-create-buffer)
(if (and (equal (buffer-name) "*Gnuplot Trail*")
(> (recursion-depth) 0))
(exit-recursive-edit)
- (if (eq major-mode 'calc-edit-mode)
+ (if (derived-mode-p 'calc-edit-mode)
(calc-edit-finish arg)
(if calc-was-keypad-mode
(calc-keypad)
(if (and (equal (buffer-name) "*Gnuplot Trail*")
(> (recursion-depth) 0))
(exit-recursive-edit))
- (if (eq major-mode 'calc-edit-mode)
+ (if (derived-mode-p 'calc-edit-mode)
(calc-edit-cancel)
(if (and interactive
calc-embedded-info
(eq (current-buffer) (aref calc-embedded-info 0)))
(calc-embedded nil)
- (unless (eq major-mode 'calc-mode)
+ (unless (derived-mode-p 'calc-mode)
(calc-create-buffer))
(run-hooks 'calc-end-hook)
(if (integerp calc-undo-length)
(and kbuf (bury-buffer kbuf))))))
;;;###autoload
-(defun quick-calc ()
- "Do a quick calculation in the minibuffer without invoking full Calculator."
- (interactive)
- (calc-do-quick-calc))
+(defun quick-calc (&optional insert)
+ "Do a quick calculation in the minibuffer without invoking full Calculator.
+With prefix argument INSERT, insert the result in the current
+buffer. Otherwise, the result is copied into the kill ring."
+ (interactive "P")
+ (calc-do-quick-calc insert))
;;;###autoload
(defun calc-eval (str &optional separator &rest args)
(if (math-lessp 1 time)
(calc-record time "(t)"))))
(or (memq 'no-align calc-command-flags)
- (eq major-mode 'calc-trail-mode)
+ (derived-mode-p 'calc-trail-mode)
(calc-align-stack-window))
(and (memq 'position-point calc-command-flags)
- (if (eq major-mode 'calc-mode)
+ (if (derived-mode-p 'calc-mode)
(progn
(goto-char (point-min))
(forward-line (1- calc-final-point-line))
(setq calc-command-flags (cons f calc-command-flags))))
(defun calc-select-buffer ()
- (or (eq major-mode 'calc-mode)
+ (or (derived-mode-p 'calc-mode)
(if calc-main-buffer
(set-buffer calc-main-buffer)
(let ((buf (get-buffer "*Calculator*")))
(and calc-embedded-info (calc-embedded-mode-line-change))))))
(defun calc-align-stack-window ()
- (if (eq major-mode 'calc-mode)
+ (if (derived-mode-p 'calc-mode)
(progn
(let ((win (get-buffer-window (current-buffer))))
(if win
(defvar calc-any-evaltos nil)
(defun calc-refresh (&optional align)
(interactive)
- (and (eq major-mode 'calc-mode)
+ (and (derived-mode-p 'calc-mode)
(not calc-executing-macro)
(let* ((buffer-read-only nil)
(save-point (point))
(calc-align-stack-window)
(goto-char save-point))
(if save-mark (set-mark save-mark))))
- (and calc-embedded-info (not (eq major-mode 'calc-mode))
+ (and calc-embedded-info (not (derived-mode-p 'calc-mode))
(with-current-buffer (aref calc-embedded-info 1)
(calc-refresh align)))
(setq calc-refresh-count (1+ calc-refresh-count)))
(null (buffer-name calc-trail-buffer)))
(save-excursion
(setq calc-trail-buffer (get-buffer-create "*Calc Trail*"))
- (let ((buf (or (and (not (eq major-mode 'calc-mode))
+ (let ((buf (or (and (not (derived-mode-p 'calc-mode))
(get-buffer "*Calculator*"))
(current-buffer))))
(set-buffer calc-trail-buffer)
- (or (eq major-mode 'calc-trail-mode)
- (calc-trail-mode buf)))))
+ (unless (derived-mode-p 'calc-trail-mode)
+ (calc-trail-mode)
+ (set (make-local-variable 'calc-main-buffer) buf)))))
(or (and calc-trail-pointer
(eq (marker-buffer calc-trail-pointer) calc-trail-buffer))
(with-current-buffer calc-trail-buffer
(defun calc-trail-here ()
(interactive)
- (if (eq major-mode 'calc-trail-mode)
+ (if (derived-mode-p 'calc-trail-mode)
(progn
(beginning-of-line)
(if (bobp)
(defun calc-enter (n)
(interactive "p")
- (calc-wrapper
- (cond ((< n 0)
- (calc-push-list (calc-top-list 1 (- n))))
- ((= n 0)
- (calc-push-list (calc-top-list (calc-stack-size))))
- (t
- (calc-push-list (calc-top-list n))))))
-
+ (let ((num (if calc-context-sensitive-enter (max 1 (calc-locate-cursor-element (point))))))
+ (calc-wrapper
+ (cond ((< n 0)
+ (calc-push-list (calc-top-list 1 (- n))))
+ ((= n 0)
+ (calc-push-list (calc-top-list (calc-stack-size))))
+ (num
+ (calc-push-list (calc-top-list n num)))
+ (t
+ (calc-push-list (calc-top-list n)))))
+ (if (and calc-context-sensitive-enter (> n 0)) (calc-cursor-stack-index (+ num n)))))
(defun calc-pop (n)
(interactive "P")
- (calc-wrapper
- (let* ((nn (prefix-numeric-value n))
- (top (and (null n) (calc-top 1))))
- (cond ((and (null n)
- (eq (car-safe top) 'incomplete)
- (> (length top) (if (eq (nth 1 top) 'intv) 3 2)))
- (calc-pop-push-list 1 (let ((tt (copy-sequence top)))
- (setcdr (nthcdr (- (length tt) 2) tt) nil)
- (list tt))))
- ((< nn 0)
- (if (and calc-any-selections
- (calc-top-selected 1 (- nn)))
- (calc-delete-selection (- nn))
- (calc-pop-stack 1 (- nn) t)))
- ((= nn 0)
- (calc-pop-stack (calc-stack-size) 1 t))
- (t
- (if (and calc-any-selections
- (= nn 1)
- (calc-top-selected 1 1))
- (calc-delete-selection 1)
- (calc-pop-stack nn)))))))
+ (let ((num (if calc-context-sensitive-enter (max 1 (calc-locate-cursor-element (point))))))
+ (calc-wrapper
+ (let* ((nn (prefix-numeric-value n))
+ (top (and (null n) (calc-top 1))))
+ (cond ((and calc-context-sensitive-enter (> num 1))
+ (calc-pop-stack nn num))
+ ((and (null n)
+ (eq (car-safe top) 'incomplete)
+ (> (length top) (if (eq (nth 1 top) 'intv) 3 2)))
+ (calc-pop-push-list 1 (let ((tt (copy-sequence top)))
+ (setcdr (nthcdr (- (length tt) 2) tt) nil)
+ (list tt))))
+ ((< nn 0)
+ (if (and calc-any-selections
+ (calc-top-selected 1 (- nn)))
+ (calc-delete-selection (- nn))
+ (calc-pop-stack 1 (- nn) t)))
+ ((= nn 0)
+ (calc-pop-stack (calc-stack-size) 1 t))
+ (t
+ (if (and calc-any-selections
+ (= nn 1)
+ (calc-top-selected 1 1))
+ (calc-delete-selection 1)
+ (calc-pop-stack nn))))))
+ (if calc-context-sensitive-enter (calc-cursor-stack-index (1- num)))))
+
(defconst math-bignum-digit-length
- (truncate (/ (log10 (/ most-positive-fixnum 2)) 2))
+ (truncate (/ (log (/ most-positive-fixnum 2) 10) 2))
"The length of a \"digit\" in Calc bignums.
If a big integer is of the form (bigpos N0 N1 ...), this is the
length of the allowable Emacs integers N0, N1,...
(cons (car math-normalize-a) args))
nil)
(wrong-type-argument
- (setq math-normalize-error t)
(or calc-next-why
(calc-record-why "Wrong type of argument"
(cons (car math-normalize-a) args)))
(cons (car math-normalize-a) args))
nil)
(inexact-result
- (setq math-normalize-error t)
(calc-record-why "No exact representation for result"
(cons (car math-normalize-a) args))
nil)
;; Coerce integer A to be a bignum. [B S]
(defun math-bignum (a)
- (if (>= a 0)
- (cons 'bigpos (math-bignum-big a))
- (cons 'bigneg (math-bignum-big (- a)))))
+ (cond
+ ((>= a 0)
+ (cons 'bigpos (math-bignum-big a)))
+ ((= a most-negative-fixnum)
+ ;; Note: cannot get the negation directly because
+ ;; (- most-negative-fixnum) is most-negative-fixnum.
+ ;;
+ ;; most-negative-fixnum := -most-positive-fixnum - 1
+ (math-sub (cons 'bigneg (math-bignum-big most-positive-fixnum))
+ 1))
+ (t
+ (cons 'bigneg (math-bignum-big (- a))))))
(defun math-bignum-big (a) ; [L s]
(if (= a 0)