;;; calc.el --- the GNU Emacs calculator
-;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2012 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
;; Keywords: convenience, extensions
-;; Version: 2.1
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; target integral is not complete (and the time limit has not run out)
;; choose an incomplete integral from the cache and, for every integral
;; appearing in its RHS's, add those integrals to the cache using the
-;; same substitition, parts, etc. rules. The cache should be organized
+;; same substitution, parts, etc. rules. The cache should be organized
;; as a priority queue, choosing the "simplest" incomplete integral at
;; each step, or choosing randomly among equally simple integrals.
;; Simplicity equals small size, and few steps removed from the original
(declare-function calcFunc-unixtime "calc-forms" (date &optional zone))
(declare-function math-parse-date "calc-forms" (math-pd-str))
(declare-function math-lessp "calc-ext" (a b))
+(declare-function math-compare "calc-ext" (a b))
(declare-function calc-embedded-finish-command "calc-embed" ())
(declare-function calc-embedded-select-buffer "calc-embed" ())
(declare-function calc-embedded-mode-line-change "calc-embed" ())
(declare-function calc-incomplete-error "calc-incom" (a))
(declare-function math-float-fancy "calc-arith" (a))
(declare-function math-neg-fancy "calc-arith" (a))
-(declare-function math-zerop "calc-misc" (a))
(declare-function calc-add-fractions "calc-frac" (a b))
(declare-function math-add-objects-fancy "calc-arith" (a b))
(declare-function math-add-symb-fancy "calc-arith" (a b))
(declare-function math-adjust-fraction "calc-ext" (a))
(declare-function math-format-binary "calc-bin" (a))
(declare-function math-format-radix "calc-bin" (a))
+(declare-function math-format-twos-complement "calc-bin" (a))
(declare-function math-group-float "calc-ext" (str))
(declare-function math-mod "calc-misc" (a b))
(declare-function math-format-number-fancy "calc-ext" (a prec))
:tag "Calc"
:group 'applications)
-;;;###autoload
+;; Do not autoload, so it is evaluated at run-time rather than at dump time.
+;; ;;;###autoload
(defcustom calc-settings-file
- (convert-standard-filename "~/.calc.el")
- "*File in which to record permanent settings."
+ (locate-user-emacs-file "calc.el" ".calc.el")
+ "File in which to record permanent settings."
:group 'calc
:type '(file))
(fortran-mode . fortran)
(f90-mode . fortran)
(texinfo-mode . calc-normal-language))
- "*Alist of major modes with appropriate Calc languages."
+ "Alist of major modes with appropriate Calc languages."
:group 'calc
:type '(alist :key-type (symbol :tag "Major mode")
:value-type (symbol :tag "Calc language")))
(defcustom calc-embedded-announce-formula
"%Embed\n\\(% .*\n\\)*"
- "*A regular expression which is sure to be followed by a calc-embedded formula."
+ "A regular expression which is sure to be followed by a calc-embedded formula."
:group 'calc
:type '(regexp))
(sgml-mode . "<!-- Embed -->\n\\(<!-- .* -->\n\\)*")
(xml-mode . "<!-- Embed -->\n\\(<!-- .* -->\n\\)*")
(texinfo-mode . "@c Embed\n\\(@c .*\n\\)*"))
- "*Alist of major modes with appropriate values for `calc-embedded-announce-formula'."
+ "Alist of major modes with appropriate values for `calc-embedded-announce-formula'."
:group 'calc
:type '(alist :key-type (symbol :tag "Major mode")
:value-type (regexp :tag "Regexp to announce formula")))
(defcustom calc-embedded-open-formula
"\\`\\|^\n\\|\\$\\$?\\|\\\\\\[\\|^\\\\begin[^{].*\n\\|^\\\\begin{.*[^x]}.*\n\\|^@.*\n\\|^\\.EQ.*\n\\|\\\\(\\|^%\n\\|^\\.\\\\\"\n"
- "*A regular expression for the opening delimiter of a formula used by calc-embedded."
+ "A regular expression for the opening delimiter of a formula used by calc-embedded."
:group 'calc
:type '(regexp))
(defcustom calc-embedded-close-formula
"\\'\\|\n$\\|\\$\\$?\\|\\\\]\\|^\\\\end[^{].*\n\\|^\\\\end{.*[^x]}.*\n\\|^@.*\n\\|^\\.EN.*\n\\|\\\\)\\|\n%\n\\|^\\.\\\\\"\n"
- "*A regular expression for the closing delimiter of a formula used by calc-embedded."
+ "A regular expression for the closing delimiter of a formula used by calc-embedded."
:group 'calc
:type '(regexp))
(defcustom calc-embedded-open-close-formula-alist
nil
- "*Alist of major modes with pairs of formula delimiters used by calc-embedded."
+ "Alist of major modes with pairs of formula delimiters used by calc-embedded."
:group 'calc
:type '(alist :key-type (symbol :tag "Major mode")
:value-type (list (regexp :tag "Opening formula delimiter")
(regexp :tag "Closing formula delimiter"))))
-(defcustom calc-embedded-open-word
- "^\\|[^-+0-9.eE]"
- "*A regular expression for the opening delimiter of a formula used by calc-embedded-word."
- :group 'calc
- :type '(regexp))
-
-(defcustom calc-embedded-close-word
- "$\\|[^-+0-9.eE]"
- "*A regular expression for the closing delimiter of a formula used by calc-embedded-word."
+(defcustom calc-embedded-word-regexp
+ "[-+]?[0-9]+\\(\\.[0-9]+\\)?\\([eE][-+]?[0-9]+\\)?"
+ "A regular expression determining a word for calc-embedded-word."
:group 'calc
:type '(regexp))
-(defcustom calc-embedded-open-close-word-alist
+(defcustom calc-embedded-word-regexp-alist
nil
- "*Alist of major modes with pairs of word delimiters used by calc-embedded."
+ "Alist of major modes with word regexps used by calc-embedded-word."
:group 'calc
:type '(alist :key-type (symbol :tag "Major mode")
- :value-type (list (regexp :tag "Opening word delimiter")
- (regexp :tag "Closing word delimiter"))))
+ :value-type (regexp :tag "Regexp for word")))
(defcustom calc-embedded-open-plain
"%%% "
- "*A string which is the opening delimiter for a \"plain\" formula.
+ "A string which is the opening delimiter for a \"plain\" formula.
If calc-show-plain mode is enabled, this is inserted at the front of
each formula."
:group 'calc
(defcustom calc-embedded-close-plain
" %%%\n"
- "*A string which is the closing delimiter for a \"plain\" formula.
+ "A string which is the closing delimiter for a \"plain\" formula.
See calc-embedded-open-plain."
:group 'calc
:type '(string))
(sgml-mode "<!-- %% " " %% -->\n")
(xml-mode "<!-- %% " " %% -->\n")
(texinfo-mode "@c %% " " %%\n"))
- "*Alist of major modes with pairs of delimiters for \"plain\" formulas."
+ "Alist of major modes with pairs of delimiters for \"plain\" formulas."
:group 'calc
:type '(alist :key-type (symbol :tag "Major mode")
:value-type (list (string :tag "Opening \"plain\" delimiter")
(defcustom calc-embedded-open-new-formula
"\n\n"
- "*A string which is inserted at front of formula by calc-embedded-new-formula."
+ "A string which is inserted at front of formula by calc-embedded-new-formula."
:group 'calc
:type '(string))
(defcustom calc-embedded-close-new-formula
"\n\n"
- "*A string which is inserted at end of formula by calc-embedded-new-formula."
+ "A string which is inserted at end of formula by calc-embedded-new-formula."
:group 'calc
:type '(string))
(defcustom calc-embedded-open-close-new-formula-alist
nil
- "*Alist of major modes with pairs of new formula delimiters used by calc-embedded."
+ "Alist of major modes with pairs of new formula delimiters used by calc-embedded."
:group 'calc
:type '(alist :key-type (symbol :tag "Major mode")
:value-type (list (string :tag "Opening new formula delimiter")
(defcustom calc-embedded-open-mode
"% "
- "*A string which should precede calc-embedded mode annotations.
+ "A string which should precede calc-embedded mode annotations.
This is not required to be present for user-written mode annotations."
:group 'calc
:type '(string))
(defcustom calc-embedded-close-mode
"\n"
- "*A string which should follow calc-embedded mode annotations.
+ "A string which should follow calc-embedded mode annotations.
This is not required to be present for user-written mode annotations."
:group 'calc
:type '(string))
(sgml-mode "<!-- " " -->\n")
(xml-mode "<!-- " " -->\n")
(texinfo-mode "@c " "\n"))
- "*Alist of major modes with pairs of strings to delimit annotations."
+ "Alist of major modes with pairs of strings to delimit annotations."
:group 'calc
:type '(alist :key-type (symbol :tag "Major mode")
:value-type (list (string :tag "Opening annotation delimiter")
(string :tag "Closing annotation delimiter"))))
(defcustom calc-gnuplot-name
- "gnuplot"
- "*Name of GNUPLOT program, for calc-graph features."
+ (if (eq system-type 'windows-nt) "pgnuplot" "gnuplot")
+ "Name of GNUPLOT program, for calc-graph features."
:group 'calc
:type '(string))
(defcustom calc-gnuplot-plot-command
nil
- "*Name of command for displaying GNUPLOT output; %s = file name to print."
+ "Name of command for displaying GNUPLOT output; %s = file name to print."
:group 'calc
:type '(choice (string) (sexp)))
(defcustom calc-gnuplot-print-command
"lp %s"
- "*Name of command for printing GNUPLOT output; %s = file name to print."
+ "Name of command for printing GNUPLOT output; %s = file name to print."
:group 'calc
:type '(choice (string) (sexp)))
(defcustom calc-multiplication-has-precedence
t
- "*If non-nil, multiplication has precedence over division
+ "If non-nil, multiplication has precedence over division
in normal mode."
:group 'calc
:type 'boolean)
+(defcustom calc-undo-length
+ 100
+ "The number of undo steps that will be preserved when Calc is quit."
+ :group 'calc
+ :type 'integer)
+
+(defcustom calc-highlight-selections-with-faces
+ nil
+ "If non-nil, use a separate face to indicate selected sub-formulas.
+If `calc-show-selections' is non-nil, then selected sub-formulas are shown
+by displaying the rest of the formula in `calc-nonselected-face'.
+If `calc-show-selections' is nil, then selected sub-formulas are shown
+by displaying the sub-formula in `calc-selected-face'."
+ :group 'calc
+ :type 'boolean)
+
+(defcustom calc-lu-field-reference
+ "20 uPa"
+ "The default reference level for logarithmic units (field)."
+ :group 'calc
+ :type '(string))
+
+(defcustom calc-lu-power-reference
+ "mW"
+ "The default reference level for logarithmic units (power)."
+ :group 'calc
+ :type '(string))
+
+(defcustom calc-note-threshold "1"
+ "The number of cents that a frequency should be near a note
+to be identified as that note."
+ :type 'string
+ :group 'calc)
+
+(defface calc-nonselected-face
+ '((t :inherit shadow
+ :slant italic))
+ "Face used to show the non-selected portion of a formula."
+ :group 'calc)
+
+(defface calc-selected-face
+ '((t :weight bold))
+ "Face used to show the selected portion of a formula."
+ :group 'calc)
+
(defvar calc-bug-address "jay.p.belanger@gmail.com"
"Address of the maintainer of Calc, for use by `report-calc-bug'.")
(calc-mode-var-list-restore-default-values))))
(defcalcmodevar calc-always-load-extensions nil
- "If non-nil, load the calc-ext module automatically when calc is loaded.")
+ "If non-nil, load the calc-ext module automatically when Calc is loaded.")
(defcalcmodevar calc-line-numbering t
"If non-nil, display line numbers in Calculator stack.")
If `scalar', variables are assumed to be scalar-valued.
If nil, symbolic math routines make no assumptions about variables.")
+(defcalcmodevar calc-twos-complement-mode nil
+ "If non-nil, display integers in two's complement mode.")
+
+
(defcalcmodevar calc-shift-prefix nil
"If non-nil, shifted letter keys are prefix keys rather than normal meanings.")
(defcalcmodevar calc-autorange-units nil
"If non-nil, automatically set unit prefixes to keep units in a reasonable range.")
-(defcalcmodevar calc-was-keypad-mode nil)
+(defcalcmodevar calc-was-keypad-mode nil
+ "Non-nil if Calc was last invoked in keypad mode.")
-(defcalcmodevar calc-full-mode nil)
+(defcalcmodevar calc-full-mode nil
+ "Non-nil if Calc was last invoked in full-screen mode.")
-(defcalcmodevar calc-user-parse-tables nil)
+(defcalcmodevar calc-user-parse-tables nil
+ "Alist of languages with user-defined parse rules.")
-(defcalcmodevar calc-gnuplot-default-device "default")
+(defcalcmodevar calc-gnuplot-default-device "default"
+ "The default device name for GNUPLOT plotting.")
-(defcalcmodevar calc-gnuplot-default-output "STDOUT")
+(defcalcmodevar calc-gnuplot-default-output "STDOUT"
+ "The default output file for GNUPLOT plotting.")
-(defcalcmodevar calc-gnuplot-print-device "postscript")
+(defcalcmodevar calc-gnuplot-print-device "postscript"
+ "The default device name for GNUPLOT printing.")
-(defcalcmodevar calc-gnuplot-print-output "auto")
+(defcalcmodevar calc-gnuplot-print-output "auto"
+ "The default output for GNUPLOT printing.")
-(defcalcmodevar calc-gnuplot-geometry nil)
+(defcalcmodevar calc-gnuplot-geometry nil
+ "The default geometry for the GNUPLOT window.")
-(defcalcmodevar calc-graph-default-resolution 15)
+(defcalcmodevar calc-graph-default-resolution 15
+ "The default number of data points when plotting curves.")
-(defcalcmodevar calc-graph-default-resolution-3d 5)
+(defcalcmodevar calc-graph-default-resolution-3d 5
+ "The default number of x- and y- data points when plotting surfaces.")
-(defcalcmodevar calc-invocation-macro nil)
+(defcalcmodevar calc-invocation-macro nil
+ "A user defined macro for starting Calc.
+Used by `calc-user-invocation'.")
(defcalcmodevar calc-show-banner t
"*If non-nil, show a friendly greeting above the stack.")
calc-matrix-mode
calc-inverse-flag
calc-hyperbolic-flag
+ calc-option-flag
calc-keep-args-flag
calc-angle-mode
calc-number-radix
;; Set up the autoloading linkage.
(let ((name (and (fboundp 'calc-dispatch)
- (eq (car-safe (symbol-function 'calc-dispatch)) 'autoload)
- (nth 1 (symbol-function 'calc-dispatch))))
- (p load-path))
-
- ;; If Calc files exist on the load-path, we're all set.
- (while (and p (not (file-exists-p
- (expand-file-name "calc-misc.elc" (car p)))))
- (setq p (cdr p)))
- (or p
-
- ;; If Calc is autoloaded using a path name, look there for Calc files.
- ;; This works for both relative ("calc/calc.elc") and absolute paths.
- (and name (file-name-directory name)
- (let ((p2 load-path)
- (name2 (concat (file-name-directory name)
- "calc-misc.elc")))
- (while (and p2 (not (file-exists-p
- (expand-file-name name2 (car p2)))))
- (setq p2 (cdr p2)))
- (when p2
- (setq load-path (nconc load-path
- (list
- (directory-file-name
- (file-name-directory
- (expand-file-name
- name (car p2))))))))))))
+ (eq (car-safe (symbol-function 'calc-dispatch)) 'autoload)
+ (nth 1 (symbol-function 'calc-dispatch))))
+ (p load-path))
+
+ ;; If Calc files exist on the load-path, we're all set.
+ (while (and p (not (file-exists-p
+ (expand-file-name "calc-misc.elc" (car p)))))
+ (setq p (cdr p)))
+ (or p
+
+ ;; If Calc is autoloaded using a path name, look there for Calc files.
+ ;; This works for both relative ("calc/calc.elc") and absolute paths.
+ (and name (file-name-directory name)
+ (let ((p2 load-path)
+ (name2 (concat (file-name-directory name)
+ "calc-misc.elc")))
+ (while (and p2 (not (file-exists-p
+ (expand-file-name name2 (car p2)))))
+ (setq p2 (cdr p2)))
+ (when p2
+ (setq load-path (nconc load-path
+ (list
+ (directory-file-name
+ (file-name-directory
+ (expand-file-name
+ name (car p2))))))))))))
;; The following modes use specially-formatted data.
(put 'calc-mode 'mode-class 'special)
(put 'math-underflow 'error-conditions '(error math-underflow calc-error))
(put 'math-underflow 'error-message "Floating-point underflow occurred")
-(defconst calc-version "2.1")
-(defvar calc-trail-pointer nil) ; "Current" entry in trail buffer.
-(defvar calc-trail-overlay nil) ; Value of overlay-arrow-string.
-(defvar calc-undo-list nil) ; List of previous operations for undo.
-(defvar calc-redo-list nil) ; List of recent undo operations.
-(defvar calc-main-buffer nil) ; Pointer to Calculator buffer.
-(defvar calc-trail-buffer nil) ; Pointer to Calc Trail buffer.
-(defvar calc-why nil) ; Explanations of most recent errors.
+(defvar calc-trail-pointer nil
+ "The \"current\" entry in trail buffer.")
+(defvar calc-trail-overlay nil
+ "The value of overlay-arrow-string.")
+(defvar calc-undo-list nil
+ "The list of previous operations for undo.")
+(defvar calc-redo-list nil
+ "The list of recent undo operations.")
+(defvar calc-main-buffer nil
+ "A pointer to Calculator buffer.")
+(defvar calc-buffer-list nil
+ "A list of all Calc buffers.")
+(defvar calc-trail-buffer nil
+ "A pointer to Calc Trail buffer.")
+(defvar calc-why nil
+ "Explanations of most recent errors.")
(defvar calc-next-why nil)
(defvar calc-inverse-flag nil
"If non-nil, next operation is Inverse.")
(defvar calc-hyperbolic-flag nil
"If non-nil, next operation is Hyperbolic.")
+(defvar calc-option-flag nil
+ "If non-nil, next operation has Optional behavior.")
(defvar calc-keep-args-flag nil
"If non-nil, next operation should not remove its arguments from stack.")
(defvar calc-function-open "("
(defvar calc-lang-parens-are-subscripts nil
"Languages in which subscripts are indicated by parentheses.")
-(defvar calc-last-kill nil) ; Last number killed in calc-mode.
-(defvar calc-dollar-values nil) ; Values to be used for '$'.
-(defvar calc-dollar-used nil) ; Highest order of '$' that occurred.
-(defvar calc-hashes-used nil) ; Highest order of '#' that occurred.
-(defvar calc-quick-prev-results nil) ; Previous results from Quick Calc.
-(defvar calc-said-hello nil) ; Has welcome message been said yet?
-(defvar calc-executing-macro nil) ; Kbd macro executing from "K" key.
-(defvar calc-any-selections nil) ; Nil means no selections present.
-(defvar calc-help-phase 0) ; Count of consecutive "?" keystrokes.
-(defvar calc-full-help-flag nil) ; Executing calc-full-help?
-(defvar calc-refresh-count 0) ; Count of calc-refresh calls.
-(defvar calc-display-dirty nil)
+(defvar calc-last-kill nil
+ "The last number killed in calc-mode.")
+(defvar calc-dollar-values nil
+ "Values to be used for '$'.")
+(defvar calc-dollar-used nil
+ "The highest order of '$' that occurred.")
+(defvar calc-hashes-used nil
+ "The highest order of '#' that occurred.")
+(defvar calc-quick-prev-results nil
+ "Previous results from Quick Calc.")
+(defvar calc-said-hello nil
+ "Non-nil if the welcome message has been displayed.")
+(defvar calc-executing-macro nil
+ "Non-nil if a keyboard macro is executing from the \"K\" key.")
+(defvar calc-any-selections nil
+ "Non-nil if there are selections present.")
+(defvar calc-help-phase 0
+ "The number of consecutive \"?\" keystrokes.")
+(defvar calc-full-help-flag nil
+ "Non-nil if `calc-full-help' is being executed.")
+(defvar calc-refresh-count 0
+ "The number of `calc-refresh' calls.")
+(defvar calc-display-dirty nil
+ "Non-nil if the stack display might not reflect the latest mode settings.")
(defvar calc-prepared-composition nil)
(defvar calc-selection-cache-default-entry nil)
-(defvar calc-embedded-info nil)
-(defvar calc-embedded-active nil)
-(defvar calc-standalone-flag nil)
-(defvar var-EvalRules nil)
+(defvar calc-embedded-info nil
+ "If non-nil, a vector consisting of information for embedded mode.")
+(defvar calc-embedded-active nil
+ "Alist of buffers with sorted lists of calc-embedded-infos.")
+(defvar calc-standalone-flag nil
+ "Non-nil if Emacs started with standalone Calc.")
+(defvar var-EvalRules nil
+ "User defined rules that Calc will apply automatically.")
(defvar math-eval-rules-cache-tag t)
(defvar math-radix-explicit-format t)
-(defvar math-expr-function-mapping nil)
-(defvar math-expr-variable-mapping nil)
+(defvar math-expr-function-mapping nil
+ "Alist of language specific functions with Calc functions.")
+(defvar math-expr-variable-mapping nil
+ "Alist of language specific variables with Calc variables.")
(defvar math-read-expr-quotes nil)
(defvar math-working-step nil)
(defvar math-working-step-2 nil)
(defvar var-i '(special-const (math-imaginary 1)))
(defvar var-pi '(special-const (math-pi)))
+(defvar var-Ï€ '(special-const (math-pi)))
(defvar var-e '(special-const (math-e)))
(defvar var-phi '(special-const (math-phi)))
+(defvar var-φ '(special-const (math-phi)))
(defvar var-gamma '(special-const (math-gamma-const)))
+(defvar var-γ '(special-const (math-gamma-const)))
(defvar var-Modes '(special-const (math-get-modes-vec)))
(mapc (lambda (v) (or (boundp v) (set v nil)))
(define-key map "\"" 'calc-auto-algebraic-entry)
(define-key map "\t" 'calc-roll-down)
(define-key map "\M-\t" 'calc-roll-up)
+ (define-key map "\C-x\C-t" 'calc-transpose-lines)
(define-key map "\C-m" 'calc-enter)
(define-key map "\M-\C-m" 'calc-last-args-stub)
(define-key map "\C-j" 'calc-over)
+ (define-key map "\C-y" 'calc-yank)
+ (define-key map [mouse-2] 'calc-yank)
+ (define-key map [remap undo] 'calc-undo)
(mapc (lambda (x) (define-key map (char-to-string x) 'undefined))
- "lOW")
+ "lOW")
(mapc (lambda (x) (define-key map (char-to-string x) 'calc-missing-key))
- (concat "ABCDEFGHIJKLMNPQRSTUVXZabcdfghjkmoprstuvwxyz"
- ":\\|!()[]<>{},;=~`\C-k\M-k\C-w\M-w\C-y\C-_"))
+ (concat "ABCDEFGHIJKLMNOPQRSTUVXZabcdfghjkmoprstuvwxyz"
+ ":\\|!()[]<>{},;=~`\C-k\C-w"))
+ (define-key map "\M-w" 'calc-missing-key)
+ (define-key map "\M-k" 'calc-missing-key)
+ (define-key map "\M-\C-w" 'calc-missing-key)
(mapc (lambda (x) (define-key map (char-to-string x) 'calcDigit-start))
- "_0123456789.#@")
- map))
+ "_0123456789.#@")
+ map)
+ "The key map for Calc.")
(defvar calc-digit-map
(let ((map (make-keymap)))
- (if (featurep 'xemacs)
- (map-keymap (function
- (lambda (keys bind)
- (define-key map keys
- (if (eq bind 'undefined)
- 'undefined 'calcDigit-nondigit))))
- calc-mode-map)
- (let ((cmap (nth 1 calc-mode-map))
- (dmap (nth 1 map))
- (i 0))
- (while (< i 128)
- (aset dmap i
- (if (eq (aref cmap i) 'undefined)
- 'undefined 'calcDigit-nondigit))
- (setq i (1+ i)))))
+ (map-keymap (lambda (key bind)
+ (define-key map (vector key)
+ (if (eq bind 'undefined)
+ 'undefined 'calcDigit-nondigit)))
+ calc-mode-map)
(mapc (lambda (x) (define-key map (char-to-string x) 'calcDigit-key))
- "_0123456789.e+-:n#@oh'\"mspM")
+ "_0123456789.e+-:n#@oh'\"mspM")
(mapc (lambda (x) (define-key map (char-to-string x) 'calcDigit-letter))
- "abcdfgijklqrtuvwxyzABCDEFGHIJKLNOPQRSTUVWXYZ")
+ "abcdfgijklqrtuvwxyzABCDEFGHIJKLNOPQRSTUVWXYZ")
(define-key map "'" 'calcDigit-algebraic)
(define-key map "`" 'calcDigit-edit)
(define-key map "\C-g" 'abort-recursive-edit)
- map))
+ map)
+ "The key map for entering Calc digits.")
(mapc (lambda (x)
(condition-case err
(define-key calc-digit-map x 'calcDigit-backspace)
(define-key calc-mode-map x 'calc-pop)
(define-key calc-mode-map
- (if (vectorp x)
- (if (featurep 'xemacs)
- (if (= (length x) 1)
- (vector (if (consp (aref x 0))
- (cons 'meta (aref x 0))
- (list 'meta (aref x 0))))
- "\e\C-d")
- (vconcat "\e" x))
- (concat "\e" x))
+ (if (and (vectorp x) (featurep 'xemacs))
+ (if (= (length x) 1)
+ (vector (if (consp (aref x 0))
+ (cons 'meta (aref x 0))
+ (list 'meta (aref x 0))))
+ "\e\C-d")
+ (vconcat "\e" x))
'calc-pop-above))
(error nil)))
(if calc-scan-for-dels
(defvar calc-dispatch-map
(let ((map (make-keymap)))
(mapc (lambda (x)
- (define-key map (char-to-string (car x)) (cdr x))
- (when (string-match "abcdefhijklnopqrstuwxyz"
- (char-to-string (car x)))
- (define-key map (char-to-string (- (car x) ?a -1)) (cdr x)))
- (define-key map (format "\e%c" (car x)) (cdr x)))
- '( ( ?a . calc-embedded-activate )
- ( ?b . calc-big-or-small )
- ( ?c . calc )
- ( ?d . calc-embedded-duplicate )
- ( ?e . calc-embedded )
- ( ?f . calc-embedded-new-formula )
- ( ?g . calc-grab-region )
- ( ?h . calc-dispatch-help )
- ( ?i . calc-info )
- ( ?j . calc-embedded-select )
- ( ?k . calc-keypad )
- ( ?l . calc-load-everything )
- ( ?m . read-kbd-macro )
- ( ?n . calc-embedded-next )
- ( ?o . calc-other-window )
- ( ?p . calc-embedded-previous )
- ( ?q . quick-calc )
- ( ?r . calc-grab-rectangle )
- ( ?s . calc-info-summary )
- ( ?t . calc-tutorial )
- ( ?u . calc-embedded-update-formula )
- ( ?w . calc-embedded-word )
- ( ?x . calc-quit )
- ( ?y . calc-copy-to-buffer )
- ( ?z . calc-user-invocation )
- ( ?\' . calc-embedded-new-formula )
- ( ?\` . calc-embedded-edit )
- ( ?: . calc-grab-sum-down )
- ( ?_ . calc-grab-sum-across )
- ( ?0 . calc-reset )
- ( ?? . calc-dispatch-help )
- ( ?# . calc-same-interface )
- ( ?& . calc-same-interface )
- ( ?\\ . calc-same-interface )
- ( ?= . calc-same-interface )
- ( ?* . calc-same-interface )
- ( ?/ . calc-same-interface )
- ( ?+ . calc-same-interface )
- ( ?- . calc-same-interface ) ))
- map))
+ (let* ((x-chr (car x))
+ (x-str (char-to-string x-chr))
+ (x-def (cdr x)))
+ (define-key map x-str x-def)
+ (when (string-match "[a-z]" x-str)
+ ;; Map upper case char to same definition.
+ (define-key map (upcase x-str) x-def)
+ (unless (string-match "[gmv]" x-str)
+ ;; Map control prefixed char to same definition.
+ (define-key map (vector (list 'control x-chr)) x-def)))
+ (define-key map (format "\e%c" x-chr) x-def)))
+ '( ( ?a . calc-embedded-activate )
+ ( ?b . calc-big-or-small )
+ ( ?c . calc )
+ ( ?d . calc-embedded-duplicate )
+ ( ?e . calc-embedded )
+ ( ?f . calc-embedded-new-formula )
+ ( ?g . calc-grab-region )
+ ( ?h . calc-dispatch-help )
+ ( ?i . calc-info )
+ ( ?j . calc-embedded-select )
+ ( ?k . calc-keypad )
+ ( ?l . calc-load-everything )
+ ( ?m . read-kbd-macro )
+ ( ?n . calc-embedded-next )
+ ( ?o . calc-other-window )
+ ( ?p . calc-embedded-previous )
+ ( ?q . quick-calc )
+ ( ?r . calc-grab-rectangle )
+ ( ?s . calc-info-summary )
+ ( ?t . calc-tutorial )
+ ( ?u . calc-embedded-update-formula )
+ ( ?w . calc-embedded-word )
+ ( ?x . calc-quit )
+ ( ?y . calc-copy-to-buffer )
+ ( ?z . calc-user-invocation )
+ ( ?\' . calc-embedded-new-formula )
+ ( ?\` . calc-embedded-edit )
+ ( ?: . calc-grab-sum-down )
+ ( ?_ . calc-grab-sum-across )
+ ( ?0 . calc-reset )
+ ( ?? . calc-dispatch-help )
+ ( ?# . calc-same-interface )
+ ( ?& . calc-same-interface )
+ ( ?\\ . calc-same-interface )
+ ( ?= . calc-same-interface )
+ ( ?* . calc-same-interface )
+ ( ?/ . calc-same-interface )
+ ( ?+ . calc-same-interface )
+ ( ?- . calc-same-interface ) ))
+ map)
+ "The key map for starting Calc.")
-;;;; (Autoloads here)
-(mapc
- (lambda (x) (dolist (func (cdr x)) (autoload func (car x))))
- '(
-
- ("calc-aent" calc-alg-digit-entry calc-alg-entry
- calc-check-user-syntax calc-do-alg-entry calc-do-calc-eval
- calc-do-quick-calc calc-match-user-syntax math-build-parse-table
- math-find-user-tokens math-read-expr-list math-read-exprs math-read-if
- math-read-token math-remove-dashes math-read-preprocess-string)
-
- ("calc-embed" calc-do-embedded-activate)
-
- ("calc-misc"
- calc-do-handle-whys calc-do-refresh calc-num-prefix-name
- calc-record-list calc-record-why calc-report-bug calc-roll-down-stack
- calc-roll-up-stack calc-temp-minibuffer-message calcFunc-floor
- calcFunc-inv calcFunc-trunc math-concat math-constp math-div2
- math-div2-bignum math-do-working math-evenp math-fixnatnump
- math-fixnump math-floor math-imod math-ipow math-looks-negp math-mod
- math-negp math-posp math-pow math-read-radix-digit math-reject-arg
- math-trunc math-zerop)))
-
-(mapc
- (lambda (x) (dolist (cmd (cdr x)) (autoload cmd (car x) nil t)))
- '(
-
- ("calc-aent" calc-algebraic-entry calc-auto-algebraic-entry
- calcDigit-algebraic calcDigit-edit)
-
- ("calc-misc" another-calc calc-big-or-small calc-dispatch-help
- calc-help calc-info calc-info-goto-node calc-info-summary calc-inv
- calc-last-args-stub
- calc-missing-key calc-mod calc-other-window calc-over calc-percent
- calc-pop-above calc-power calc-roll-down calc-roll-up
- calc-shift-Y-prefix-help calc-tutorial calcDigit-letter
- report-calc-bug)))
+;;;; (Autoloads here)
+(load "calc-loaddefs.el" nil t)
;;;###autoload (define-key ctl-x-map "*" 'calc-dispatch)
(defvar calc-dispatch-help nil)
(defun calc-do-dispatch (arg)
+ "Start the Calculator."
(let ((key (calc-read-key-sequence
(if calc-dispatch-help
"Calc options: Calc, Keypad, Quick, Embed; eXit; Info, Tutorial; Grab; ?=more"
(beep))))
(defun calc-read-key-sequence (prompt map)
+ "Read keys, with prompt PROMPT and keymap MAP."
(let ((prompt2 (format "%s " (key-description (this-command-keys))))
(glob (current-global-map))
(loc (current-local-map)))
(or (input-pending-p) (message "%s" prompt))
- (let ((key (calc-read-key t)))
+ (let ((key (calc-read-key t))
+ (input-method-function nil))
(calc-unread-command (cdr key))
(unwind-protect
(progn
(defvar calc-alg-map) ; Defined in calc-ext.el
-(defun calc-version ()
- "Return version of this version of Calc."
- (interactive)
- (message "Calc version %s" calc-version))
+
+(defvar calc-embedded-modes) ; Defined in calc-embed.el
+(defvar calc-override-minor-modes) ; Defined in calc-embed.el
+(defun calc-kill-stack-buffer ()
+ "Check to see if user wants to kill the Calc stack buffer.
+This will look for buffers using the Calc buffer for embedded mode,
+and inform the user if there are any.
+If the user wants to kill the Calc buffer, this will remove
+embedded information from the appropriate buffers and tidy up
+the trail buffer."
+ (let ((cb (current-buffer))
+ (info-list nil)
+ (buflist)
+; (plural nil)
+ (cea calc-embedded-active))
+ ;; Get a list of all buffers using this buffer for
+ ;; embedded Calc.
+ (while cea
+ (when (and (eq cb (aref (nth 1 (car cea)) 1))
+ (buffer-name (car (car cea))))
+ (setq info-list (cons (car cea) info-list)))
+ (setq cea (cdr cea)))
+ ;; Eventually, prompt user with a list of buffers using embedded mode.
+ (when (and
+ info-list
+ (yes-or-no-p
+ (concat "This Calc stack is being used for embedded mode. Kill anyway?")))
+ (while info-list
+ (with-current-buffer (car (car info-list))
+ (when calc-embedded-info
+ (setq calc-embedded-info nil
+ mode-line-buffer-identification (car calc-embedded-modes)
+ truncate-lines (nth 2 calc-embedded-modes)
+ buffer-read-only nil)
+ (use-local-map (nth 1 calc-embedded-modes))
+ (setq minor-mode-overriding-map-alist
+ (remq calc-override-minor-modes minor-mode-overriding-map-alist))
+ (let ((str mode-line-buffer-identification))
+ (setq mode-line-buffer-identification str))
+ (set-buffer-modified-p (buffer-modified-p))))
+ (setq calc-embedded-active
+ (delete (car info-list) calc-embedded-active))
+ (setq info-list (cdr info-list))))
+ (if (not info-list)
+ (progn
+ (setq calc-buffer-list (delete cb calc-buffer-list))
+ (if (buffer-live-p calc-trail-buffer)
+ (with-current-buffer calc-trail-buffer
+ (if (eq cb calc-main-buffer)
+ ;; If there are other Calc stacks, make another one
+ ;; the calc-main-buffer ...
+ (if calc-buffer-list
+ (setq calc-main-buffer (car calc-buffer-list))
+ ;; ... otherwise kill the trail and its windows.
+ (let ((wl (get-buffer-window-list calc-trail-buffer)))
+ (while wl
+ (delete-window (car wl))
+ (setq wl (cdr wl))))
+ (kill-buffer calc-trail-buffer)))))
+ (setq calc-trail-buffer nil)
+ t))))
(defun calc-mode ()
"Calculator major mode.
(make-local-variable 'overlay-arrow-position)
(make-local-variable 'overlay-arrow-string)
(add-hook 'change-major-mode-hook 'font-lock-defontify nil t)
+ (add-hook 'kill-buffer-query-functions
+ 'calc-kill-stack-buffer
+ t t)
(setq truncate-lines t)
(setq buffer-read-only t)
(setq major-mode 'calc-mode)
(run-mode-hooks 'calc-mode-hook)
(calc-refresh t)
(calc-set-mode-line)
- (calc-check-defines))
+ (calc-check-defines)
+ (if calc-buffer-list (setq calc-stack (copy-sequence calc-stack)))
+ (add-to-list 'calc-buffer-list (current-buffer) t))
(defvar calc-check-defines 'calc-check-defines) ; suitable for run-hooks
(defun calc-check-defines ()
(set (make-local-variable 'calc-main-buffer) buf))
(when (= (buffer-size) 0)
(let ((buffer-read-only nil))
- (insert (propertize (concat "Emacs Calculator Trail\n")
- 'font-lock-face 'italic))))
+ (insert (propertize "Emacs Calculator Trail\n" 'face 'italic))))
(run-mode-hooks 'calc-trail-mode-hook))
(defun calc-create-buffer ()
+ "Create and initialize a buffer for the Calculator."
(set-buffer (get-buffer-create "*Calculator*"))
(or (eq major-mode 'calc-mode)
(calc-mode))
(set-window-buffer w (current-buffer))
(select-window w))
(pop-to-buffer (current-buffer)))))))
- (save-excursion
- (set-buffer (calc-trail-buffer))
+ (with-current-buffer (calc-trail-buffer)
(and calc-display-trail
(= (window-width) (frame-width))
(calc-trail-display 1 t)))
(calc arg calc-full-mode t)))))
(defun calc-quit (&optional non-fatal interactive)
+ "Quit the Calculator in an appropriate manner."
(interactive "i\np")
(and calc-standalone-flag (not non-fatal)
(save-buffers-kill-emacs nil))
(unless (eq major-mode 'calc-mode)
(calc-create-buffer))
(run-hooks 'calc-end-hook)
- (setq calc-undo-list nil calc-redo-list nil)
+ (if (integerp calc-undo-length)
+ (cond
+ ((= calc-undo-length 0)
+ (setq calc-undo-list nil calc-redo-list nil))
+ ((> calc-undo-length 0)
+ (let ((tail (nthcdr (1- calc-undo-length) calc-undo-list)))
+ (if tail (setcdr tail nil)))
+ (setq calc-redo-list nil))))
(mapc (function (lambda (v) (set-default v (symbol-value v))))
calc-local-var-list)
(let ((buf (current-buffer))
(win (get-buffer-window (current-buffer)))
(kbuf (get-buffer "*Calc Keypad*")))
(delete-windows-on (calc-trail-buffer))
+ ;; The next few lines will set `calc-window-height' so that the
+ ;; next time Calc is called, the window will be the same size
+ ;; as the current window.
(if (and win
- (< (window-height win) (1- (frame-height)))
- (= (window-width win) (frame-width)) ; avoid calc-keypad
+ (not (window-full-height-p win))
+ (window-full-width-p win) ; avoid calc-keypad
(not (get-buffer-window "*Calc Keypad*")))
(setq calc-window-height (- (window-height win) 2)))
(progn
(delete-windows-on buf)
- (delete-windows-on kbuf))
+ (and kbuf (delete-windows-on kbuf)))
(bury-buffer buf)
(bury-buffer calc-trail-buffer)
(and kbuf (bury-buffer kbuf))))))
(defvar calc-aborted-prefix nil)
(defvar calc-start-time nil)
-(defvar calc-command-flags)
+(defvar calc-command-flags nil)
(defvar calc-final-point-line)
(defvar calc-final-point-column)
;;; Note that modifications to this function may break calc-pass-errors.
(and (memq 'position-point calc-command-flags)
(if (eq major-mode 'calc-mode)
(progn
- (goto-line calc-final-point-line)
+ (goto-char (point-min))
+ (forward-line (1- calc-final-point-line))
(move-to-column calc-final-point-column))
(save-current-buffer
(calc-select-buffer)
- (goto-line calc-final-point-line)
+ (goto-char (point-min))
+ (forward-line (1- calc-final-point-line))
(move-to-column calc-final-point-column))))
(unless (memq 'keep-flags calc-command-flags)
(save-excursion
(calc-select-buffer)
(setq calc-inverse-flag nil
calc-hyperbolic-flag nil
+ calc-option-flag nil
calc-keep-args-flag nil)))
(when (memq 'do-edit calc-command-flags)
(switch-to-buffer (get-buffer-create "*Calc Edit*")))
(figs (nth 1 calc-float-format))
(new-mode-string
(format "Calc%s%s: %d %s %-14s"
- (if calc-embedded-info "Embed" "")
+ (if (and calc-embedded-info
+ (eq (aref calc-embedded-info 1) (current-buffer)))
+ "Embed" "")
(if (and (> (length (buffer-name)) 12)
(equal (substring (buffer-name) 0 12)
"*Calculator*"))
((= calc-number-radix 8) "Oct ")
((= calc-number-radix 16) "Hex ")
(t (format "Radix%d " calc-number-radix)))
+ (if calc-twos-complement-mode "TwosComp " "")
(if calc-leading-zeros "Zero " "")
(cond ((null calc-language) "")
((get calc-language 'math-lang-name)
(> (calc-stack-size) 0)
(calc-top 1 'sel)) "Sel " "")
(if calc-display-dirty "Dirty " "")
+ (if calc-option-flag "Opt " "")
(if calc-inverse-flag "Inv " "")
(if calc-hyperbolic-flag "Hyp " "")
(if calc-keep-args-flag "Keep " "")
(erase-buffer)
(when calc-show-banner
(insert (propertize "--- Emacs Calculator Mode ---\n"
- 'font-lock-face 'italic)))
+ 'face 'italic)))
(while thing
(goto-char (point-min))
(when calc-show-banner
(goto-char save-point))
(if save-mark (set-mark save-mark))))
(and calc-embedded-info (not (eq major-mode 'calc-mode))
- (save-excursion
- (set-buffer (aref calc-embedded-info 1))
+ (with-current-buffer (aref calc-embedded-info 1)
(calc-refresh align)))
(setq calc-refresh-count (1+ calc-refresh-count)))
(calc-trail-mode buf)))))
(or (and calc-trail-pointer
(eq (marker-buffer calc-trail-pointer) calc-trail-buffer))
- (save-excursion
- (set-buffer calc-trail-buffer)
- (goto-line 2)
+ (with-current-buffer calc-trail-buffer
+ (goto-char (point-min))
+ (forward-line 1)
(setq calc-trail-pointer (point-marker))))
calc-trail-buffer)
(math-showing-full-precision
(math-format-flat-expr val 0)))
"")))
- (save-excursion
- (set-buffer buf)
+ (with-current-buffer buf
(let ((aligned (calc-check-trail-aligned))
(buffer-read-only nil))
(goto-char (point-max))
(interactive)
(calc-wrapper
(if (or calc-algebraic-mode
- (and (> calc-number-radix 14) (eq last-command-char ?e)))
+ (and (> calc-number-radix 14) (eq last-command-event ?e)))
(calc-alg-digit-entry)
(calc-unread-command)
(setq calc-aborted-prefix nil)
(or (boundp 'calc-buffer)
(use-local-map minibuffer-local-map))
(let ((str (minibuffer-contents)))
- (setq calc-digit-value (save-excursion
- (set-buffer calc-buffer)
+ (setq calc-digit-value (with-current-buffer calc-buffer
(math-read-number str))))
(if (and (null calc-digit-value) (> (calc-minibuffer-size) 0))
(progn
(beep)
(calc-temp-minibuffer-message " [Bad format]"))
- (or (memq last-command-char '(32 13))
+ (or (memq last-command-event '(32 13))
(progn (setq prefix-arg current-prefix-arg)
- (calc-unread-command (if (and (eq last-command-char 27)
- (>= last-input-char 128))
- last-input-char
+ (calc-unread-command (if (and (eq last-command-event 27)
+ (>= last-input-event 128))
+ last-input-event
nil))))
(exit-minibuffer)))
(defun calcDigit-key ()
(interactive)
(goto-char (point-max))
- (if (or (and (memq last-command-char '(?+ ?-))
+ (if (or (and (memq last-command-event '(?+ ?-))
(> (buffer-size) 0)
(/= (preceding-char) ?e))
- (and (memq last-command-char '(?m ?s))
+ (and (memq last-command-event '(?m ?s))
(not (calc-minibuffer-contains "[-+]?[0-9]+\\.?0*[@oh].*"))
(not (calc-minibuffer-contains "[-+]?\\(1[1-9]\\|[2-9][0-9]\\)#.*"))))
(calcDigit-nondigit)
(if (calc-minibuffer-contains "\\([-+]?\\|.* \\)\\'")
- (cond ((memq last-command-char '(?. ?@)) (insert "0"))
- ((and (memq last-command-char '(?o ?h ?m))
+ (cond ((memq last-command-event '(?. ?@)) (insert "0"))
+ ((and (memq last-command-event '(?o ?h ?m))
(not (calc-minibuffer-contains ".*#.*"))) (insert "0"))
- ((memq last-command-char '(?: ?e)) (insert "1"))
- ((eq last-command-char ?#)
+ ((memq last-command-event '(?: ?e)) (insert "1"))
+ ((eq last-command-event ?#)
(insert (int-to-string calc-number-radix)))))
(if (and (calc-minibuffer-contains "\\([-+]?[0-9]+#\\|[^:]*:\\)\\'")
- (eq last-command-char ?:))
+ (eq last-command-event ?:))
(insert "1"))
(if (and (calc-minibuffer-contains "[-+]?[0-9]+#\\'")
- (eq last-command-char ?.))
+ (eq last-command-event ?.))
(insert "0"))
(if (and (calc-minibuffer-contains "[-+]?0*\\([2-9]\\|1[0-4]\\)#\\'")
- (eq last-command-char ?e))
+ (eq last-command-event ?e))
(insert "1"))
- (if (or (and (memq last-command-char '(?h ?o ?m ?s ?p))
+ (if (or (and (memq last-command-event '(?h ?o ?m ?s ?p))
(calc-minibuffer-contains ".*#.*"))
- (and (eq last-command-char ?e)
+ (and (eq last-command-event ?e)
(calc-minibuffer-contains "[-+]?\\(1[5-9]\\|[2-9][0-9]\\)#.*"))
- (and (eq last-command-char ?n)
+ (and (eq last-command-event ?n)
(calc-minibuffer-contains "[-+]?\\(2[4-9]\\|[3-9][0-9]\\)#.*")))
- (setq last-command-char (upcase last-command-char)))
+ (setq last-command-event (upcase last-command-event)))
(cond
- ((memq last-command-char '(?_ ?n))
+ ((memq last-command-event '(?_ ?n))
(goto-char (minibuffer-prompt-end))
(if (and (search-forward " +/- " nil t)
(not (search-forward "e" nil t)))
(delete-char 1)
(insert "-")))
(goto-char (point-max)))
- ((eq last-command-char ?p)
+ ((eq last-command-event ?p)
(if (or (calc-minibuffer-contains ".*\\+/-.*")
(calc-minibuffer-contains ".*mod.*")
(calc-minibuffer-contains ".*#.*")
(if (not (calc-minibuffer-contains ".* \\'"))
(insert " "))
(insert "+/- ")))
- ((and (eq last-command-char ?M)
+ ((and (eq last-command-event ?M)
(not (calc-minibuffer-contains
"[-+]?\\(2[3-9]\\|[3-9][0-9]\\)#.*")))
(if (or (calc-minibuffer-contains ".*\\+/-.*")
(insert " "))
(insert "mod "))))
(t
- (insert (char-to-string last-command-char))
- (if (or (and (calc-minibuffer-contains "[-+]?\\(.*\\+/- *\\|.*mod *\\)?\\([0-9][0-9]?\\)#[0-9a-zA-Z]*\\(:[0-9a-zA-Z]*\\(:[0-9a-zA-Z]*\\)?\\|.[0-9a-zA-Z]*\\(e[-+]?[0-9]*\\)?\\)?\\'")
+ (insert (char-to-string last-command-event))
+ (if (or (and (calc-minibuffer-contains "[-+]?\\(.*\\+/- *\\|.*mod *\\)?\\([0-9][0-9]?\\)#[#]?[0-9a-zA-Z]*\\(:[0-9a-zA-Z]*\\(:[0-9a-zA-Z]*\\)?\\|.[0-9a-zA-Z]*\\(e[-+]?[0-9]*\\)?\\)?\\'")
(let ((radix (string-to-number
(buffer-substring
(match-beginning 2) (match-end 2)))))
(and (>= radix 2)
(<= radix 36)
- (or (memq last-command-char '(?# ?: ?. ?e ?+ ?-))
+ (or (memq last-command-event '(?# ?: ?. ?e ?+ ?-))
(let ((dig (math-read-radix-digit
- (upcase last-command-char))))
+ (upcase last-command-event))))
(and dig
(< dig radix)))))))
(calc-minibuffer-contains
"[-+]?\\(.*\\+/- *\\|.*mod *\\)?\\([0-9]+\\.?0*[@oh] *\\)?\\([0-9]+\\.?0*['m] *\\)?[0-9]*\\(\\.?[0-9]*\\(e[-+]?[0-3]?[0-9]?[0-9]?[0-9]?[0-9]?[0-9]?[0-9]?\\)?\\|[0-9]:\\([0-9]+:\\)?[0-9]*\\)?[\"s]?\\'"))
- (if (and (memq last-command-char '(?@ ?o ?h ?\' ?m))
+ (if (and (memq last-command-event '(?@ ?o ?h ?\' ?m))
(string-match " " calc-hms-format))
(insert " "))
(if (and (eq this-command last-command)
- (eq last-command-char ?.))
+ (eq last-command-event ?.))
(progn
(require 'calc-ext)
(calc-digit-dots))
- (delete-backward-char 1)
+ (delete-char -1)
(beep)
(calc-temp-minibuffer-message " [Bad format]"))))))
(setq calc-prev-prev-char calc-prev-char
- calc-prev-char last-command-char))
+ calc-prev-char last-command-event))
(defun calcDigit-backspace ()
(t (backward-delete-char 1)))
(if (= (calc-minibuffer-size) 0)
(progn
- (setq last-command-char 13)
+ (setq last-command-event 13)
(calcDigit-nondigit))))
;;;; Arithmetic routines.
-;;;
-;;; An object as manipulated by one of these routines may take any of the
-;;; following forms:
-;;;
-;;; integer An integer. For normalized numbers, this format
-;;; is used only for
-;;; negative math-small-integer-size + 1 to
-;;; math-small-integer-size - 1
-;;;
-;;; (bigpos N0 N1 N2 ...) A big positive integer,
-;;; N0 + N1*math-bignum-digit-size
-;;; + N2*(math-bignum-digit-size)^2 ...
-;;; (bigneg N0 N1 N2 ...) A big negative integer,
-;;; - N0 - N1*math-bignum-digit-size ...
-;;; Each digit N is in the range
-;;; 0 ... math-bignum-digit-size -1.
-;;; Normalized, always at least three N present,
-;;; and the most significant N is nonzero.
-;;;
-;;; (frac NUM DEN) A fraction. NUM and DEN are small or big integers.
-;;; Normalized, DEN > 1.
-;;;
-;;; (float NUM EXP) A floating-point number, NUM * 10^EXP;
-;;; NUM is a small or big integer, EXP is a small int.
-;;; Normalized, NUM is not a multiple of 10, and
-;;; abs(NUM) < 10^calc-internal-prec.
-;;; Normalized zero is stored as (float 0 0).
-;;;
-;;; (cplx REAL IMAG) A complex number; REAL and IMAG are any of above.
-;;; Normalized, IMAG is nonzero.
-;;;
-;;; (polar R THETA) Polar complex number. Normalized, R > 0 and THETA
-;;; is neither zero nor 180 degrees (pi radians).
-;;;
-;;; (vec A B C ...) Vector of objects A, B, C, ... A matrix is a
-;;; vector of vectors.
-;;;
-;;; (hms H M S) Angle in hours-minutes-seconds form. All three
-;;; components have the same sign; H and M must be
-;;; numerically integers; M and S are expected to
-;;; lie in the range [0,60).
-;;;
-;;; (date N) A date or date/time object. N is an integer to
-;;; store a date only, or a fraction or float to
-;;; store a date and time.
-;;;
-;;; (sdev X SIGMA) Error form, X +/- SIGMA. When normalized,
-;;; SIGMA > 0. X is any complex number and SIGMA
-;;; is real numbers; or these may be symbolic
-;;; expressions where SIGMA is assumed real.
-;;;
-;;; (intv MASK LO HI) Interval form. MASK is 0=(), 1=(], 2=[), or 3=[].
-;;; LO and HI are any real numbers, or symbolic
-;;; expressions which are assumed real, and LO < HI.
-;;; For [LO..HI], if LO = HI normalization produces LO,
-;;; and if LO > HI normalization produces [LO..LO).
-;;; For other intervals, if LO > HI normalization
-;;; sets HI equal to LO.
-;;;
-;;; (mod N M) Number modulo M. When normalized, 0 <= N < M.
-;;; N and M are real numbers.
-;;;
-;;; (var V S) Symbolic variable. V is a Lisp symbol which
-;;; represents the variable's visible name. S is
-;;; the symbol which actually stores the variable's
-;;; value: (var pi var-pi).
-;;;
-;;; In general, combining rational numbers in a calculation always produces
-;;; a rational result, but if either argument is a float, result is a float.
-
-;;; In the following comments, [x y z] means result is x, args must be y, z,
-;;; respectively, where the code letters are:
-;;;
-;;; O Normalized object (vector or number)
-;;; V Normalized vector
-;;; N Normalized number of any type
-;;; N Normalized complex number
-;;; R Normalized real number (float or rational)
-;;; F Normalized floating-point number
-;;; T Normalized rational number
-;;; I Normalized integer
-;;; B Normalized big integer
-;;; S Normalized small integer
-;;; D Digit (small integer, 0..999)
-;;; L Normalized bignum digit list (without "bigpos" or "bigneg" symbol)
-;;; or normalized vector element list (without "vec")
-;;; P Predicate (truth value)
-;;; X Any Lisp object
-;;; Z "nil"
-;;;
-;;; Lower-case letters signify possibly un-normalized values.
-;;; "L.D" means a cons of an L and a D.
-;;; [N N; n n] means result will be normalized if argument is.
-;;; Also, [Public] marks routines intended to be called from outside.
-;;; [This notation has been neglected in many recent routines.]
+;;
+;; An object as manipulated by one of these routines may take any of the
+;; following forms:
+;;
+;; integer An integer. For normalized numbers, this format
+;; is used only for
+;; negative math-small-integer-size + 1 to
+;; math-small-integer-size - 1
+;;
+;; (bigpos N0 N1 N2 ...) A big positive integer,
+;; N0 + N1*math-bignum-digit-size
+;; + N2*(math-bignum-digit-size)^2 ...
+;; (bigneg N0 N1 N2 ...) A big negative integer,
+;; - N0 - N1*math-bignum-digit-size ...
+;; Each digit N is in the range
+;; 0 ... math-bignum-digit-size -1.
+;; Normalized, always at least three N present,
+;; and the most significant N is nonzero.
+;;
+;; (frac NUM DEN) A fraction. NUM and DEN are small or big integers.
+;; Normalized, DEN > 1.
+;;
+;; (float NUM EXP) A floating-point number, NUM * 10^EXP;
+;; NUM is a small or big integer, EXP is a small int.
+;; Normalized, NUM is not a multiple of 10, and
+;; abs(NUM) < 10^calc-internal-prec.
+;; Normalized zero is stored as (float 0 0).
+;;
+;; (cplx REAL IMAG) A complex number; REAL and IMAG are any of above.
+;; Normalized, IMAG is nonzero.
+;;
+;; (polar R THETA) Polar complex number. Normalized, R > 0 and THETA
+;; is neither zero nor 180 degrees (pi radians).
+;;
+;; (vec A B C ...) Vector of objects A, B, C, ... A matrix is a
+;; vector of vectors.
+;;
+;; (hms H M S) Angle in hours-minutes-seconds form. All three
+;; components have the same sign; H and M must be
+;; numerically integers; M and S are expected to
+;; lie in the range [0,60).
+;;
+;; (date N) A date or date/time object. N is an integer to
+;; store a date only, or a fraction or float to
+;; store a date and time.
+;;
+;; (sdev X SIGMA) Error form, X +/- SIGMA. When normalized,
+;; SIGMA > 0. X is any complex number and SIGMA
+;; is real numbers; or these may be symbolic
+;; expressions where SIGMA is assumed real.
+;;
+;; (intv MASK LO HI) Interval form. MASK is 0=(), 1=(], 2=[), or 3=[].
+;; LO and HI are any real numbers, or symbolic
+;; expressions which are assumed real, and LO < HI.
+;; For [LO..HI], if LO = HI normalization produces LO,
+;; and if LO > HI normalization produces [LO..LO).
+;; For other intervals, if LO > HI normalization
+;; sets HI equal to LO.
+;;
+;; (mod N M) Number modulo M. When normalized, 0 <= N < M.
+;; N and M are real numbers.
+;;
+;; (var V S) Symbolic variable. V is a Lisp symbol which
+;; represents the variable's visible name. S is
+;; the symbol which actually stores the variable's
+;; value: (var pi var-pi).
+;;
+;; In general, combining rational numbers in a calculation always produces
+;; a rational result, but if either argument is a float, result is a float.
+
+;; In the following comments, [x y z] means result is x, args must be y, z,
+;; respectively, where the code letters are:
+;;
+;; O Normalized object (vector or number)
+;; V Normalized vector
+;; N Normalized number of any type
+;; N Normalized complex number
+;; R Normalized real number (float or rational)
+;; F Normalized floating-point number
+;; T Normalized rational number
+;; I Normalized integer
+;; B Normalized big integer
+;; S Normalized small integer
+;; D Digit (small integer, 0..999)
+;; L Normalized bignum digit list (without "bigpos" or "bigneg" symbol)
+;; or normalized vector element list (without "vec")
+;; P Predicate (truth value)
+;; X Any Lisp object
+;; Z "nil"
+;;
+;; Lower-case letters signify possibly un-normalized values.
+;; "L.D" means a cons of an L and a D.
+;; [N N; n n] means result will be normalized if argument is.
+;; Also, [Public] marks routines intended to be called from outside.
+;; [This notation has been neglected in many recent routines.]
(defvar math-eval-rules-cache)
(defvar math-eval-rules-cache-other)
-;;; True if A is a floating-point real or complex number. [P x] [Public]
+;; True if A is a floating-point real or complex number. [P x] [Public]
(defun math-floatp (a)
(cond ((eq (car-safe a) 'float) t)
((memq (car-safe a) '(cplx polar mod sdev intv))
-;;; Verify that A is a complete object and return A. [x x] [Public]
+;; Verify that A is a complete object and return A. [x x] [Public]
(defun math-check-complete (a)
(cond ((integerp a) a)
((eq (car-safe a) 'incomplete)
-;;; Coerce integer A to be a bignum. [B S]
+;; Coerce integer A to be a bignum. [B S]
(defun math-bignum (a)
(if (>= a 0)
(cons 'bigpos (math-bignum-big a))
(math-bignum-big (/ a math-bignum-digit-size)))))
-;;; Build a normalized floating-point number. [F I S]
+;; Build a normalized floating-point number. [F I S]
(defun math-make-float (mant exp)
(if (eq mant 0)
'(float 0 0)
;;; Format a number as a string.
+(defvar math-half-2-word-size)
(defun math-format-number (a &optional prec) ; [X N] [Public]
(cond
((eq calc-display-raw t) (format "%s" a))
+ ((and calc-twos-complement-mode
+ math-radix-explicit-format
+ (Math-integerp a)
+ (or (eq a 0)
+ (and (Math-integer-posp a)
+ (Math-lessp a math-half-2-word-size))
+ (and (Math-integer-negp a)
+ (require 'calc-ext)
+ (let ((comparison
+ (math-compare (Math-integer-neg a) math-half-2-word-size)))
+ (or (= comparison 0)
+ (= comparison -1))))))
+ (require 'calc-bin)
+ (math-format-twos-complement a))
((and (nth 1 calc-frac-format) (Math-integerp a))
(require 'calc-ext)
(math-format-number (math-adjust-fraction a)))
;;; Parse a simple number in string form. [N X] [Public]
-(defun math-read-number (s)
+(defun math-read-number (s &optional decimal)
"Convert the string S into a Calc number."
(math-normalize
- (cond
-
- ;; Integers (most common case)
- ((string-match "\\` *\\([0-9]+\\) *\\'" s)
- (let ((digs (math-match-substring s 1)))
- (if (and (eq calc-language 'c)
- (> (length digs) 1)
- (eq (aref digs 0) ?0))
- (math-read-number (concat "8#" digs))
- (if (<= (length digs) (* 2 math-bignum-digit-length))
- (string-to-number digs)
- (cons 'bigpos (math-read-bignum digs))))))
-
- ;; Clean up the string if necessary
- ((string-match "\\`\\(.*\\)[ \t\n]+\\([^\001]*\\)\\'" s)
- (math-read-number (concat (math-match-substring s 1)
- (math-match-substring s 2))))
-
- ;; Plus and minus signs
- ((string-match "^[-_+]\\(.*\\)$" s)
- (let ((val (math-read-number (math-match-substring s 1))))
- (and val (if (eq (aref s 0) ?+) val (math-neg val)))))
-
- ;; Forms that require extensions module
- ((string-match "[^-+0-9eE.]" s)
- (require 'calc-ext)
- (math-read-number-fancy s))
-
- ;; Decimal point
- ((string-match "^\\([0-9]*\\)\\.\\([0-9]*\\)$" s)
- (let ((int (math-match-substring s 1))
- (frac (math-match-substring s 2)))
- (let ((ilen (length int))
- (flen (length frac)))
- (let ((int (if (> ilen 0) (math-read-number int) 0))
- (frac (if (> flen 0) (math-read-number frac) 0)))
- (and int frac (or (> ilen 0) (> flen 0))
- (list 'float
- (math-add (math-scale-int int flen) frac)
- (- flen)))))))
-
- ;; "e" notation
- ((string-match "^\\(.*\\)[eE]\\([-+]?[0-9]+\\)$" s)
- (let ((mant (math-match-substring s 1))
- (exp (math-match-substring s 2)))
- (let ((mant (if (> (length mant) 0) (math-read-number mant) 1))
- (exp (if (<= (length exp) (if (memq (aref exp 0) '(?+ ?-)) 8 7))
- (string-to-number exp))))
- (and mant exp (Math-realp mant) (> exp -4000000) (< exp 4000000)
- (let ((mant (math-float mant)))
- (list 'float (nth 1 mant) (+ (nth 2 mant) exp)))))))
-
- ;; Syntax error!
- (t nil))))
+ (save-match-data
+ (cond
+
+ ;; Integers (most common case)
+ ((string-match "\\` *\\([0-9]+\\) *\\'" s)
+ (let ((digs (math-match-substring s 1)))
+ (if (and (memq calc-language calc-lang-c-type-hex)
+ (> (length digs) 1)
+ (eq (aref digs 0) ?0)
+ (null decimal))
+ (math-read-number (concat "8#" digs))
+ (if (<= (length digs) (* 2 math-bignum-digit-length))
+ (string-to-number digs)
+ (cons 'bigpos (math-read-bignum digs))))))
+
+ ;; Clean up the string if necessary
+ ((string-match "\\`\\(.*\\)[ \t\n]+\\([^\001]*\\)\\'" s)
+ (math-read-number (concat (math-match-substring s 1)
+ (math-match-substring s 2))))
+
+ ;; Plus and minus signs
+ ((string-match "^[-_+]\\(.*\\)$" s)
+ (let ((val (math-read-number (math-match-substring s 1))))
+ (and val (if (eq (aref s 0) ?+) val (math-neg val)))))
+
+ ;; Forms that require extensions module
+ ((string-match "[^-+0-9eE.]" s)
+ (require 'calc-ext)
+ (math-read-number-fancy s))
+
+ ;; Decimal point
+ ((string-match "^\\([0-9]*\\)\\.\\([0-9]*\\)$" s)
+ (let ((int (math-match-substring s 1))
+ (frac (math-match-substring s 2)))
+ (let ((ilen (length int))
+ (flen (length frac)))
+ (let ((int (if (> ilen 0) (math-read-number int t) 0))
+ (frac (if (> flen 0) (math-read-number frac t) 0)))
+ (and int frac (or (> ilen 0) (> flen 0))
+ (list 'float
+ (math-add (math-scale-int int flen) frac)
+ (- flen)))))))
+
+ ;; "e" notation
+ ((string-match "^\\(.*\\)[eE]\\([-+]?[0-9]+\\)$" s)
+ (let ((mant (math-match-substring s 1))
+ (exp (math-match-substring s 2)))
+ (let ((mant (if (> (length mant) 0) (math-read-number mant t) 1))
+ (exp (if (<= (length exp) (if (memq (aref exp 0) '(?+ ?-)) 8 7))
+ (string-to-number exp))))
+ (and mant exp (Math-realp mant) (> exp -4000000) (< exp 4000000)
+ (let ((mant (math-float mant)))
+ (list 'float (nth 1 mant) (+ (nth 2 mant) exp)))))))
+
+ ;; Syntax error!
+ (t nil)))))
;;; Parse a very simple number, keeping all digits.
(defun math-read-number-simple (s)
"Convert the string S into a Calc number.
S is assumed to be a simple number (integer or float without an exponent)
and all digits are kept, regardless of Calc's current precision."
- (cond
- ;; Integer
- ((string-match "^[0-9]+$" s)
- (if (string-match "^\\(0+\\)" s)
- (setq s (substring s (match-end 0))))
- (if (<= (length s) (* 2 math-bignum-digit-length))
- (string-to-number s)
- (cons 'bigpos (math-read-bignum s))))
- ;; Minus sign
- ((string-match "^-[0-9]+$" s)
- (if (<= (length s) (1+ (* 2 math-bignum-digit-length)))
- (string-to-number s)
- (cons 'bigneg (math-read-bignum (substring s 1)))))
- ;; Decimal point
- ((string-match "^\\(-?[0-9]*\\)\\.\\([0-9]*\\)$" s)
- (let ((int (math-match-substring s 1))
- (frac (math-match-substring s 2)))
- (list 'float (math-read-number-simple (concat int frac))
- (- (length frac)))))
- ;; Syntax error!
- (t nil)))
+ (save-match-data
+ (cond
+ ;; Integer
+ ((string-match "^[0-9]+$" s)
+ (if (string-match "^\\(0+\\)" s)
+ (setq s (substring s (match-end 0))))
+ (if (<= (length s) (* 2 math-bignum-digit-length))
+ (string-to-number s)
+ (cons 'bigpos (math-read-bignum s))))
+ ;; Minus sign
+ ((string-match "^-[0-9]+$" s)
+ (if (<= (length s) (1+ (* 2 math-bignum-digit-length)))
+ (string-to-number s)
+ (cons 'bigneg (math-read-bignum (substring s 1)))))
+ ;; Decimal point
+ ((string-match "^\\(-?[0-9]*\\)\\.\\([0-9]*\\)$" s)
+ (let ((int (math-match-substring s 1))
+ (frac (math-match-substring s 2)))
+ (list 'float (math-read-number-simple (concat int frac))
+ (- (length frac)))))
+ ;; Syntax error!
+ (t nil))))
(defun math-match-substring (s n)
(if (match-beginning n)
;;;###autoload
(defmacro defmath (func args &rest body) ; [Public]
+ "Define Calc function.
+
+Like `defun' except that code in the body of the definition can
+make use of the full range of Calc data types and the usual
+arithmetic operations are converted to their Calc equivalents.
+
+The prefix `calcFunc-' is added to the specified name to get the
+actual Lisp function name.
+
+See Info node `(calc)Defining Functions'."
+ (declare (doc-string 3))
(require 'calc-ext)
(math-do-defmath func args body))
(setq unread-command-event nil)
(setq unread-command-events nil)))
+(defcalcmodevar math-2-word-size
+ (math-read-number-simple "4294967296")
+ "Two to the power of `calc-word-size'.")
+
+(defcalcmodevar math-half-2-word-size
+ (math-read-number-simple "2147483648")
+ "One-half of two to the power of `calc-word-size'.")
+
(when calc-always-load-extensions
(require 'calc-ext)
(calc-load-everything))
(provide 'calc)
-;;; arch-tag: 0c3b170c-4ce6-4eaf-8d9b-5834d1fe938f
+;; Local variables:
+;; coding: utf-8
+;; End:
+
;;; calc.el ends here