-;; Calculator for GNU Emacs, part I
-;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc.
-;; Written by Dave Gillespie, daveg@synaptics.com.
+;;; calc.el --- the GNU Emacs calculator
+
+;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002 Free Software Foundation, Inc.
+
+;; Author: David Gillespie <daveg@synaptics.com>
+;; Maintainer: Colin Walters <walters@debian.org>
+;; Keywords: convenience, extensions
+;; Version: 2.02g
;; This file is part of GNU Emacs.
;; file named COPYING. Among other things, the copyright notice
;; and this notice must be preserved on all copies.
-
-
-;;; Calc is split into many files. This file is the main entry point.
-;;; This file includes autoload commands for various other basic Calc
-;;; facilities. The more advanced features are based in calc-ext, which
-;;; in turn contains autoloads for the rest of the Calc files. This
-;;; odd set of interactions is designed to make Calc's loading time
-;;; be as short as possible when only simple calculations are needed.
-
-;;; Suggested usage:
-;;;
-;;; (autoload 'calc-dispatch "calc" "Emacs Calculator" t nil)
-;;; (global-set-key "\e#" 'calc-dispatch)
-;;; Type `M-# M-#' to start.
-;;;
-;;; The Calc home directory must be added to the Emacs load-path:
-;;;
-;;; (setq load-path (cons "/x/y/z/calc" load-path))
-;;;
-;;; where "/x/y/z/calc" represents the full name of the Calc home directory.
-;;;
-;;; See the file INSTALL for a complete list of recommeded autoload
-;;; commands (though only calc-dispatch is absolutely necessary).
-
-
-;;; Author's address:
-;;; Dave Gillespie, daveg@synaptics.com, uunet!synaptx!daveg.
-;;; Synaptics, Inc., 2698 Orchard Parkway, San Jose, CA 95134.
-;;;
-;;; The old address daveg@csvax.cs.caltech.edu will continue to
-;;; work for the foreseeable future.
-;;;
-;;; The latest version of Calc is always available from anonymous FTP
-;;; on csvax.cs.caltech.edu [131.215.131.131]; look in ~ftp/pub/calc*.
-;;; It should also be available on prep.ai.mit.edu.
-;;;
-;;; Bug reports and suggestions are always welcome!
-
-
-;;; All functions, macros, and Lisp variables defined here begin with one
-;;; of the prefixes "math", "Math", or "calc", with the exceptions of
-;;; "full-calc", "full-calc-keypad", "another-calc", "quick-calc",
-;;; "report-calc-bug", and "defmath". User-accessible variables begin
-;;; with "var-".
-
-
+;;; Commentary:
+
+;; Calc is split into many files. This file is the main entry point.
+;; This file includes autoload commands for various other basic Calc
+;; facilities. The more advanced features are based in calc-ext, which
+;; in turn contains autoloads for the rest of the Calc files. This
+;; odd set of interactions is designed to make Calc's loading time
+;; be as short as possible when only simple calculations are needed.
+
+;; Original author's address:
+;; Dave Gillespie, daveg@synaptics.com, uunet!synaptx!daveg.
+;; Synaptics, Inc., 2698 Orchard Parkway, San Jose, CA 95134.
+;;
+;; The old address daveg@csvax.cs.caltech.edu will continue to
+;; work for the foreseeable future.
+;;
+;; Bug reports and suggestions are always welcome! (Type M-x
+;; report-calc-bug to send them).
+
+;; All functions, macros, and Lisp variables defined here begin with one
+;; of the prefixes "math", "Math", or "calc", with the exceptions of
+;; "full-calc", "full-calc-keypad", "another-calc", "quick-calc",
+;; "report-calc-bug", and "defmath". User-accessible variables begin
+;; with "var-".
+
+;;; TODO:
+
+;; Fix rewrite mechanism to do less gratuitous rearrangement of terms.
+;; Implement a pattern-based "refers" predicate.
+;;
+;; Make it possible to Undo a selection command.
+;; Figure out how to allow selecting rows of matrices.
+;; If cursor was in selection before, move it after j n, j p, j L, etc.
+;; Consider reimplementing calc-delete-selection using rewrites.
+;;
+;; Implement line-breaking in non-flat compositions (is this desirable?).
+;; Implement matrix formatting with multi-line components.
+;;
+;; Have "Z R" define a user command based on a set of rewrite rules.
+;; Support "incf" and "decf" in defmath definitions.
+;; Have defmath generate calls to calc-binary-op or calc-unary-op.
+;; Make some way to define algebraic functions using keyboard macros.
+;;
+;; Allow calc-word-size=0 => Common Lisp-style signed bitwise arithmetic.
+;; Consider digamma function (and thus arb. prec. Euler's gamma constant).
+;; May as well make continued-fractions stuff available to the user.
+;;
+;; How about matrix eigenvalues, SVD, pseudo-inverse, etc.?
+;; Should cache matrix inverses as well as decompositions.
+;; If dividing by a non-square matrix, use least-squares automatically.
+;; Consider supporting matrix exponentials.
+;;
+;; Have ninteg detect and work around singularities at the endpoints.
+;; Use an adaptive subdivision algorithm for ninteg.
+;; Provide nsum and nprod to go along with ninteg.
+;;
+;; Handle TeX-mode parsing of \matrix{ ... } where ... contains braces.
+;; Support AmS-TeX's \{d,t,}frac, \{d,t,}binom notations.
+;; Format and parse sums and products in Eqn and Math modes.
+;;
+;; Get math-read-big-expr to read sums, products, etc.
+;; Change calc-grab-region to use math-read-big-expr.
+;; Have a way to define functions using := in Embedded Mode.
+;;
+;; Support polar plotting with GNUPLOT.
+;; Make a calc-graph-histogram function.
+;;
+;; Replace hokey formulas for complex functions with formulas designed
+;; to minimize roundoff while maintaining the proper branch cuts.
+;; Test accuracy of advanced math functions over whole complex plane.
+;; Extend Bessel functions to provide arbitrary precision.
+;; Extend advanced math functions to handle error forms and intervals.
+;; Provide a better implementation for math-sin-cos-raw.
+;; Provide a better implementation for math-hypot.
+;; Provide a better implementation for math-make-frac.
+;; Provide a better implementation for calcFunc-prfac.
+;; Provide a better implementation for calcFunc-factor.
+;;
+;; Provide more examples in the tutorial section of the manual.
+;; Cover in the tutorial: simplification modes, declarations,
+;; bitwise stuff, selections, matrix mapping, financial functions.
+;; Provide more Lisp programming examples in the manual.
+;; Finish the Internals section of the manual (and bring it up to date).
+;;
+;; Tim suggests adding spreadsheet-like features.
+;; Implement language modes for Gnuplot, Lisp, Ada, APL, ...?
+;;
+;; For atan series, if x > tan(pi/12) (about 0.268) reduce using the identity
+;; atan(x) = atan((x * sqrt(3) - 1) / (sqrt(3) + x)) + pi/6.
+;;
+;; A better integration algorithm:
+;; Use breadth-first instead of depth-first search, as follows:
+;; The integral cache allows unfinished integrals in symbolic notation
+;; on the righthand side. An entry with no unfinished integrals on the
+;; RHS is "complete"; references to it elsewhere are replaced by the
+;; integrated value. More than one cache entry for the same integral
+;; may exist, though if one becomes complete, the others may be deleted.
+;; The integrator works by using every applicable rule (such as
+;; substitution, parts, linearity, etc.) to generate possible righthand
+;; sides, all of which are entered into the cache. Now, as long as the
+;; 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
+;; 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
+;; target integral. Note that when the integrator finishes, incomplete
+;; integrals can be left in the cache, so the algorithm can start where
+;; it left off if another similar integral is later requested.
+;; Breadth-first search would avoid the nagging problem of, e.g., whether
+;; to use parts or substitution first, and which decomposition is best.
+;; All are tried, and any path that diverges will quickly be put on the
+;; back burner by the priority queue.
+;; Note: Probably a good idea to call math-simplify-extended before
+;; measuring a formula's simplicity.
+
+;; From: "Robert J. Chassell" <bob@rattlesnake.com>
+;; Subject: Re: fix for `Cannot open load file: calc-alg-3'
+;; To: walters@debian.org
+;; Date: Sat, 24 Nov 2001 21:44:21 +0000 (UTC)
+;;
+;; Could you add logistic curve fitting to the current list?
+;;
+;; (I guess the key binding for a logistic curve would have to be `s'
+;; since a logistic curve is an `s' curve; both `l' and `L' are already
+;; taken for logarithms.)
+;;
+;; Here is the current list for curve fitting;
+;;
+;; `1'
+;; Linear or multilinear. a + b x + c y + d z.
+;;
+;; `2-9'
+;; Polynomials. a + b x + c x^2 + d x^3.
+;;
+;; `e'
+;; Exponential. a exp(b x) exp(c y).
+;;
+;; `E'
+;; Base-10 exponential. a 10^(b x) 10^(c y).
+;;
+;; `x'
+;; Exponential (alternate notation). exp(a + b x + c y).
+;;
+;; `X'
+;; Base-10 exponential (alternate). 10^(a + b x + c y).
+;;
+;; `l'
+;; Logarithmic. a + b ln(x) + c ln(y).
+;;
+;; `L'
+;; Base-10 logarithmic. a + b log10(x) + c log10(y).
+;;
+;; `^'
+;; General exponential. a b^x c^y.
+;;
+;; `p'
+;; Power law. a x^b y^c.
+;;
+;; `q'
+;; Quadratic. a + b (x-c)^2 + d (x-e)^2.
+;;
+;; `g'
+;; Gaussian. (a / b sqrt(2 pi)) exp(-0.5*((x-c)/b)^2).
+;;
+;;
+;; Logistic curves are used a great deal in ecology, and in predicting
+;; human actions, such as use of different kinds of energy in a country
+;; (wood, coal, oil, natural gas, etc.) or the number of scientific
+;; papers a person publishes, or the number of movies made.
+;;
+;; (The less information on which to base the curve, the higher the error
+;; rate. Theodore Modis ran some Monte Carlo simulations and produced
+;; what may be useful set of confidence levels for different amounts of
+;; initial information.)
+
+;;; Code:
(provide 'calc)
-
-
-(defun calc-record-compilation-date ()
- (calc-record-compilation-date-macro)
-)
-(calc-record-compilation-date)
-
+(require 'calc-macs)
;;; The "###autoload" comment will be used by Emacs version 19 for
;;; maintaining the loaddefs.el file automatically.
"*File name in which to look for the Calculator's Info documentation.")
;;;###autoload
-(defvar calc-settings-file "~/.emacs"
- "*File in which to record permanent settings; default is \"~/.emacs\".")
+(defvar calc-settings-file user-init-file
+ "*File in which to record permanent settings; default is `user-init-file'.")
;;;###autoload
(defvar calc-autoload-directory nil
(defvar calc-gnuplot-print-command "lp %s"
"*Name of command for printing GNUPLOT output; %s = file name to print.")
-
;; Address of the author of Calc, for use by report-calc-bug.
-(defvar calc-bug-address "daveg@synaptics.com")
+(defvar calc-bug-address "walters@debian.org")
-
-;; If T, scan keymaps to find all DEL-like keys.
-;; If NIL, only DEL itself is mapped to calc-pop.
+;; If t, scan keymaps to find all DEL-like keys.
+;; if nil, only DEL itself is mapped to calc-pop.
(defvar calc-scan-for-dels t)
-
-
(defvar calc-extensions-loaded nil)
-
-
-;;; IDEAS:
-;;;
-;;; Fix rewrite mechanism to do less gratuitous rearrangement of terms.
-;;; Implement a pattern-based "refers" predicate.
-;;;
-;;; Make it possible to Undo a selection command.
-;;; Figure out how to allow selecting rows of matrices.
-;;; If cursor was in selection before, move it after j n, j p, j L, etc.
-;;; Consider reimplementing calc-delete-selection using rewrites.
-;;;
-;;; Implement line-breaking in non-flat compositions (is this desirable?).
-;;; Implement matrix formatting with multi-line components.
-;;;
-;;; Have "Z R" define a user command based on a set of rewrite rules.
-;;; Support "incf" and "decf" in defmath definitions.
-;;; Have defmath generate calls to calc-binary-op or calc-unary-op.
-;;; Make some way to define algebraic functions using keyboard macros.
-;;;
-;;; Allow calc-word-size=0 => Common Lisp-style signed bitwise arithmetic.
-;;; Consider digamma function (and thus arb. prec. Euler's gamma constant).
-;;; May as well make continued-fractions stuff available to the user.
-;;;
-;;; How about matrix eigenvalues, SVD, pseudo-inverse, etc.?
-;;; Should cache matrix inverses as well as decompositions.
-;;; If dividing by a non-square matrix, use least-squares automatically.
-;;; Consider supporting matrix exponentials.
-;;;
-;;; Have ninteg detect and work around singularities at the endpoints.
-;;; Use an adaptive subdivision algorithm for ninteg.
-;;; Provide nsum and nprod to go along with ninteg.
-;;;
-;;; Handle TeX-mode parsing of \matrix{ ... } where ... contains braces.
-;;; Support AmS-TeX's \{d,t,}frac, \{d,t,}binom notations.
-;;; Format and parse sums and products in Eqn and Math modes.
-;;;
-;;; Get math-read-big-expr to read sums, products, etc.
-;;; Change calc-grab-region to use math-read-big-expr.
-;;; Have a way to define functions using := in Embedded Mode.
-;;;
-;;; Support polar plotting with GNUPLOT.
-;;; Make a calc-graph-histogram function.
-;;;
-;;; Replace hokey formulas for complex functions with formulas designed
-;;; to minimize roundoff while maintaining the proper branch cuts.
-;;; Test accuracy of advanced math functions over whole complex plane.
-;;; Extend Bessel functions to provide arbitrary precision.
-;;; Extend advanced math functions to handle error forms and intervals.
-;;; Provide a better implementation for math-sin-cos-raw.
-;;; Provide a better implementation for math-hypot.
-;;; Provide a better implementation for math-make-frac.
-;;; Provide a better implementation for calcFunc-prfac.
-;;; Provide a better implementation for calcFunc-factor.
-;;;
-;;; Provide more examples in the tutorial section of the manual.
-;;; Cover in the tutorial: simplification modes, declarations,
-;;; bitwise stuff, selections, matrix mapping, financial functions.
-;;; Provide more Lisp programming examples in the manual.
-;;; Finish the Internals section of the manual (and bring it up to date).
-;;;
-;;; Tim suggests adding spreadsheet-like features.
-;;; Implement language modes for Gnuplot, Lisp, Ada, APL, ...?
-;;;
-
-
-;;; For atan series, if x > tan(pi/12) (about 0.268) reduce using the identity
-;;; atan(x) = atan((x * sqrt(3) - 1) / (sqrt(3) + x)) + pi/6.
-
-
-;;; A better integration algorithm:
-;;; Use breadth-first instead of depth-first search, as follows:
-;;; The integral cache allows unfinished integrals in symbolic notation
-;;; on the righthand side. An entry with no unfinished integrals on the
-;;; RHS is "complete"; references to it elsewhere are replaced by the
-;;; integrated value. More than one cache entry for the same integral
-;;; may exist, though if one becomes complete, the others may be deleted.
-;;; The integrator works by using every applicable rule (such as
-;;; substitution, parts, linearity, etc.) to generate possible righthand
-;;; sides, all of which are entered into the cache. Now, as long as the
-;;; 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
-;;; 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
-;;; target integral. Note that when the integrator finishes, incomplete
-;;; integrals can be left in the cache, so the algorithm can start where
-;;; it left off if another similar integral is later requested.
-;;; Breadth-first search would avoid the nagging problem of, e.g., whether
-;;; to use parts or substitution first, and which decomposition is best.
-;;; All are tried, and any path that diverges will quickly be put on the
-;;; back burner by the priority queue.
-;;; Note: Probably a good idea to call math-simplify-extended before
-;;; measuring a formula's simplicity.
-
-
-
-
-
-
;; Calculator stack.
;; Entries are 3-lists: Formula, Height (in lines), Selection (or nil).
(defvar calc-stack '((top-of-stack 1 nil)))
;; This is 1 unless calc-truncate-stack has been used.
;;(defvar calc-stack-top 1)
-;; 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.
;;(defvar calc-always-load-extensions nil)
-;; If non-NIL, display line numbers in Calculator stack.
+;; If non-nil, display line numbers in Calculator stack.
;;(defvar calc-line-numbering t)
-;; If non-NIL, break long values across multiple lines in Calculator stack.
+;; If non-nil, break long values across multiple lines in Calculator stack.
;;(defvar calc-line-breaking t)
-;; If NIL, stack display is left-justified.
+;; If nil, stack display is left-justified.
;; If 'right, stack display is right-justified.
;; If 'center, stack display is centered."
;;(defvar calc-display-just nil)
;; Radix for entry and display of numbers in calc-mode, 2-36.
;;(defvar calc-number-radix 10)
-;; If non-NIL, leading zeros are provided to pad integers to calc-word-size.
+;; If non-nil, leading zeros are provided to pad integers to calc-word-size.
;;(defvar calc-leading-zeros nil)
-;; If non-NIL, group digits in large displayed integers by inserting spaces.
+;; If non-nil, group digits in large displayed integers by inserting spaces.
;; If an integer, group that many digits at a time.
;; If 't', use 4 for binary and hex, 3 otherwise.
;;(defvar calc-group-digits nil)
;; Format of displayed fractions; a string of one or two of ":" or "/".
;;(defvar calc-frac-format '(":" nil))
-;; If non-NIL, prefer fractional over floating-point results.
+;; If non-nil, prefer fractional over floating-point results.
;;(defvar calc-prefer-frac nil)
;; Format of displayed hours-minutes-seconds angles, a format string.
;; Preferred form, either 'cplx or 'polar, for complex numbers.
;;(defvar calc-complex-mode 'cplx)
-;; If NIL, 1 / 0 is left unsimplified.
+;; If nil, 1 / 0 is left unsimplified.
;; If 0, 1 / 0 is changed to inf (zeros are considered positive).
;; Otherwise, 1 / 0 is changed to uinf (undirected infinity).
;;(defvar calc-infinite-mode nil)
-;; If non-NIL, display vectors of byte-sized integers as strings.
+;; If non-nil, display vectors of byte-sized integers as strings.
;;(defvar calc-display-strings nil)
-;; If NIL, vector elements are left-justified.
+;; If nil, vector elements are left-justified.
;; If 'right, vector elements are right-justified.
;; If 'center, vector elements are centered."
;;(defvar calc-matrix-just 'center)
-;; If non-NIL, display vectors one element per line.
+;; If non-nil, display vectors one element per line.
;;(defvar calc-break-vectors nil)
-;; If non-NIL, display long vectors in full. If NIL, use abbreviated form.
+;; If non-nil, display long vectors in full. If nil, use abbreviated form.
;;(defvar calc-full-vectors t)
-;; If non-NIL, display long vectors in full in the trail.
+;; If non-nil, display long vectors in full in the trail.
;;(defvar calc-full-trail-vectors t)
-;; If non-NIL, separate elements of displayed vectors with this string.
+;; If non-nil, separate elements of displayed vectors with this string.
;;(defvar calc-vector-commas ",")
-;; If non-NIL, surround displayed vectors with these characters.
+;; If non-nil, surround displayed vectors with these characters.
;;(defvar calc-vector-brackets "[]")
;; A list of code-letter symbols that control "big" matrix display.
;; Type of simplification applied to results.
;; If 'none, results are not simplified when pushed on the stack.
;; If 'num, functions are simplified only when args are constant.
-;; If NIL, only fast simplifications are applied.
+;; If nil, only fast simplifications are applied.
;; If 'binary, math-clip is applied if appropriate.
;; If 'alg, math-simplify is applied.
;; If 'ext, math-simplify-extended is applied.
;; If 'units, math-simplify-units is applied.
;;(defvar calc-simplify-mode nil)
-;; If non-NIL, recompute evalto's automatically when necessary.
+;; If non-nil, recompute evalto's automatically when necessary.
;;(defvar calc-auto-recompute t)
-;; If non-NIL, display shows unformatted Lisp exprs. (For debugging)
+;; If non-nil, display shows unformatted Lisp exprs. (For debugging)
;;(defvar calc-display-raw nil)
;; Number of digits of internal precision for calc-mode calculations.
;;(defvar calc-internal-prec 12)
-;; If non-NIL, next operation is Inverse.
+;; If non-nil, next operation is Inverse.
;;(defvar calc-inverse-flag nil)
-;; If non-NIL, next operation is Hyperbolic.
+;; If non-nil, next operation is Hyperbolic.
;;(defvar calc-hyperbolic-flag nil)
-;; If non-NIL, next operation should not remove its arguments from stack.
+;; If non-nil, next operation should not remove its arguments from stack.
;;(defvar calc-keep-args-flag nil)
;; If deg, angles are in degrees; if rad, angles are in radians.
;; If hms, angles are in degrees-minutes-seconds.
;;(defvar calc-angle-mode 'deg)
-;; If non-NIL, numeric entry accepts whole algebraic expressions.
-;; If NIL, algebraic expressions must be preceded by "'".
+;; If non-nil, numeric entry accepts whole algebraic expressions.
+;; If nil, algebraic expressions must be preceded by "'".
;;(defvar calc-algebraic-mode nil)
;; Like calc-algebraic-mode except only affects ( and [ keys.
;;(defvar calc-incomplete-algebraic-mode nil)
-;; If non-NIL, inexact numeric computations like sqrt(2) are postponed.
-;; If NIL, computations on numbers always yield numbers where possible.
+;; If non-nil, inexact numeric computations like sqrt(2) are postponed.
+;; If nil, computations on numbers always yield numbers where possible.
;;(defvar calc-symbolic-mode nil)
;; If 'matrix, variables are assumed to be matrix-valued.
;; If a number, variables are assumed to be NxN matrices.
;; If 'scalar, variables are assumed to be scalar-valued.
-;; If NIL, symbolic math routines make no assumptions about variables.
+;; If nil, symbolic math routines make no assumptions about variables.
;;(defvar calc-matrix-mode nil)
-;; If non-NIL, shifted letter keys are prefix keys rather than normal meanings.
+;; If non-nil, shifted letter keys are prefix keys rather than normal meanings.
;;(defvar calc-shift-prefix nil)
;; Initial height of Calculator window.
;;(defvar calc-window-height 7)
-;; If non-NIL, M-x calc creates a window to display Calculator trail.
+;; If non-nil, M-x calc creates a window to display Calculator trail.
;;(defvar calc-display-trail t)
-;; If non-NIL, selected sub-formulas are shown by obscuring rest of formula.
-;; If NIL, selected sub-formulas are highlighted by obscuring the sub-formulas.
+;; If non-nil, selected sub-formulas are shown by obscuring rest of formula.
+;; If nil, selected sub-formulas are highlighted by obscuring the sub-formulas.
;;(defvar calc-show-selections t)
-;; If non-NIL, commands operate only on selected portions of formulas.
-;; If NIL, selections displayed but ignored.
+;; If non-nil, commands operate only on selected portions of formulas.
+;; If nil, selections displayed but ignored.
;;(defvar calc-use-selections t)
-;; If non-NIL, selection hides deep structure of associative formulas.
+;; If non-nil, selection hides deep structure of associative formulas.
;;(defvar calc-assoc-selections t)
-;; If non-NIL, display "Working..." for potentially slow Calculator commands.
+;; If non-nil, display "Working..." for potentially slow Calculator commands.
;;(defvar calc-display-working-message 'lots)
-;; If non-NIL, automatically execute a "why" command to explain odd results.
+;; If non-nil, automatically execute a "why" command to explain odd results.
;;(defvar calc-auto-why nil)
-;; If non-NIL, display timing information on each slow command.
+;; If non-nil, display timing information on each slow command.
;;(defvar calc-timing nil)
;; Floating-point numbers with this positive exponent or higher above the
;; List of strings for Y prefix help.
(defvar calc-Y-help-msgs nil)
-;; T if calc-settings-file has been loaded yet.
+;; t if calc-settings-file has been loaded yet.
(defvar calc-loaded-settings-file nil)
(put 'math-underflow 'error-conditions '(error math-underflow calc-error))
(put 'math-underflow 'error-message "Floating-point underflow occurred")
- (setq calc-version "2.02f"
- calc-version-date "Sun Dec 15 1996"
+ (setq calc-version "2.02g"
+ calc-version-date "Mon Nov 19 2001"
calc-trail-pointer nil ; "Current" entry in trail buffer.
calc-trail-overlay nil ; Value of overlay-arrow-string.
calc-was-split nil ; Had multiple windows before Calc.
(mapcar (function (lambda (v) (or (boundp v) (set v nil))))
calc-local-var-list)
- (if (boundp 'calc-mode-map)
- nil
+ (unless (boundp 'calc-mode-map)
(setq calc-mode-map (make-keymap))
(suppress-keymap calc-mode-map t)
(define-key calc-mode-map "+" 'calc-plus)
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)
-
-))
-
-)
+report-calc-bug))))
(calc-init-base)
;;;###autoload
(defun calc-dispatch (&optional arg)
- "Invoke the GNU Emacs Calculator. See calc-dispatch-help for details."
+ "Invoke the GNU Emacs Calculator. See `calc-dispatch-help' for details."
(interactive "P")
(sit-for echo-keystrokes)
(condition-case err ; look for other keys bound to calc-dispatch
(define-key calc-dispatch-map (substring keys 0 1) nil))
(define-key calc-dispatch-map keys 'calc-same-interface))))
(error nil))
- (calc-do-dispatch arg)
-)
+ (calc-do-dispatch arg))
+(defvar calc-dispatch-help nil)
(defun calc-do-dispatch (arg)
(let ((key (calc-read-key-sequence
(if calc-dispatch-help
(progn
(or (commandp key) (calc-extensions))
(call-interactively key))
- (beep)))
-)
-(setq calc-dispatch-help nil)
+ (beep))))
(defun calc-read-key-sequence (prompt map)
(let ((prompt2 (format "%s " (key-description (this-command-keys))))
(char-to-string (cdr key)))))
"" prompt2)))
(use-global-map glob)
- (use-local-map loc))))
-)
+ (use-local-map loc)))))
1 nil))))))
(setq calc-stack-top (- (length calc-stack) calc-stack-top -1))
(or calc-loaded-settings-file
+ (null calc-settings-file)
(string-match "\\.emacs" calc-settings-file)
(progn
(setq calc-loaded-settings-file t)
(eval (cons 'progn calc-defs))
(setq calc-defs nil)
(calc-set-mode-line)))
- (calc-check-defines)
-)
+ (calc-check-defines))
+(defvar calc-check-defines 'calc-check-defines) ; suitable for run-hooks
(defun calc-check-defines ()
(if (symbol-plist 'calc-define)
(let ((plist (copy-sequence (symbol-plist 'calc-define))))
(setq plist (cdr (cdr plist))))
;; See if this has added any more calc-define properties.
(calc-check-defines))
- (setplist 'calc-define nil))))
-)
-(setq calc-check-defines 'calc-check-defines) ; suitable for run-hooks
+ (setplist 'calc-define nil)))))
(defun calc-trail-mode (&optional buf)
"Calc Trail mode.
(setq calc-main-buffer buf)))
(if (= (buffer-size) 0)
(let ((buffer-read-only nil))
- (insert "Emacs Calculator v" calc-version " by Dave Gillespie, "
- "installed " calc-installed-date "\n")))
- (run-hooks 'calc-trail-mode-hook)
-)
+ (insert "Emacs Calculator v" calc-version " by Dave Gillespie\n")))
+ (run-hooks 'calc-trail-mode-hook))
(defun calc-create-buffer ()
(set-buffer (get-buffer-create "*Calculator*"))
(if calc-language
(progn
(calc-extensions)
- (calc-set-language calc-language calc-language-option t)))
-)
+ (calc-set-language calc-language calc-language-option t))))
;;;###autoload
(defun calc (&optional arg full-display interactive)
(save-excursion
(set-buffer (calc-trail-buffer))
(and calc-display-trail
- (= (window-width) (screen-width))
+ (= (window-width) (frame-width))
(calc-trail-display 1 t)))
- (message "Welcome to the GNU Emacs Calculator! Press `?' or `h' for help, `q' to quit.")
+ (message "Welcome to the GNU Emacs Calculator! Press `?' or `h' for help, `q' to quit")
(run-hooks 'calc-start-hook)
(and (windowp full-display)
(window-point full-display)
(progn
(sit-for 2)
(message "")))
- (setq calc-said-hello t))))
-)
+ (setq calc-said-hello t)))))
;;;###autoload
(defun full-calc ()
"Invoke the Calculator and give it a full-sized window."
(interactive)
- (calc nil t (interactive-p))
-)
+ (calc nil t (interactive-p)))
(defun calc-same-interface (arg)
"Invoke the Calculator using the most recent interface (calc or calc-keypad)."
(MacEdit-finish-edit)
(if calc-was-keypad-mode
(calc-keypad)
- (calc arg calc-full-mode t)))))
-)
+ (calc arg calc-full-mode t))))))
(defun calc-quit (&optional non-fatal)
calc-embedded-info
(eq (current-buffer) (aref calc-embedded-info 0)))
(calc-embedded nil)
- (or (eq major-mode 'calc-mode)
- (calc-create-buffer))
+ (unless (eq major-mode 'calc-mode)
+ (calc-create-buffer))
(run-hooks 'calc-end-hook)
(setq calc-undo-list nil calc-redo-list nil)
(mapcar (function (lambda (v) (set-default v (symbol-value v))))
(kbuf (get-buffer "*Calc Keypad*")))
(delete-windows-on (calc-trail-buffer))
(if (and win
- (< (window-height win) (1- (screen-height)))
- (= (window-width win) (screen-width)) ; avoid calc-keypad
+ (< (window-height win) (1- (frame-height)))
+ (= (window-width win) (frame-width)) ; avoid calc-keypad
(not (get-buffer-window "*Calc Keypad*")))
(setq calc-window-height (- (window-height win) 2)))
(if calc-was-split
(delete-windows-on kbuf))
(bury-buffer buf)
(bury-buffer calc-trail-buffer)
- (and kbuf (bury-buffer kbuf))))))
-)
+ (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)
-)
+ (calc-do-quick-calc))
;;;###autoload
(defun calc-eval (str &optional separator &rest args)
"Do a quick calculation and return the result as a string.
Return value will either be the formatted result in string form,
or a list containing a character position and an error message in string form."
- (calc-do-calc-eval str separator args)
-)
+ (calc-do-calc-eval str separator args))
;;;###autoload
(defun calc-keypad ()
Or, position the cursor manually and do M-x calc-keypad-press."
(interactive)
(calc-extensions)
- (calc-do-keypad calc-full-mode (interactive-p))
-)
+ (calc-do-keypad calc-full-mode (interactive-p)))
;;;###autoload
(defun full-calc-keypad ()
See calc-keypad for details."
(interactive)
(calc-extensions)
- (calc-do-keypad t (interactive-p))
-)
+ (calc-do-keypad t (interactive-p)))
+(defvar calc-aborted-prefix nil)
+(defvar calc-start-time nil)
;;; Note that modifications to this function may break calc-pass-errors.
(defun calc-do (do-body &optional do-slow)
(calc-check-defines)
(and (eq calc-algebraic-mode 'total)
(calc-extensions)
(use-local-map calc-alg-map))
- (and do-slow calc-display-working-message
- (progn
- (message "Working...")
- (calc-set-command-flag 'clear-message)))
+ (when (and do-slow calc-display-working-message)
+ (message "Working...")
+ (calc-set-command-flag 'clear-message))
(funcall do-body)
(setq calc-aborted-prefix nil)
- (and (memq 'renum-stack calc-command-flags)
- (calc-renumber-stack))
- (and (memq 'clear-message calc-command-flags)
- (message "")))
+ (when (memq 'renum-stack calc-command-flags)
+ (calc-renumber-stack))
+ (when (memq 'clear-message calc-command-flags)
+ (message "")))
(error
(if (and (eq (car err) 'error)
(stringp (nth 1 err))
(string-match "max-specpdl-size\\|max-lisp-eval-depth"
(nth 1 err)))
- (error "Computation got stuck or ran too long. Type `M' to increase the limit.")
+ (error "Computation got stuck or ran too long. Type `M' to increase the limit")
(setq calc-aborted-prefix nil)
(signal (car err) (cdr err)))))
(setq calc-old-aborted-prefix calc-aborted-prefix)
- (and calc-aborted-prefix
-
(calc-record "<Aborted>" calc-aborted-prefix))
+ (when calc-aborted-prefix
+ (calc-record "<Aborted>" calc-aborted-prefix))
(and calc-start-time
(let* ((calc-internal-prec 12)
(calc-date-format nil)
(calc-select-buffer)
(goto-line calc-final-point-line)
(move-to-column calc-final-point-column))))
- (or (memq 'keep-flags calc-command-flags)
- (save-excursion
- (calc-select-buffer)
- (setq calc-inverse-flag nil
- calc-hyperbolic-flag nil
- calc-keep-args-flag nil)))
- (and (memq 'do-edit calc-command-flags)
- (switch-to-buffer (get-buffer-create "*Calc Edit*")))
+ (unless (memq 'keep-flags calc-command-flags)
+ (save-excursion
+ (calc-select-buffer)
+ (setq calc-inverse-flag nil
+ calc-hyperbolic-flag nil
+ calc-keep-args-flag nil)))
+ (when (memq 'do-edit calc-command-flags)
+ (switch-to-buffer (get-buffer-create "*Calc Edit*")))
(calc-set-mode-line)
- (and calc-embedded-info
- (calc-embedded-finish-command))))
- (identity nil) ; allow a GC after timing is done
-)
-(setq calc-aborted-prefix nil)
-(setq calc-start-time nil)
+ (when calc-embedded-info
+ (calc-embedded-finish-command))))
+ (identity nil)) ; allow a GC after timing is done
+
(defun calc-set-command-flag (f)
- (if (not (memq f calc-command-flags))
- (setq calc-command-flags (cons f calc-command-flags)))
-)
+ (unless (memq f calc-command-flags)
+ (setq calc-command-flags (cons f calc-command-flags))))
(defun calc-select-buffer ()
(or (eq major-mode 'calc-mode)
(let ((buf (get-buffer "*Calculator*")))
(if buf
(set-buffer buf)
- (error "Calculator buffer not available")))))
-)
+ (error "Calculator buffer not available"))))))
(defun calc-cursor-stack-index (&optional index)
(goto-char (point-max))
- (forward-line (- (calc-substack-height (or index 1))))
-)
+ (forward-line (- (calc-substack-height (or index 1)))))
(defun calc-stack-size ()
- (- (length calc-stack) calc-stack-top)
-)
+ (- (length calc-stack) calc-stack-top))
(defun calc-substack-height (n)
(let ((sum 0)
(setq sum (+ sum (nth 1 (car stack)))
n (1- n)
stack (cdr stack)))
- sum)
-)
+ sum))
(defun calc-set-mode-line ()
(save-excursion
nil
(setq mode-line-buffer-identification new-mode-string)
(set-buffer-modified-p (buffer-modified-p))
- (and calc-embedded-info (calc-embedded-mode-line-change)))))
-)
+ (and calc-embedded-info (calc-embedded-mode-line-change))))))
(defun calc-align-stack-window ()
(if (eq major-mode 'calc-mode)
(goto-char (1- (match-end 0)))))
(save-excursion
(calc-select-buffer)
- (calc-align-stack-window)))
-)
+ (calc-align-stack-window))))
(defun calc-check-stack (n)
(if (> n (calc-stack-size))
(error "Too few elements on stack"))
(if (< n 0)
- (error "Invalid argument"))
-)
+ (error "Invalid argument")))
(defun calc-push-list (vals &optional m sels)
(while vals
(calc-record-undo (list 'push mm))
(calc-set-command-flag 'renum-stack))))
(setq vals (cdr vals)
- sels (cdr sels)))
-)
+ sels (cdr sels))))
(defun calc-pop-push-list (n vals &optional m sels)
(if (and calc-any-selections (null sels))
(calc-replace-selections n vals m)
(calc-pop-stack n m sels)
- (calc-push-list vals m sels))
-)
+ (calc-push-list vals m sels)))
(defun calc-pop-push-record-list (n prefix vals &optional m sels)
(or (and (consp vals)
(if (cdr vals)
(calc-record-list vals prefix)
(calc-record (car vals) prefix)))
- (calc-pop-push-list n vals m sels)
-)
+ (calc-pop-push-list n vals m sels))
(defun calc-enter-result (n prefix vals &optional m)
(setq calc-aborted-prefix prefix)
(if (equal vals '((nil)))
(setq vals nil))
(calc-pop-push-record-list n prefix vals m)
- (calc-handle-whys)
-)
+ (calc-handle-whys))
(defun calc-normalize (val)
(if (memq calc-simplify-mode '(nil none num))
(math-normalize val)
(calc-extensions)
- (calc-normalize-fancy val))
-)
+ (calc-normalize-fancy val)))
(defun calc-handle-whys ()
(if calc-next-why
- (calc-do-handle-whys))
-)
+ (calc-do-handle-whys)))
(defun calc-pop-stack (&optional n m sel-ok) ; pop N objs at level M of stack.
(calc-cursor-stack-index n)
(setq calc-stack (nthcdr n calc-stack))
(delete-region (point) (point-max))))
- (calc-set-command-flag 'renum-stack)))))
-)
+ (calc-set-command-flag 'renum-stack))))))
(defun calc-get-stack-element (x)
(cond ((eq sel-mode 'entry)
(car x))
(sel-mode
(calc-sel-error))
- (t (nth 2 x)))
-)
+ (t (nth 2 x))))
;; Get the Nth element of the stack (N=1 is the top element).
(defun calc-top (&optional n sel-mode)
(or n (setq n 1))
(calc-check-stack n)
- (calc-get-stack-element (nth (+ n calc-stack-top -1) calc-stack))
-)
+ (calc-get-stack-element (nth (+ n calc-stack-top -1) calc-stack)))
(defun calc-top-n (&optional n sel-mode) ; in case precision has changed
- (math-check-complete (calc-normalize (calc-top n sel-mode)))
-)
+ (math-check-complete (calc-normalize (calc-top n sel-mode))))
(defun calc-top-list (&optional n m sel-mode)
(or n (setq n 1))
(let ((top (copy-sequence (nthcdr (+ m calc-stack-top -1)
calc-stack))))
(setcdr (nthcdr (1- n) top) nil)
- (nreverse (mapcar 'calc-get-stack-element top))))
-)
+ (nreverse (mapcar 'calc-get-stack-element top)))))
(defun calc-top-list-n (&optional n m sel-mode)
(mapcar 'math-check-complete
- (mapcar 'calc-normalize (calc-top-list n m sel-mode)))
-)
+ (mapcar 'calc-normalize (calc-top-list n m sel-mode))))
(defun calc-renumber-stack ()
(beginning-of-line)
(setq lnum (1+ lnum)
stack (cdr stack))))))
- (and calc-embedded-info (calc-embedded-stack-change))
-)
+ (and calc-embedded-info (calc-embedded-stack-change)))
(defun calc-refresh (&optional align)
(interactive)
(save-excursion
(set-buffer (aref calc-embedded-info 1))
(calc-refresh align)))
- (setq calc-refresh-count (1+ calc-refresh-count))
-)
+ (setq calc-refresh-count (1+ calc-refresh-count)))
(defun calc-x-paste-text (arg)
(if (eq (car-safe val) 'error)
(error "%s in yanked data" (nth 2 val)))))
(calc-enter-result 0 "Xynk" val))))
- (x-paste-text arg))
-)
+ (x-paste-text arg)))
(save-excursion
(let ((win (get-buffer-window (current-buffer))))
(and win
- (pos-visible-in-window-p (1- (point-max)) win))))
-)
+ (pos-visible-in-window-p (1- (point-max)) win)))))
(defun calc-trail-buffer ()
(and (or (null calc-trail-buffer)
(set-buffer calc-trail-buffer)
(goto-line 2)
(setq calc-trail-pointer (point-marker))))
- calc-trail-buffer
-)
+ calc-trail-buffer)
(defun calc-record (val &optional prefix)
(setq calc-aborted-prefix nil)
(if (and aligned win (not (memq 'hold-trail calc-command-flags)))
(calc-trail-here))
(goto-char (1- (point-max))))))))
- val
-)
+ val)
(defun calc-trail-display (flag &optional no-refresh)
(if (interactive-p)
(calc-do-refresh)
(calc-refresh))))))))
- calc-trail-buffer
-)
+ calc-trail-buffer)
(defun calc-trail-here ()
(interactive)
(set-buffer calc-main-buffer)
(setq overlay-arrow-string calc-trail-overlay
overlay-arrow-position calc-trail-pointer))))))
- (error "Not in Calc Trail buffer"))
-)
+ (error "Not in Calc Trail buffer")))
(cdr calc-undo-list)))
(setq calc-undo-list (cons (list rec) calc-undo-list)
calc-redo-list nil)
- (calc-set-command-flag 'undo)))
-)
+ (calc-set-command-flag 'undo))))
(mapcar 'math-check-complete
(calc-top-list 2))))
(calc-extensions)
- (calc-binary-op-fancy name func arg ident unary))
-)
+ (calc-binary-op-fancy name func arg ident unary)))
(defun calc-unary-op (name func arg &optional func2)
(setq calc-aborted-prefix name)
(calc-enter-result 1 name (list (or func2 func)
(math-check-complete (calc-top 1))))
(calc-extensions)
- (calc-unary-op-fancy name func arg))
-)
+ (calc-unary-op-fancy name func arg)))
(defun calc-plus (arg)
(interactive "P")
(calc-slow-wrapper
- (calc-binary-op "+" 'calcFunc-add arg 0 nil '+))
-)
+ (calc-binary-op "+" 'calcFunc-add arg 0 nil '+)))
(defun calc-minus (arg)
(interactive "P")
(calc-slow-wrapper
- (calc-binary-op "-" 'calcFunc-sub arg 0 'neg '-))
-)
+ (calc-binary-op "-" 'calcFunc-sub arg 0 'neg '-)))
(defun calc-times (arg)
(interactive "P")
(calc-slow-wrapper
- (calc-binary-op "*" 'calcFunc-mul arg 1 nil '*))
-)
+ (calc-binary-op "*" 'calcFunc-mul arg 1 nil '*)))
(defun calc-divide (arg)
(interactive "P")
(calc-slow-wrapper
- (calc-binary-op "/" 'calcFunc-div arg 0 'calcFunc-inv '/))
-)
+ (calc-binary-op "/" 'calcFunc-div arg 0 'calcFunc-inv '/)))
(defun calc-change-sign (arg)
(interactive "P")
(calc-wrapper
- (calc-unary-op "chs" 'neg arg))
-)
+ (calc-unary-op "chs" 'neg arg)))
((= n 0)
(calc-push-list (calc-top-list (calc-stack-size))))
(t
- (calc-push-list (calc-top-list n)))))
-)
+ (calc-push-list (calc-top-list n))))))
(defun calc-pop (n)
(= nn 1)
(calc-top-selected 1 1))
(calc-delete-selection 1)
- (calc-pop-stack nn))))))
-)
+ (calc-pop-stack nn)))))))
(if (eq calc-prev-char 'dots)
(progn
(calc-extensions)
- (calc-dots))))))
-)
+ (calc-dots)))))))
+
+(defsubst calc-minibuffer-size ()
+ (- (point-max) (minibuffer-prompt-end)))
(defun calcDigit-nondigit ()
(interactive)
;; Exercise for the reader: Figure out why this is a good precaution!
(or (boundp 'calc-buffer)
(use-local-map minibuffer-local-map))
- (let ((str (buffer-string)))
+ (let ((str (minibuffer-contents)))
(setq calc-digit-value (save-excursion
(set-buffer calc-buffer)
(math-read-number str))))
- (if (and (null calc-digit-value) (> (buffer-size) 0))
+ (if (and (null calc-digit-value) (> (calc-minibuffer-size) 0))
(progn
(beep)
(calc-temp-minibuffer-message " [Bad format]"))
(>= last-input-char 128))
last-input-char
nil))))
- (exit-minibuffer))
-)
+ (exit-minibuffer)))
(defun calc-minibuffer-contains (rex)
(save-excursion
- (goto-char (point-min))
- (looking-at rex))
-)
+ (goto-char (minibuffer-prompt-end))
+ (looking-at rex)))
(defun calcDigit-key ()
(interactive)
(setq last-command-char (upcase last-command-char)))
(cond
((memq last-command-char '(?_ ?n))
- (goto-char (point-min))
+ (goto-char (minibuffer-prompt-end))
(if (and (search-forward " +/- " nil t)
(not (search-forward "e" nil t)))
(beep)
(upcase last-command-char))))
(and dig
(< dig radix)))))))
- (save-excursion
- (goto-char (point-min))
- (looking-at
- "[-+]?\\(.*\\+/- *\\|.*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]?\\'")))
+ (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))
(string-match " " calc-hms-format))
(insert " "))
(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-char))
(defun calcDigit-backspace ()
((eq last-command 'calcDigit-start)
(erase-buffer))
(t (backward-delete-char 1)))
- (if (= (buffer-size) 0)
+ (if (= (calc-minibuffer-size) 0)
(progn
(setq last-command-char 13)
- (calcDigit-nondigit)))
-)
+ (calcDigit-nondigit))))
(calc-record-why "*Variable is void" (nth 1 err)))))
(if (consp (car a))
(math-dimension-error)
- (cons (car a) args)))))))
-)
+ (cons (car a) args))))))))
(math-floatp (nth 2 a))
(and (eq (car a) 'intv) (math-floatp (nth 3 a)))))
((eq (car-safe a) 'date)
- (math-floatp (nth 1 a))))
-)
+ (math-floatp (nth 1 a)))))
((eq (car-safe a) 'incomplete)
(calc-incomplete-error a))
((consp a) a)
- (t (error "Invalid data object encountered")))
-)
+ (t (error "Invalid data object encountered"))))
(defun math-bignum (a)
(if (>= a 0)
(cons 'bigpos (math-bignum-big a))
- (cons 'bigneg (math-bignum-big (- a))))
-)
+ (cons 'bigneg (math-bignum-big (- a)))))
(defun math-bignum-big (a) ; [L s]
(if (= a 0)
nil
- (cons (% a 1000) (math-bignum-big (/ a 1000))))
-)
+ (cons (% a 1000) (math-bignum-big (/ a 1000)))))
;;; Build a normalized floating-point number. [F I S]
(if (and (>= exp 3000000)
(>= (+ exp (math-numdigs mant) -1) 4000000))
(signal 'math-overflow nil)
- (list 'float mant exp))))
-)
+ (list 'float mant exp)))))
(defun math-div10-bignum (a) ; [l l]
(if (cdr a)
(cons (+ (/ (car a) 10) (* (% (nth 1 a) 10) 100))
(math-div10-bignum (cdr a)))
- (list (/ (car a) 10)))
-)
+ (list (/ (car a) 10))))
;;; Coerce A to be a float. [F N; V V] [Public]
(defun math-float (a)
((eq (car a) 'float) a)
((memq (car a) '(cplx polar vec hms date sdev mod))
(cons (car a) (mapcar 'math-float (cdr a))))
- (t (math-float-fancy a)))
-)
+ (t (math-float-fancy a))))
(defun math-neg (a)
(list (car a) (Math-integer-neg (nth 1 a)) (nth 2 a)))
((memq (car a) '(cplx vec hms date calcFunc-idn))
(cons (car a) (mapcar 'math-neg (cdr a))))
- (t (math-neg-fancy a)))
-)
+ (t (math-neg-fancy a))))
;;; Compute the number of decimal digits in integer A. [S I]
((= a 0) 0)
((> a -10) 1)
((> a -100) 2)
- (t (math-numdigs (- a)))))
-)
+ (t (math-numdigs (- a))))))
;;; Multiply (with truncation toward 0) the integer A by 10^N. [I i S]
(defun math-scale-int (a n)
(cond ((= n 0) a)
((> n 0) (math-scale-left a n))
- (t (math-normalize (math-scale-right a (- n)))))
-)
+ (t (math-normalize (math-scale-right a (- n))))))
(defun math-scale-left (a n) ; [I I S]
(if (= n 0)
(* a 100))
(if (or (>= a 100000) (<= a -100000))
(math-scale-left (math-bignum a) 1)
- (* a 10))))))
-)
+ (* a 10)))))))
(defun math-scale-left-bignum (a n)
(if (>= n 3)
n (- n 3)) 3)))
(if (> n 0)
(math-mul-bignum-digit a (if (= n 2) 100 10) 0)
- a)
-)
+ a))
(defun math-scale-right (a n) ; [i i S]
(if (= n 0)
(/ a 100)
(if (= n 1)
(/ a 10)
- a)))))
-)
+ a))))))
(defun math-scale-right-bignum (a n) ; [L L S; l l S]
(if (>= n 3)
n (% n 3)))
(if (> n 0)
(cdr (math-mul-bignum-digit a (if (= n 2) 10 100) 0))
- a)
-)
+ a))
;;; Multiply (with rounding) the integer A by 10^N. [I i S]
(defun math-scale-rounding (a n)
(- (math-scale-rounding (- a) n))
(if (= n -1)
(/ (+ a 5) 10)
- (/ (+ (math-scale-right a (- -1 n)) 5) 10)))))
-)
+ (/ (+ (math-scale-right a (- -1 n)) 5) 10))))))
;;; Compute the sum of A and B. [O O O] [Public]
(and (calc-extensions)
(math-add-objects-fancy a b))))
(and (calc-extensions)
- (math-add-symb-fancy a b)))
-)
+ (math-add-symb-fancy a b))))
(defun math-add-bignum (a b) ; [L L L; l l l]
(if a
(nconc a b)
a)))
a)
- b)
-)
+ b))
(defun math-sub-bignum (a b) ; [l l l]
(if b
(setq b (cdr b)))
(and b
'neg))
- a)
-)
+ a))
(defun math-add-float (a b) ; [F F F]
(let ((ediff (- (nth 2 a) (nth 2 b))))
b
(math-make-float (math-add (nth 1 a)
(math-scale-left (nth 1 b) ediff))
- (nth 2 a)))))
-)
+ (nth 2 a))))))
;;; Compute the difference of A and B. [O O O] [Public]
(defun math-sub (a b)
(setq a (- a b))
(if (or (<= a -1000000) (>= a 1000000))
(math-bignum a)
- a))
-)
+ a)))
(defun math-sub-float (a b) ; [F F F]
(let ((ediff (- (nth 2 a) (nth 2 b))))
(math-make-float (math-add (nth 1 a)
(Math-integer-neg
(math-scale-left (nth 1 b) ediff)))
- (nth 2 a)))))
-)
+ (nth 2 a))))))
;;; Compute the product of A and B. [O O O] [Public]
(and (calc-extensions)
(math-mul-objects-fancy a b))))
(and (calc-extensions)
- (math-mul-symb-fancy a b)))
-)
+ (math-mul-symb-fancy a b))))
(defun math-infinitep (a &optional undir)
(while (and (consp a) (memq (car a) '(* / neg)))
(memq (nth 2 a) '(var-inf var-uinf var-nan))
(if (and undir (eq (nth 2 a) 'var-inf))
'(var uinf var-uinf)
- a))
-)
+ a)))
;;; Multiply digit lists A and B. [L L L; l l l]
(defun math-mul-bignum (a b)
(if (cdr ss)
(setcar (cdr ss) (+ (/ prod 1000) (car (cdr ss))))
(setcdr ss (list (/ prod 1000))))))
- sum))
-)
+ sum)))
;;; Multiply digit list A by digit D. [L L D D; l l D D]
(defun math-mul-bignum-digit (a d c)
(setcdr aa (list (/ prod 1000))))
a))
(and (> c 0)
- (list c)))
-)
+ (list c))))
;;; Compute the integer (quotient . remainder) of A and B, which may be
(math-normalize (cons (if (eq (car a) (car b)) 'bigpos 'bigneg)
(car res)))
(math-normalize (cons (car a) (cdr res))))))
- (cons (/ a b) (% a b)))
-)
+ (cons (/ a b) (% a b))))
(defun math-quotient (a b) ; [I I I] [Public]
(if (and (not (consp a)) (not (consp b)))
(math-mul-bignum-digit (cdr b) d 0)
alen blen)))
(math-normalize (cons (if (eq (car a) (car b)) 'bigpos 'bigneg)
- (car res))))))
-)
+ (car res)))))))
;;; Divide a bignum digit list by another. [l.l l L]
(cons (car res)
(car (math-div-bignum-digit (cdr res) d)))))
(let ((res (math-div-bignum-digit a (car b))))
- (cons (car res) (list (cdr res)))))
-)
+ (cons (car res) (list (cdr res))))))
;;; Divide a bignum digit list by a digit. [l.D l D]
(defun math-div-bignum-digit (a b)
(cons
(cons (/ num b) (car res))
(% num b)))
- '(nil . 0))
-)
+ '(nil . 0)))
(defun math-div-bignum-big (a b alen blen) ; [l.l l L]
(if (< alen blen)
(res2 (math-div-bignum-part num b blen)))
(cons
(cons (car res2) (car res))
- (cdr res2))))
-)
+ (cdr res2)))))
(defun math-div-bignum-part (a b blen) ; a < b*1000 [D.l l L]
(let* ((num (+ (* (or (nth blen a) 0) 1000) (or (nth (1- blen) a) 0)))
(den (nth (1- blen) b))
(guess (min (/ num den) 999)))
- (math-div-bignum-try a b (math-mul-bignum-digit b guess 0) guess))
-)
+ (math-div-bignum-try a b (math-mul-bignum-digit b guess 0) guess)))
(defun math-div-bignum-try (a b c guess) ; [D.l l l D]
(let ((rem (math-sub-bignum a c)))
(if (eq rem 'neg)
(math-div-bignum-try a b (math-sub-bignum c b) (1- guess))
- (cons guess rem)))
-)
+ (cons guess rem))))
;;; Compute the quotient of A and B. [O O N] [Public]
(and (calc-extensions)
(math-div-objects-fancy a b))))
(and (calc-extensions)
- (math-div-symb-fancy a b)))
-)
+ (math-div-symb-fancy a b))))
(defun math-div-float (a b) ; [F F F]
(let ((ldiff (max (- (1+ calc-internal-prec)
(- (math-numdigs (nth 1 a)) (math-numdigs (nth 1 b))))
0)))
(math-make-float (math-quotient (math-scale-int (nth 1 a) ldiff) (nth 1 b))
- (- (- (nth 2 a) (nth 2 b)) ldiff)))
-)
+ (- (- (nth 2 a) (nth 2 b)) ldiff))))
(aset s 0 ?1)
(aset s 1 ?:))))
(setcar (cdr entry) (calc-count-lines s))
- s)
-)
+ s))
(defun math-stack-value-offset (c)
(let* ((num (if calc-line-numbering 4 0))
(if (integerp calc-line-breaking)
(setq wid calc-line-breaking)))
(cons (max (- off (length calc-left-label)) 0)
- (+ wid num)))
-)
+ (+ wid num))))
(defun calc-count-lines (s)
(let ((pos 0)
(while (setq newpos (string-match "\n" s pos))
(setq pos (1+ newpos)
num (1+ num)))
- num)
-)
+ num))
(defun math-format-value (a &optional w)
(if (and (Math-scalarp a)
(math-format-number a)
(calc-extensions)
(let ((calc-line-breaking nil))
- (math-composition-to-string (math-compose-expr a 0) w)))
-)
+ (math-composition-to-string (math-compose-expr a 0) w))))
(defun calc-window-width ()
(if calc-embedded-info
(let ((win (get-buffer-window (aref calc-embedded-info 0))))
- (1- (if win (window-width win) (screen-width))))
+ (1- (if win (window-width win) (frame-width))))
(- (window-width (get-buffer-window (current-buffer)))
- (if calc-line-numbering 5 1)))
-)
+ (if calc-line-numbering 5 1))))
(defun math-comp-concat (c1 c2)
(if (and (stringp c1) (stringp c2))
(concat c1 c2)
- (list 'horiz c1 c2))
-)
+ (list 'horiz c1 c2)))
(math-format-number a)))
(t
(calc-extensions)
- (math-format-flat-expr-fancy a prec)))
-)
+ (math-format-flat-expr-fancy a prec))))
str)))
(t
(calc-extensions)
- (math-format-number-fancy a prec)))
-)
+ (math-format-number-fancy a prec))))
(defun math-format-bignum (a) ; [X L]
(if (and (= calc-number-radix 10)
(not calc-group-digits))
(math-format-bignum-decimal a)
(calc-extensions)
- (math-format-bignum-fancy a))
-)
+ (math-format-bignum-fancy a)))
(defun math-format-bignum-decimal (a) ; [X L]
(if a
(setq s (concat (format "%06d" (+ (* (nth 1 a) 1000) (car a))) s)
a (cdr (cdr a))))
(concat (int-to-string (+ (* (or (nth 1 a) 0) 1000) (car a))) s))
- "0")
-)
+ "0"))
(list 'float (nth 1 mant) (+ (nth 2 mant) exp)))))))
;; Syntax error!
- (t nil)))
-)
+ (t nil))))
(defun math-match-substring (s n)
(if (match-beginning n)
(substring s (match-beginning n) (match-end n))
- "")
-)
+ ""))
(defun math-read-bignum (s) ; [l X]
(if (> (length s) 3)
(cons (string-to-int (substring s -3))
(math-read-bignum (substring s 0 -3)))
- (list (string-to-int s)))
-)
+ (list (string-to-int s))))
(defconst math-tex-ignore-words
( ":=" calcFunc-assign 51 50 )
( "::" calcFunc-condition 45 46 )
( "=>" calcFunc-evalto 40 41 )
- ( "=>" calcFunc-evalto 40 -1 )
-))
-(setq math-expr-opers math-standard-opers)
-
+ ( "=>" calcFunc-evalto 40 -1 )))
+(defvar math-expr-opers math-standard-opers)
;;;###autoload
(defun calc-grab-region (top bot arg)
"Parse the region as a vector of numbers and push it on the Calculator stack."
(interactive "r\nP")
(calc-extensions)
- (calc-do-grab-region top bot arg)
-)
+ (calc-do-grab-region top bot arg))
;;;###autoload
(defun calc-grab-rectangle (top bot arg)
"Parse a rectangle as a matrix of numbers and push it on the Calculator stack."
(interactive "r\nP")
(calc-extensions)
- (calc-do-grab-rectangle top bot arg)
-)
+ (calc-do-grab-rectangle top bot arg))
(defun calc-grab-sum-down (top bot arg)
"Parse a rectangle as a matrix of numbers and sum its columns."
(interactive "r\nP")
(calc-extensions)
- (calc-do-grab-rectangle top bot arg 'calcFunc-reduced)
-)
+ (calc-do-grab-rectangle top bot arg 'calcFunc-reduced))
(defun calc-grab-sum-across (top bot arg)
"Parse a rectangle as a matrix of numbers and sum its rows."
(interactive "r\nP")
(calc-extensions)
- (calc-do-grab-rectangle top bot arg 'calcFunc-reducea)
-)
+ (calc-do-grab-rectangle top bot arg 'calcFunc-reducea))
;;;###autoload
"Start Calc Embedded mode on the formula surrounding point."
(interactive "P")
(calc-extensions)
- (calc-do-embedded arg end obeg oend)
-)
+ (calc-do-embedded arg end obeg oend))
;;;###autoload
(defun calc-embedded-activate (&optional arg cbuf)
"Scan the current editing buffer for all embedded := and => formulas.
Also looks for the equivalent TeX words, \\gets and \\evalto."
(interactive "P")
- (calc-do-embedded-activate arg cbuf)
-)
+ (calc-do-embedded-activate arg cbuf))
(defun calc-user-invocation ()
(interactive)
(or (stringp calc-invocation-macro)
(error "Use `Z I' inside Calc to define a `M-# Z' keyboard macro"))
- (execute-kbd-macro calc-invocation-macro nil)
-)
+ (execute-kbd-macro calc-invocation-macro nil))
;;;###autoload
(defmacro defmath (func args &rest body) ; [Public]
(calc-extensions)
- (math-do-defmath func args body)
-)
+ (math-do-defmath func args body))
;;; Functions needed for Lucid Emacs support.
(cons key key)))
(t
(let ((key (read-char)))
- (cons key key))))
-)
+ (cons key key)))))
(defun calc-unread-command (&optional input)
- (cond (calc-emacs-type-gnu19
- (setq unread-command-events (cons (or input last-command-event)
- unread-command-events)))
- (calc-emacs-type-lucid
- (setq unread-command-event
- (if (integerp input) (character-to-event input)
- (or input last-command-event))))
- (t
- (setq unread-command-char (or input last-command-char))))
-)
+ (if (featurep 'xemacs)
+ (setq unread-command-event
+ (if (integerp input) (character-to-event input)
+ (or input last-command-event)))
+ (push (or input last-command-event) unread-command-events)))
(defun calc-clear-unread-commands ()
- (cond (calc-emacs-type-gnu19 (setq unread-command-events nil))
+ (if (featurep 'xemacs)
(calc-emacs-type-lucid (setq unread-command-event nil))
- (t (setq unread-command-char -1)))
-)
+ (setq unread-command-events nil)))
(if calc-always-load-extensions
(progn
(calc-extensions)
- (calc-load-everything))
-)
+ (calc-load-everything)))
(run-hooks 'calc-load-hook)
-
+;;; calc.el ends here