Usenet 1994 January

home *** CD-ROM | disk | FTP | other *** search

/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / misc / volume13 / gmcalc / part01 next >

Wrap

Text File | 1990-06-05 | 57.2 KB | 1,645 lines

Newsgroups: comp.sources.misc From: daveg@csvax.caltech.edu (David Gillespie) Subject: v13i027: Emacs Calculator 1.01, part 01/19 Sender: allbery@uunet.UU.NET (Brandon S. Allbery - comp.sources.misc) Posting-number: Volume 13, Issue 27 Submitted-by: daveg@csvax.caltech.edu (David Gillespie) Archive-name: gmcalc/part01 ---- Cut Here and unpack ---- #!/bin/sh # shar: Shell Archiver (v1.22) # # This is part 1 of a multipart archive # do not concatenate these parts, unpack them in order with /bin/sh # # Run the following text with /bin/sh to create: # README # INSTALL # calc.el # calc-ext.el # calc.texinfo # if test -r s2_seq_.tmp then echo "Must unpack archives in sequence!" next=`cat s2_seq_.tmp`; echo "Please unpack part $next next" exit 1; fi echo "x - extracting README (Text)" sed 's/^X//' << 'SHAR_EOF' > README && X XThis tar file contains version 1.01 of Calc, an advanced desk Xcalculator for GNU Emacs. X X"Calc" Copyright 1990 Dave Gillespie X 256-80 Caltech X Pasadena CA 91125 X daveg@csvax.caltech.edu, cit-vax!daveg X X X XFrom the Introduction to the manual: X X "Calc" is an advanced calculator and mathematical tool that runs as X part of the GNU Emacs environment. Very roughly based on the HP-28/48 X series of calculators, its many features include: X X * Choice of algebraic or RPN style entry of calculations. X X * Arbitrary precision integers and floating-point numbers. X X * Arithmetic on rational numbers, complex numbers (rectangular and polar), X error forms with standard deviations, open and closed intervals, vectors X and matrices, quantities with units, and simple algebraic expressions. X X * Mathematical operations such as logarithms and trig functions. X X * Programmer's features (bitwise operations, non-decimal integers). X X * Number theoretical features such as prime factorization and arithmetic X modulo M for any M. X X * Algebraic manipulation features, including symbolic calculus. X X * Kill and yank to and from regular editing buffers. X X * Easy programming using keyboard macros, algebraic formulas, X algebraic rewrite rules, or Lisp code. X X X XTo install Calc: X X 1. Create a directory for Calc X 2. "cd" to that directory X 3. Place calc-1.01.tar.Z in the directory (be sure to ftp it in binary mode) X 4. Type "uncompress calc-1.01.tar.Z" X 5. Type "tar xvf calc-1.01.tar" X4,5. Alternatively: "zcat calc1.01.tar.Z | tar xvf -" X 6. Follow the instructions in the file "INSTALL". X X X XThe files contained in this tar file are: X X README This very file. X X INSTALL Installation instructions (excerpted from the manual). X X calc.el The main source file. This contains just the basic X arithmetic functions, and is kept small for fast X loading. 124K. X X calc-ext.el The rest of the Calculator source. This file is X auto-loaded the first time you use an advanced Calc X command. 460K. X X calc.elc The byte-compiled version of Calc. You can make X calc-ext.elc these yourself from calc.el and calc-ext.el if you X prefer; use the M-x byte-compile-file command. X (Not available in shar distribution; 82K + 358K.) X X calc.texinfo Documentation for Calc. This can be turned into X a printed manual and also into on-line help. 465K. X Beware: printed, this is over 200 pages! X X macedit.el A handy utility for editing keyboard macros; good X for using Calc as a programmable calculator. 19K. X X XCalc is written entirely in Emacs Lisp, for maximum portability. XYou do not need to recompile Emacs to install and use Calc. X XYou will need about two megabytes of disk space to hold Calc with Xits Info documentation. X XSee the file INSTALL for installation instructions. If you're impatient, Xuse `M-x load-file' to load `calc.elc' and `calc-ext.elc', then type X`M-x calc' to run the Calculator. Type `?' for help; read `calc.texinfo' Xfor the complete documentation. X XDon't even try to run Calc in uncompiled (.el) form! It's far too slow. X X XI am anxious to hear about your experiences using Calc. Send mail to X"daveg@csvax.caltech.edu", or "cit-vax!daveg". A bug report is most Xuseful if you include the exact input and output that occurred, any Xmodes in effect (such as the current precision), and so on. If you Xfind Calc is difficult to operate in any way, or if you have other Xsuggestions, don't hesitate to let me know. If you find errors X(including simple typos) in the manual, let me know. Even if you find Xno bugs at all I would love to hear your opinions. X XThe latest Calc tar files and patches are available for anonymous FTP Xon csvax.caltech.edu. Look in the "pub" subdirectory. X XThanks, X X -- Dave X X X X X XSummary of changes to "Calc" X------- -- ------- -- ---- X X XVersion 1.01: X X * Added a tutorial section to the manual. X X * Next and Prev for node Strings in the manual were reversed; fixed. X X * Changed "'bignum" in calc-isqrt-bignum-iter to "'bigpos". X X * Fixed a bug that prevented "$" from working during algebraic entry. X X * Fixed a bug caused by an X (last-X) command following a K (macro) command. X X * Fixed a bug in which K command incorrectly formatted stack in Big mode. X X * Added space between unary operators and non-flat compositions. X (Otherwise, "-(a/b)" in Big mode blended the minus sign into the rule!) X X * Fixed formatting of (-1)^n in Big mode. X X * Fixed some problems relating to "not" operator in Pascal language mode. X X * Fixed several bugs relating to V M ' and V M $ sequences. X X * Fixed matrix-vector multiplication to produce a vector. X X * Introduced Z ` ... Z ' commands; renamed old Z ' to Z #. X X * Fixed various other bugs. X X * Added calc-settings-file variable suggested by C. Witty. X XVersion 1.00: X X * First official release of Calc. X X * If you used the Beta test version (0.01), you will find that this X version of Calc is over 50% larger than the original release. X General areas of improvement include much better algebra features; X operations on units; language modes; simplification modes; interval X arithmetic; vector mapping and reduction. Other new commands include X calc-fraction and calc-grab-region. The program has been split into X two parts for faster loading, and the manual is more complete. X SHAR_EOF chmod 0664 README || echo "restore of README fails" set `wc -c README`;Sum=$1 if test "$Sum" != "5418" then echo original size 5418, current size $Sum;fi echo "x - extracting INSTALL (Text)" sed 's/^X//' << 'SHAR_EOF' > INSTALL && X XInstallation X************ X XCalc comes as a pair of Emacs Lisp files, generally called `calc.el' and X`calc-ext.el'. The first contains the basic foundations of the XCalculator, and is as small as possible to promote quick loading. The Xsecond contains all the more advanced commands and functions. Calc is Xusually installed so that the `M-x calc' or `M-#' command auto-loads Xonly the first part, and the second part is auto-loaded whenever the Xfirst advanced feature is used. X XCalc is written in a way that maximizes performance when its code has been Xbyte-compiled; a side effect is that performance is seriously degraded if Xit *isn't* compiled. Thus, it is essential to compile the Calculator Xbefore trying to use it. The Emacs command `M-x byte-compile-file' Xis used to compile an Emacs Lisp file. Compile each of `calc.el' and X`calc-ext.el' to obtain byte-code files `calc.elc' and X`calc-ext.elc'. You may find you need to do `M-x load-file Xcalc.elc' before compiling `calc-ext.el' will work. X XFor your convenience, the FTP distribution of Calc, obtainable from Xanonymous FTP on `csvax.caltech.edu', includes already-compiled Xversions of both of these files. X XTo teach Emacs how to load in Calc when you type `M-x calc' for the Xfirst time, include these lines in your `.emacs' file (if you are Xinstalling Calc just for your own use), or the system's `lisp/default' Xfile (if you are installing Calc publicly). X X (autoload 'calc ".../calc.elc" "Calculator Mode" t nil) X (autoload 'calc-extensions ".../calc-ext.elc" nil nil nil) X (autoload 'quick-calc ".../calc.elc" "Quick Calculator" t nil) X (autoload 'calc-grab-region ".../calc-ext.elc" nil t nil) X (autoload 'defmath ".../calc-ext.elc" nil t t) X Xwhere `.../calc.elc' represents the full path to the `calc.elc' Xfile, and similarly for `.../calc-ext.elc'. If you have installed Xthese files in Emacs' main `lisp/' directory, you can just write X`"calc.elc"' and `"calc-ext.elc"'. X XThe `autoload' command for `calc' is what loads `calc.elc' Xwhen you type `M-x calc'. The `autoload' for `calc-extensions' Xbrings in the extensions module; Calc takes care to call the X`calc-extensions' function (which doesn't actually do anything) Xbefore any operation that requires the extensions to be present. XThe other three `autoload' commands are for functions which might Xreasonably be used before the user has typed `M-x calc' for the Xfirst time. X XIf you don't want to bother with a split Calculator, you can simply Xconcatenate `calc-ext.elc' onto the end of `calc.elc', rewrite Xthe above `autoload' commands all to point to the combined file, Xand treat Calc as one big program. You may need to do this if X`autoload' is giving you problems. X XYou may also wish to bind the `calc' command to a key. The Xrecommended keystroke is `M-#' (i.e., Meta-Shift-3). To set up Xthis key binding, include this command in your `.emacs' or X`lisp/default' file: X X (global-set-key "\e#" 'calc) X XThere are no standard key assignments for `quick-calc' and X`calc-grab-region', but you may wish to define some. X XThe file `macedit.el' contains another useful Emacs extension Xcalled `edit-kbd-macro'. It allows you to edit a keyboard macro Xin human-readable form. The `Z E' command in Calc knows how to Xuse it to edit user commands that have been defined by keyboard macros. XTo autoload it, you will want to include the commands, X X (autoload 'edit-kbd-macro ".../macedit.elc" "Edit Keyboard Macro" t nil) X (autoload 'edit-last-kbd-macro ".../macedit.elc" "Edit Keyboard Macro" t nil) X XThe documentation for Calc (i.e., this manual) comes in a file X`calc.texinfo'. To format this for use as an on-line manual, Xopen this file for editing in Emacs and give the command X`M-x texinfo-format-buffer'. When this finishes, type `C-x C-s' Xto save. The result will be a collection of files whose names begin Xwith `calc-info'. You can also format this into a printable Xdocument using TeX, but beware, the manual is about 170 printed pages! X XThere is a Lisp variable called `calc-info-filename' which holds Xthe name of the Info file containing Calc's on-line documentation. XIts default value is `calc-info', which will work correctly if Xthe Info files are stored in Emacs' main `info/' directory. If Xyou keep them elsewhere, you will want to put a command of the form, X X (setq calc-info-filename ".../calc-info") X Xin your `.emacs' or `lisp/default' file, where again `...' Xrepresents the directory containing the Info files. X XAnother variable you might want to set is `calc-settings-file', which Xholds the file name in which commands like `m m' and `Z P' store X"permanent" definitions. The default value for this variable is X`"~/.emacs"'. If `calc-settings-file' does not contain `".emacs"' as a Xsubstring, and if the variable `calc-loaded-settings-file' is `nil', Xthen Calc will automatically load your settings file (if it exists) the Xfirst time Calc is invoked. X XTo test your installation of Calc, start a fresh Emacs and type `M-#' Xto make sure the autoload commands and key bindings work. Now, type X`i' to make sure Calc can find its Info documentation. Press `q' Xto exit the Info system. Type `20 S' to compute the sine of X20 degrees; this will test the autoloading of the extensions module. XThe result should be 0.342020143326. Finally, press `M-#' again to Xmake sure the Calculator can exit. X X(The above text is included in both the Calc documentation and the Xfile INSTALL in the Calc distribution directory.) SHAR_EOF chmod 0644 INSTALL || echo "restore of INSTALL fails" set `wc -c INSTALL`;Sum=$1 if test "$Sum" != "5522" then echo original size 5522, current size $Sum;fi echo "x - extracting calc.el (Text)" sed 's/^X//' << 'SHAR_EOF' > calc.el && X;; Calculator for GNU Emacs X;; Copyright (C) 1990 Dave Gillespie X X;; This file is part of GNU Emacs. X X;; GNU Emacs is distributed in the hope that it will be useful, X;; but WITHOUT ANY WARRANTY. No author or distributor X;; accepts responsibility to anyone for the consequences of using it X;; or for whether it serves any particular purpose or works at all, X;; unless he says so in writing. Refer to the GNU Emacs General Public X;; License for full details. X X;; Everyone is granted permission to copy, modify and redistribute X;; GNU Emacs, but only under the conditions described in the X;; GNU Emacs General Public License. A copy of this license is X;; supposed to have been given to you along with GNU Emacs so you X;; can know your rights and responsibilities. It should be in a X;; file named COPYING. Among other things, the copyright notice X;; and this notice must be preserved on all copies. X X X;;; This is part I of the Emacs Calculator. It defines simple arithmetic X;;; commands only. Assuming the autoload commands shown below have been X;;; done, the Calculator will autoload the remaining commands from calc-ext.elc X;;; whenever one is first needed. If you wish, you can concatenate calc-ext X;;; onto the end of calc (.el or .elc) to make one big file. X X;;; Suggested usage: X;;; X;;; (autoload 'calc ".../calc.elc" "Calculator Mode" t nil) X;;; (autoload 'quick-calc ".../calc.elc" "Quick Calculator" t nil) X;;; (autoload 'calc-grab-region ".../calc-ext.elc" nil t nil) X;;; (autoload 'defmath ".../calc-ext.elc" nil t t) X;;; (autoload 'calc-extensions ".../calc-ext.elc" nil nil nil) X;;; (global-set-key "\e#" 'calc) X;;; M-x calc X;;; X;;; where ".../calc.elc" represents the full path for "calc.elc", X;;; and ".../calc-ext.elc" is the path of the companion file containing X;;; all of the more advanced Calc commands. X X X;;; Author's address: X;;; Dave Gillespie, 256-80 Caltech, Pasadena CA 91125. X;;; daveg@csvax.caltech.edu, ...!cit-vax!daveg. X;;; X;;; This file and the manual, calc.texinfo, are available from anonymous FTP X;;; on csvax.caltech.edu [192.12.18.1]; look in ~ftp/pub/calc. X;;; X;;; Bug reports and suggestions are always welcome! X X X;;; All functions, macros, and Lisp variables defined here begin with one X;;; of the prefixes "math", "Math", or "calc", with the exception of X;;; "another-calc". User-accessible variables begin with "var-". X X X X(provide 'calc) X X(defmacro calc-record-compilation-date-macro () X (` (setq calc-version (concat "Emacs Calc Mode" X " v1.01 by Dave Gillespie" X ", installed " X (, (current-time-string)) X " by " X (, (user-full-name))))) X) X(defun calc-record-compilation-date () X (calc-record-compilation-date-macro) X) X(calc-record-compilation-date) X X X(defvar calc-info-filename "calc-info" X "*File name in which to look for the Calculator's Info documentation.") X X X(defvar calc-extensions-loaded nil) X X X X;;; IDEAS: X;;; X;;; Consider breaking calc-ext.el into several extension modules: X;;; Base extensions, algebra/units, scientific, programming X;;; X;;; How about putting cursor on an operator or functor in stack window X;;; to indicate the subterm to which a command should apply? X;;; Make math-simplify faster! X;;; Provide analogues of Mathematica's polynomial-munching ops: X;;; Together, Apart, Cancel, Factor, GCD, quotient/remainder. X;;; Automatically generate derivatives for functions defined with Z F. X;;; Handle commutativity and associativity among +, -, *, / in rewrite rules. X;;; X;;; In no-simplify mode, have a key which executes the top-level call X;;; once, but does not execute any of the arguments' calls. X;;; Put a set of evaluations in the c-prefix menu, analogous to m-prefix. X;;; X;;; During algebraic entry, hit ` to switch to calc-edit entry. X;;; X;;; When the stack is truncated, put the "." on the *second*-to-bottom line. X;;; When formatting formulas, suppress extra spaces inside vectors! X;;; Implement line-breaking in non-flat compositions. X;;; Implement structured line-breaking using level information. X;;; Implement matrix formatting with multi-line components. X;;; X;;; Support lambda notation in Z F and Z G commands. X;;; Have "Z R" define a user command based on a set of rewrite rules. X;;; Support "incf" and "decf" in defmath definitions. X;;; Have defmath generate calls to calc-binary-op or calc-unary-op. X;;; X;;; Allow calc-word-size=0 => Common Lisp-style signed bitwise arithmetic. X;;; Consider implementing some other special functions. X;;; May as well make continued-fractions stuff available to the user. X;;; Provide date arithmetic a la HP 48. X;;; X;;; Implement some more built-in statistical functions: X;;; mean, median, variance, std dev of a list. X;;; How about fitting a list or Nx2 matrix to a line or curve. X;;; X;;; How about matrix eigenvalues, SVD, pseudo-inverse, etc.? X;;; Should cache matrix inverses as well as decompositions. X;;; Allow calc-edit to edit a matrix in a more convenient form. X;;; X;;; Replace hokey formulas for complex functions with formulas designed X;;; to minimize roundoff while maintaining the proper branch cuts. X;;; Provide a better implementation for math-sin-cos-raw. X;;; Provide a better implementation for math-hypot. X;;; Provide a better implementation for math-make-frac. X;;; Provide a better implementation for math-prime-factors. X;;; Provide a better implementation for math-integral. X;;; Clean up some of the definitions in the units table. X;;; Implement dfact for large inputs using gamma function. X;;; X;;; Provide more examples in the tutorial section of the manual. X;;; Cover in the tutorial: language modes, simplification modes, X;;; bitwise stuff, rewrite rules. X;;; Provide more Lisp programming examples in the manual. X;;; Finish the Internals section of the manual. X;;; X;;; Tim suggests adding spreadsheet-like features. X;;; How about ultra-low-resolution plots? (Probably too slow.) X;;; Implement language modes for Lisp, Ada, ...? X;;; X X X;;; Graphically manipulating a composed expression: X;;; Have an option in math-compose-expr which wraps each term with a X;;; "(tag C X)" form where C is the composition term and X is the X;;; sub-expression that generated it. Now, call a variant of X;;; math-simplify-comp which returns the innermost X whose C contained X;;; a given (x,y) location. In addition, have a variant of X;;; math-simplify-comp which replaces every non-blank character inside X;;; a tag form for a given X with some highlight character like "#". X;;; (Consider supporting Epoch's true highlighting here.) X X;;; Idea: Have "{" and "}" mean select next larger or smaller sub-formula X;;; around the cursor; when a sub-formula is selected, the next command X;;; (of any sort) applies to that sub-formula. Have calc-top-n and X;;; calc-enter-result fake this up. Print a warning if a stack entry is X;;; highlighted which is not touched by the next command. X X X;;; For atan series, if x > tan(pi/12) (about 0.268) reduce using the identity X;;; atan(x) = atan((x * sqrt(3) - 1) / (sqrt(3) + x)) + pi/6. X X X;;; A better integration algorithm: X;;; Use breadth-first instead of depth-first search, as follows: X;;; The integral cache allows unfinished integrals in symbolic notation X;;; on the righthand side. An entry with no unfinished integrals on the X;;; RHS is "complete"; references to it elsewhere are replaced by the X;;; integrated value. More than one cache entry for the same integral X;;; may exist, though if one becomes complete, the others may be deleted. X;;; The integrator works by using every applicable rule (such as X;;; substitution, parts, linearity, etc.) to generate possible righthand X;;; sides, all of which are entered into the cache. Now, as long as the X;;; target integral is not complete (and the time limit has not run out) X;;; choose an incomplete integral from the cache and, for every integral X;;; appearing in its RHS's, add those integrals to the cache using the X;;; same substitition, parts, etc. rules. The cache should be organized X;;; as a priority queue, choosing the "simplest" incomplete integral at X;;; each step, or choosing randomly among equally simple integrals. X;;; Simplicity equals small size, and few steps removed from the original X;;; target integral. Note that when the integrator finishes, incomplete X;;; integrals can be left in the cache, so the algorithm can start where X;;; it left off if another similar integral is later requested. X;;; Breadth-first search would avoid the nagging problem of, e.g., whether X;;; to use parts or substitution first, and which decomposition is best. X;;; All are tried, and any path that diverges will quickly be put on the X;;; back burner by the priority queue. X;;; Note: Probably a good idea to call math-simplify-extended before X;;; measuring a formula's simplicity. X X X X X X X;;; NOTE: The default values listed below and those defined in X;;; calc-mode-vars-list must match. X X(defvar calc-mode-map nil "Keymap for calc-mode.") X(defvar calc-digit-map nil "Keymap for digit entry in calc-mode.") X X(defvar calc-trail-pointer nil "\"Current\" entry in trail buffer.") X X(defvar calc-stack '((top-of-stack 1)) "Calculator stack.") X(defvar calc-undo-list nil "List of previous operations in calc-mode.") X(defvar calc-redo-list nil "List of recent undo operations in calc-mode.") X(defvar calc-main-buffer nil "The Calculator buffer.") X(defvar calc-why nil "Explanations of most recent errors.") X(defvar calc-next-why nil) X X(defvar calc-last-kill nil "Last number killed in calc-mode.") X(defvar calc-previous-alg-entry nil "Previous string entered with algebraic entry.") X(defvar calc-dollar-values nil "Values to be used for '$' in expressions.") X(defvar calc-dollar-used nil "Highest order of '$' that occur in expression.") X(defvar calc-quick-prev-results nil "Previous results from Quick Calc.") X X(defvar calc-always-load-extensions nil X "*If non-NIL, load the calc-ext module automatically when calc is loaded.") X X(defvar calc-stack-top 1 X "Index into calc-stack of \"top\" of stack. XThis is 1 unless calc-truncate-stack has been used.") X X(defvar calc-line-numbering t X "*If non-NIL, display line numbers in Calculator stack.") X X(defvar calc-line-breaking t X "*If non-NIL, break long values across multiple lines in Calculator stack.") X X(defvar calc-display-just nil X "*If NIL, stack display is left-justified. XIf 'right, stack display is right-justified. XIf 'center, stack display is centered." X) X X(defvar calc-number-radix 10 X "*Radix for entry and display of numbers in calc-mode, 2-36.") X X(defvar calc-leading-zeros nil X "*If non-NIL, leading zeros are provided to pad integers to calc-word-size.") X X(defvar calc-group-digits nil X "*If non-NIL, group digits in large displayed integers by inserting spaces. XIf an integer, group that many digits at a time. XIf 't', use 4 for binary and hex, 3 otherwise.") X X(defvar calc-group-char "," X "*The character (in the form of a string) to be used for grouping digits. XThis is used only when calc-group-digits mode is on.") X X(defvar calc-point-char "." X "*The character (in the form of a string) to be used as a decimal point.") X X(defvar calc-frac-format ":" X "*Format of displayed fractions; a string of one or two of \":\" or \"/\".") X X(defvar calc-prefer-frac nil X "*If non-NIL, prefer fractional over floating-point results.") X X(defvar calc-hms-format "%s@ %s' %s\"" X "*Format of display hours-minutes-seconds angles, a format string. XString must contain three %s marks, for hours, minutes, seconds respectively.") X X(defvar calc-float-format '(float 0) X "*Format to use for display of floating-point numbers in calc-mode. XMust be a list of one of the following forms: X (float 0) Floating point format, display full precision. X (float N) N > 0: Floating point format, at most N significant figures. X (float -N) -N < 0: Floating point format, calc-internal-prec - N figs. X (fix N) N >= 0: Fixed point format, N places after decimal point. X (sci 0) Scientific notation, full precision. X (sci N) N > 0: Scientific notation, N significant figures. X (sci -N) -N < 0: Scientific notation, calc-internal-prec - N figs. X (eng 0) Engineering notation, full precision. X (eng N) N > 0: Engineering notation, N significant figures. X (eng -N) -N < 0: Engineering notation, calc-internal-prec - N figs.") X X(defvar calc-full-float-format '(float 0) X "*Format to use when full precision must be displayed.") X X(defvar calc-complex-format nil X "*Format to use for display of complex numbers in calc-mode. Must be one of: X nil Use (x, y) form. X i Use x + yi form. X j Use x + yj form.") X X(defvar calc-complex-mode 'cplx X "*Preferred form, either 'cplx or 'polar, for complex numbers.") X X(defvar calc-display-strings nil X "*If non-NIL, display vectors of byte-sized integers as strings.") X X(defvar calc-matrix-just 'center X "*If NIL, vector elements are left-justified. XIf 'right, vector elements are right-justified. XIf 'center, vector elements are centered." X) X X(defvar calc-vector-commas "," X "*If non-NIL, separate elements of displayed vectors with this string.") X X(defvar calc-vector-brackets "[]" X "*If non-NIL, surround displayed vectors with these characters.") X X(defvar calc-function-open "(" X "*Open-parenthesis string for function call notation.") X X(defvar calc-function-close ")" X "*Close-parenthesis string for function call notation.") X X(defvar calc-language nil X "*Language or format for entry and display of stack values. Must be one of: X nil Use standard Calc notation. X flat Use standard Calc notation, one-line format. X big Display formulas in 2-d notation (enter w/standard notation). X unform Use unformatted display: add(a, mul(b,c)). X c Use C language notation. X pascal Use Pascal language notation. X fortran Use Fortran language notation. X tex Use TeX notation. X math Use Mathematica(tm) notation.") X X(defvar calc-language-option nil X "*Numeric prefix argument for the command that set calc-language.") X X(defvar calc-language-output-filter nil X "Function through which to pass strings after formatting.") X X(defvar calc-language-input-filter nil X "Function through which to pass strings before parsing.") X X(defvar calc-radix-formatter nil X "*Formatting function used for non-decimal integers.") X X(defvar calc-word-size 32 X "*Minimum number of bits per word, if any, for binary operations in calc-mode.") X X(defvar calc-previous-modulo nil X "*Most recently used value of M in a modulo form.") X X(defvar calc-simplify-mode nil X "*Type of simplification applied to results. XIf 'none, results are not simplified when pushed on the stack. XIf 'num, functions are simplified only when args are constant. XIf NIL, only fast simplifications are applied. XIf 'binary, math-clip is applied if appropriate. XIf 'alg, math-simplify is applied. XIf 'ext, math-simplify-extended is applied. XIf 'units, math-simplify-units is applied.") X X(defvar calc-mapping-dir nil X "*Last direction specified in a Map or Reduce command.") X X(defvar calc-display-raw nil X "*If non-NIL, calculator display shows unformatted Lisp exprs. (For debugging)") X X(defvar calc-display-sci-high 0 X "*Floating-point numbers with this positive exponent or higher above the Xcurrent precision are displayed in scientific notation in calc-mode.") X X(defvar calc-display-sci-low -3 X "*Floating-point numbers with this negative exponent or lower are displayed Xscientific notation in calc-mode.") X X(defvar calc-internal-prec 12 X "*Number of digits of internal precision for calc-mode calculations.") X X(defvar calc-inverse-flag nil X "*If non-NIL, next operation is Inverse.") X X(defvar calc-hyperbolic-flag nil X "*If non-NIL, next operation is Hyperbolic.") X X(defvar calc-angle-mode 'deg X "*If deg, angles are in degrees; if rad, angles are in radians. XIf hms, angles are in degrees-minutes-seconds.") X X(defvar calc-algebraic-mode nil X "*If non-NIL, numeric entry accepts whole algebraic expressions. XIf NIL, algebraic expressions must be preceded by \"'\".") X X(defvar calc-symbolic-mode nil X "*If non-NIL, inexact numeric computations like sqrt(2) are postponed. XIf NIL, computations on numbers always yield numbers where possible.") X X(defvar calc-integral-limit 3 X "*An integer which governs how long calc-integral will look for an integral. XThe integrator often uses substitution or integration by parts to transform Xan integral into another one; this controls how many levels of nested Xsub-integrations are allowed before a given path is abandoned.") X X(defvar calc-window-height 7 X "*Initial height of Calculator window.") X X(defvar calc-display-trail t X "*If non-NIL, M-x calc creates a window to display Calculator trail.") X X(defvar calc-display-working-message 'lots X "*If non-NIL, display \"Working...\" for potentially slow Calculator commands.") X X(defvar calc-auto-why nil X "*If non-NIL, automatically execute a \"why\" command to explain odd results.") X X(defvar calc-said-hello nil) X(defvar calc-executing-macro nil) X X X(defvar calc-other-modes nil X "List of used-defined strings to append to Calculator mode line.") X X X(defvar calc-settings-file "~/.emacs" X "*File in which to record permanent settings; default is \"~/.emacs\".") X X(defvar calc-loaded-settings-file nil) X X X(defvar calc-bug-address "daveg@csvax.caltech.edu" X "*Address of the author of Calc, for use by report-calc-bug.") X X X(defvar var-i '(special-const (math-imaginary 1)) X "*Calculator variable representing the imaginary constant 'i'.") X X(defvar var-pi '(special-const (math-pi)) X "*Calculator variable representing the constant 'pi'.") X X(defvar var-e '(special-const (math-e)) X "*Calculator variable representing the constant 'e'.") X X X X;;; Set up the standard keystroke (M-#) to run the Calculator, if that key X;;; has not yet been bound to anything. For best results, the user should X;;; do this before Calc is even loaded, so that M-# can auto-load Calc. X(or (global-key-binding "\e#") X (global-set-key "\e#" 'calc)) X X X(defun calc-define-del (map func) X (define-key map "\C-d" func) X (mapcar (function (lambda (x) (define-key map x func))) X (append (where-is-internal 'delete-backward-char global-map) X (where-is-internal 'backward-delete-char global-map))) X) X X;; Still unused: f g j O W Y { } X(if calc-mode-map X nil X (setq calc-mode-map (make-keymap)) X (suppress-keymap calc-mode-map t) X (define-key calc-mode-map "+" 'calc-plus) X (define-key calc-mode-map "-" 'calc-minus) X (define-key calc-mode-map "*" 'calc-times) X (define-key calc-mode-map "/" 'calc-divide) X (define-key calc-mode-map "%" 'calc-mod) X (define-key calc-mode-map "&" 'calc-inv) X (define-key calc-mode-map "^" 'calc-power) X (define-key calc-mode-map "e" 'calcDigit-start) X (define-key calc-mode-map "h" 'describe-mode) X (define-key calc-mode-map "i" 'calc-info) X (define-key calc-mode-map "n" 'calc-change-sign) X (define-key calc-mode-map "o" 'calc-realign) X (define-key calc-mode-map "p" 'calc-precision) X (define-key calc-mode-map "q" 'calc-quit) X (define-key calc-mode-map "w" 'calc-why) X (define-key calc-mode-map "?" 'calc-help) X (define-key calc-mode-map " " 'calc-enter) X (define-key calc-mode-map "<" 'calc-scroll-left) X (define-key calc-mode-map ">" 'calc-scroll-right) X (define-key calc-mode-map "'" 'calc-algebraic-entry) X (define-key calc-mode-map "$" 'calc-auto-alg-entry) X (define-key calc-mode-map "\"" 'calc-auto-alg-entry) X (define-key calc-mode-map "\t" 'calc-roll-down) X (define-key calc-mode-map "\M-\t" 'calc-roll-up) X (define-key calc-mode-map "\C-m" 'calc-enter) X (define-key calc-mode-map "\C-j" 'calc-over) X (calc-define-del calc-mode-map 'calc-pop) X (mapcar (function X (lambda (x) X (define-key calc-mode-map (char-to-string x) 'undefined))) X "fgjOWY{}") X (mapcar (function X (lambda (x) X (define-key calc-mode-map (char-to-string x) 'calc-missing-key))) X (concat "ABCDEFGHIJKLMNPQRSTUVXZabcdklmrstuvxyz" X ":\\|!()[],;=~`\C-k\M-k\C-w\M-w\C-y\C-_")) X (mapcar (function X (lambda (x) X (define-key calc-mode-map (char-to-string x) 'calcDigit-start))) X "_0123456789.#@") X) X X(if calc-digit-map X nil X (setq calc-digit-map (make-keymap)) X (let ((i 0)) X (while (< i 128) X (aset calc-digit-map i X (if (eq (aref calc-mode-map i) 'undefined) X 'undefined 'calcDigit-nondigit)) X (setq i (1+ i)))) X (mapcar (function X (lambda (x) X (define-key calc-digit-map (char-to-string x) 'calcDigit-key))) X "_0123456789.e+-:n#@oh'\"mspM") X (mapcar (function X (lambda (x) X (define-key calc-digit-map (char-to-string x) 'calcDigit-letter))) X "abcdfgijklqrtuvwxyzABCDEFGHIJKLNOPQRSTUVWXYZ") X (define-key calc-digit-map "'" 'calcDigit-algebraic) X (define-key calc-digit-map "\C-g" 'abort-recursive-edit) X (calc-define-del calc-digit-map 'calcDigit-backspace) X) X X(put 'calc-mode 'mode-class 'special) X(put 'calc-trail-mode 'mode-class 'special) X X(defconst calc-mode-var-list '((calc-always-load-extensions nil) X (calc-line-numbering t) X (calc-line-breaking t) X (calc-display-just nil) X (calc-number-radix 10) X (calc-leading-zeros nil) X (calc-group-digits nil) X (calc-group-char ",") X (calc-point-char ".") X (calc-frac-format ":") X (calc-prefer-frac nil) X (calc-hms-format "%s@ %s' %s\"") X (calc-float-format (float 0)) X (calc-full-float-format (float 0)) X (calc-complex-format nil) X (calc-matrix-just center) X (calc-vector-commas ",") X (calc-vector-brackets "[]") X (calc-complex-mode cplx) X (calc-simplify-mode nil) X (calc-mapping-dir nil) X (calc-word-size 32) X (calc-previous-modulo nil) X (calc-internal-prec 12) X (calc-angle-mode deg) X (calc-algebraic-mode nil) X (calc-symbolic-mode nil) X (calc-integral-limit 3) X (calc-window-height 7) X (calc-language nil) X (calc-language-option nil) X (calc-display-trail t) X (calc-display-working-message lots) X (calc-auto-why nil))) X X(defconst calc-local-var-list '(calc-stack X calc-stack-top X calc-undo-list X calc-redo-list X calc-always-load-extensions X calc-display-raw X calc-line-numbering X calc-line-breaking X calc-display-just X calc-auto-why X calc-algebraic-mode X calc-symbolic-mode X calc-integral-limit X calc-inverse-flag X calc-hyperbolic-flag X calc-angle-mode X calc-number-radix X calc-leading-zeros X calc-group-digits X calc-group-char X calc-point-char X calc-frac-format X calc-prefer-frac X calc-hms-format X calc-float-format X calc-full-float-format X calc-complex-format X calc-matrix-just X calc-vector-commas X calc-vector-brackets X calc-complex-mode X calc-simplify-mode X calc-mapping-dir X calc-word-size X calc-internal-prec)) X X X(defun calc-mode () X "Calculator major mode. X XThis is an RPN calculator featuring arbitrary-precision integer, rational, Xfloating-point, complex, matrix, and symbolic arithmetic. X XRPN calculation: 2 RET 3 + produces 5. XAlgebraic style: ' 2+3 RET produces 5. X XOperators are +, -, *, /, ^ (power), % (modulo), n (change-sign). X XPress ? repeatedly for more complete help. X XNotations: 3.14e6 3.14 * 10^6 X _23 negative number -23 X 17:3 the fraction 17/3 X 5:2:3 the fraction 5 and 2/3 X 16#12C the integer 12C base 16 = 300 base 10 X 8#177:100 the fraction 177:100 base 8 = 127:64 base 10 X (2, 4) complex number 2 + 4i X (2; 4) polar complex number (r; theta) X [1, 2, 3] vector ([[1, 2], [3, 4]] is a matrix) X [1 .. 4) semi-open interval, 1 <= x < 4 X 2 +/- 3 (p key) number with mean 2, standard deviation 3 X 2 mod 3 (M key) number 2 computed modulo 3 X X\\{calc-mode-map} X" X (interactive) X (mapcar (function X (lambda (v) (set-default v (symbol-value v)))) calc-local-var-list) X (kill-all-local-variables) X (use-local-map calc-mode-map) X (mapcar (function (lambda (v) (make-local-variable v))) calc-local-var-list) X (setq truncate-lines t) X (setq buffer-read-only t) X (setq major-mode 'calc-mode) X (setq mode-name "Calculator") X (if (memq 'top-of-stack (mapcar 'car-safe calc-stack)) X (setq calc-stack (copy-sequence calc-stack)) X (setq calc-stack '((top-of-stack 1)) X calc-stack-top 1)) ; backward compatibility X (or calc-loaded-settings-file X (string-match "\\.emacs" calc-settings-file) X (progn X (setq calc-loaded-settings-file t) X (load calc-settings-file t))) ; t = missing-ok X (run-hooks 'calc-mode-hook) X (calc-refresh t) X (calc-set-mode-line) X (if (and (boundp 'calc-defs) X calc-defs) X (progn X (message "Evaluating calc-defs...") X (eval (cons 'progn calc-defs)) X (setq calc-defs nil) X (calc-refresh t) X (calc-set-mode-line))) X) X X(defun calc-trail-mode (&optional buf) X (interactive) X (fundamental-mode) X (use-local-map calc-mode-map) X (setq major-mode 'calc-trail-mode) X (setq mode-name "Calc Trail") X (setq truncate-lines nil) X (setq buffer-read-only t) X (if buf X (progn X (make-local-variable 'calc-main-buffer) X (setq calc-main-buffer buf))) X (if (= (buffer-size) 0) X (let ((buffer-read-only nil)) X (insert calc-version X "\n"))) X (or (and calc-trail-pointer X (eq (marker-buffer calc-trail-pointer) (current-buffer))) X (save-excursion X (goto-line 2) X (setq calc-trail-pointer (point-marker)))) X (run-hooks 'calc-trail-mode-hook) X) X X(defun calc-create-buffer () X (set-buffer (get-buffer-create "*Calculator*")) X (if (or (not (eq major-mode 'calc-mode)) X (and (boundp 'calc-defs) calc-defs)) X (calc-mode)) X (if calc-always-load-extensions X (calc-extensions)) X (if calc-language X (progn X (calc-extensions) X (calc-set-language calc-language calc-language-option t))) X) X X(defun calc (&optional arg no-display) X "The Emacs Calculator. Full documentation is listed under \"calc-mode\"." X (interactive "P") X (or (fboundp 'calc-extensions) X (autoload 'calc-extensions "calc-ext")) X (if arg X (or (eq arg 0) X (progn X (calc-extensions) X (if (< (prefix-numeric-value arg) 0) X (calc-grab-region (region-beginning) (region-end))))) X (if (eq major-mode 'calc-mode) X (calc-quit) X (let ((oldbuf (current-buffer))) X (calc-create-buffer) X (if (get-buffer-window (current-buffer)) X (select-window (get-buffer-window (current-buffer))) X (if (and (boundp 'calc-window-hook) calc-window-hook) X (run-hooks 'calc-window-hook) X (let ((w (get-largest-window))) X (if (and pop-up-windows X (> (window-height w) X (+ window-min-height calc-window-height 2))) X (progn X (setq w (split-window w X (- (window-height w) X calc-window-height 2) X nil)) X (set-window-buffer w (current-buffer)) X (select-window w)) X (pop-to-buffer (current-buffer)))))) X (save-excursion X (let ((buf (current-buffer))) X (set-buffer (get-buffer-create "*Calc Trail*")) X (calc-trail-mode buf) X (and calc-display-trail X (= (window-width) (screen-width)) X (calc-trail-display 1 t)))) X (setq max-lisp-eval-depth (max max-lisp-eval-depth 1000)) X (calc-summary) X (and calc-said-hello X (interactive-p) X (progn X (sit-for 2) X (message ""))) X (setq calc-said-hello t) X (run-hooks 'calc-start-hook)))) X) X X(defun another-calc () X "Create another, independent Calculator buffer." X (interactive) X (if (eq major-mode 'calc-mode) X (mapcar (function X (lambda (v) X (set-default v (symbol-value v)))) calc-local-var-list)) X (set-buffer (generate-new-buffer "*Calculator*")) X (pop-to-buffer (current-buffer)) X (calc-mode) X) X X(defun calc-quit () X "Close the Calculator window(s). XThis does not destroy the Calculator buffers or forget the stack contents, Xit only closes the windows." X (interactive) X (calc-select-buffer) X (run-hooks 'calc-end-hook) X (setq calc-undo-list nil calc-redo-list nil) X (mapcar (function X (lambda (v) (set-default v (symbol-value v)))) calc-local-var-list) X (let ((buf (current-buffer)) X (tbuf (get-buffer-create "*Calc Trail*")) X (win (get-buffer-window (current-buffer)))) X (if (and win X (< (window-height win) (1- (screen-height)))) X (setq calc-window-height (- (window-height win) 2))) X (delete-windows-on buf) X (delete-windows-on tbuf) X (bury-buffer buf) X (bury-buffer tbuf)) X) X X(defun quick-calc () X "Do a quick calculation in the minibuffer without invoking full Calculator." X (interactive) X (save-excursion X (calc-create-buffer) X (let* ((calc-command-flags nil) X (calc-language (if (memq calc-language '(nil big)) X 'flat calc-language)) X (calc-dollar-values calc-quick-prev-results) X (calc-dollar-used 0) X (alg-exp (calc-do-alg-entry "" "Quick calc: "))) X (let ((buf "")) X (setq calc-quick-prev-results alg-exp) X (while alg-exp X (setq buf (concat buf X (if calc-extensions-loaded X (math-format-value (car alg-exp) 1000) X (math-format-flat-expr (car alg-exp) 0)) X " ") X alg-exp (cdr alg-exp))) X (calc-handle-whys) X (message buf)))) X) X X(defun calc-summary () X (interactive) X (message "Welcome to the GNU Emacs Calculator! Press ? for help, q to quit.") X) X X(defun calc-info () X "Run the Emacs Info system on the Calculator documentation." X (interactive) X (require 'info) X (select-window (get-largest-window)) X (Info-find-node calc-info-filename "Top") X) X X(defun calc-help () X (interactive) X (let ((msgs X '("Letter keys: Help, Info, Why; Xtended cmd; Yank; Quit" X "Letter keys: Negate; Precision; Store, Recall, Let" X "Letter keys: SHIFT + Undo, reDo, last-X; Inverse, Hyperbolic" X "Letter keys: SHIFT + sQrt; Sin, Cos, Tan; Exp, Ln, logB" X "Letter keys: SHIFT + Floor, Round; Abs, conJ, arG; Pi" X "Letter keys: SHIFT + Num-eval; More-recn; Kbd-macro" X "Other keys: +, -, *, /, ^, \\ (int div), : (frac div)" X "Other keys: & (1/x), | (concat), % (modulo), ! (factorial)" X "Other keys: ' (alg-entry), = (evaluate), ` (edit)" X "Other keys: RET (enter), DEL (drop), TAB (swap), M-TAB (roll)" X "Other keys: [ ] (vector), ( ) (complex); < > (hscroll)" X "Prefix keys: Algebra, Binary, Convert, Display, Kombinatorics" X "Prefix keys: Modes, Trail, Units, Vectors" X "Prefix keys: Z (user), SHIFT + Z (define-user)" X "Prefix keys: prefix + ? gives further help for that prefix" X " Copyright (C) 1990 Dave Gillespie, daveg@csvax.caltech.edu"))) X (setq calc-help-phase X (if (eq this-command last-command) X (% (1+ calc-help-phase) (1+ (length msgs))) X 0)) X (let ((msg (nth calc-help-phase msgs))) X (message "%s" (if msg X (concat msg ":" X (make-string (- (apply 'max X (mapcar 'length msgs)) X (length msg)) 32) X " [?=MORE]") X "")))) X) X(setq calc-help-phase 0) X X X(defun calc-scroll-left (n) X "Horizontally scroll one half-screen to the left." X (interactive "P") X (scroll-left (or n (/ (window-width) 2))) X) X X(defun calc-scroll-right (n) X "Horizontally scroll one half-screen to the right." X (interactive "P") X (scroll-right (or n (/ (window-width) 2))) X) X X X(defmacro calc-with-default-simplification (body) X (list 'let X '((calc-simplify-mode (and (not (memq calc-simplify-mode '(none num))) X calc-simplify-mode))) X body) X) X X X X X;;;; Stack and buffer management. X X(defmacro calc-wrapper (&rest body) X (` (let ((calc-command-flags nil)) X (unwind-protect X (progn X (, (append '(save-excursion (calc-select-buffer)) X body X '((calc-finish-command))))) X (calc-cleanup-command)))) X) X X(defmacro calc-slow-wrapper (&rest body) X (` (let ((calc-command-flags (list 'clear-message))) X (if calc-display-working-message (message "Working...")) X (unwind-protect X (progn X (, (append '(save-excursion (calc-select-buffer)) X body X '((calc-finish-command))))) X (calc-cleanup-command)))) X) X X(defun calc-set-command-flag (f) X (if (not (memq f calc-command-flags)) X (setq calc-command-flags (cons f calc-command-flags))) X) X X(defun calc-clear-command-flag (f) X (setq calc-command-flags (delq f calc-command-flags)) X) X X(defun calc-select-buffer () X (if (not (eq major-mode 'calc-mode)) X (if calc-main-buffer X (set-buffer calc-main-buffer) X (let ((buf (get-buffer "*Calculator*"))) X (if buf X (set-buffer buf) X (error "Calculator buffer not available"))))) X) X X(defun calc-finish-command () X (and (memq 'renum-stack calc-command-flags) X (calc-renumber-stack)) X (and (memq 'clear-message calc-command-flags) X (message "")) X) X X(defun calc-cleanup-command () X (or (memq 'no-align calc-command-flags) X (calc-align-stack-window)) X (or (memq 'keep-flags calc-command-flags) X (setq calc-inverse-flag nil X calc-hyperbolic-flag nil)) X (calc-set-mode-line) X) X X(defun calc-cursor-stack-index (&optional index) X (goto-char (point-max)) X (forward-line (- (calc-substack-height (or index 1)))) X) X X(defun calc-stack-size () X (- (length calc-stack) calc-stack-top) X) X X(defun calc-substack-height (n) X (let ((sum 0) X (stack calc-stack)) X (setq n (+ n calc-stack-top)) X (while (and (> n 0) stack) X (setq sum (+ sum (nth 1 (car stack))) X n (1- n) X stack (cdr stack))) X sum) X) X X(defun calc-set-mode-line () X (save-excursion X (calc-select-buffer) X (let* ((fmt (car calc-float-format)) X (figs (nth 1 calc-float-format)) X (new-mode-string X (format "Calc%s: %d %s %-14s" X (if (and (> (length (buffer-name)) 12) X (equal (substring (buffer-name) 0 12) X "*Calculator*")) X (substring (buffer-name) 12) X "") X calc-internal-prec X (capitalize (symbol-name calc-angle-mode)) X (concat X (cond ((= calc-number-radix 10) "") X ((= calc-number-radix 2) "Bin ") X ((= calc-number-radix 8) "Oct ") X ((= calc-number-radix 16) "Hex ") X (t (format "Radix%d " calc-number-radix))) X (if calc-algebraic-mode "Alg " "") X (if calc-symbolic-mode "Symb " "") X (cond ((eq calc-simplify-mode 'none) "NoSimp ") X ((eq calc-simplify-mode 'num) "NumSimp ") X ((eq calc-simplify-mode 'binary) X (format "BinSimp%d " calc-word-size)) X ((eq calc-simplify-mode 'alg) "AlgSimp ") X ((eq calc-simplify-mode 'units) "UnitSimp ") X (t "")) X (cond ((null calc-language) "") X ((eq calc-language 'tex) "TeX ") X (t (concat X (capitalize (symbol-name calc-language)) X " "))) X (if (eq calc-complex-mode 'polar) "Polar " "") X (if calc-prefer-frac "Frac " "") X (cond ((eq fmt 'float) X (if (zerop figs) "" (format "Norm%d " figs))) X ((eq fmt 'fix) (format "Fix%d " figs)) X ((eq fmt 'sci) X (if (zerop figs) "Sci " (format "Sci%d " figs))) X ((eq fmt 'eng) X (if (zerop figs) "Eng " (format "Eng%d " figs)))) X (if calc-inverse-flag "Inv " "") X (if calc-hyperbolic-flag "Hyp " "") X (if (/= calc-stack-top 1) "Narrow " "") X (apply 'concat calc-other-modes))))) X (if (equal new-mode-string mode-line-buffer-identification) X nil X (setq mode-line-buffer-identification new-mode-string) X (set-buffer-modified-p (buffer-modified-p))))) X) X X(defun calc-align-stack-window () X (let ((win (get-buffer-window (current-buffer)))) X (if win X (progn X (calc-cursor-stack-index 0) X (vertical-motion (- 2 (window-height))) X (set-window-start win (point))))) X (calc-cursor-stack-index 0) X (if (looking-at " *\\.$") X (goto-char (1- (match-end 0)))) X) X X(defun calc-check-stack (n) X (if (> n (calc-stack-size)) X (error "Too few elements on stack")) X (if (< n 0) X (error "Invalid argument")) X) X X(defun calc-push (&rest vals) X (if (memq nil vals) X (error "Invalid operation") X (calc-push-list vals)) X) X X(defun calc-push-list (vals &optional m) X (while vals X (if calc-executing-macro X (let ((entry (list (car vals) 1)) X (mm (+ (or m 1) calc-stack-top))) X (if (> mm 1) X (setcdr (nthcdr (- mm 2) calc-stack) X (cons entry (nthcdr (1- mm) calc-stack))) X (setq calc-stack (cons entry calc-stack)))) X (save-excursion X (calc-select-buffer) X (let* ((val (car vals)) X (fmt (math-format-stack-value val)) X (entry (list val (calc-count-lines fmt))) X (mm (+ (or m 1) calc-stack-top))) X (calc-cursor-stack-index (1- (or m 1))) X (if (> mm 1) X (setcdr (nthcdr (- mm 2) calc-stack) X (cons entry (nthcdr (1- mm) calc-stack))) X (setq calc-stack (cons entry calc-stack))) X (let ((buffer-read-only nil)) X (insert fmt "\n")) X (calc-record-undo (list 'push mm)) X (calc-set-command-flag 'renum-stack)))) X (setq vals (cdr vals))) X) X X(defun calc-count-lines (s) X (let ((pos 0) X (num 1)) X (while (setq newpos (string-match "\n" s pos)) X (setq pos (1+ newpos) X num (1+ num))) X num) X) X X(defun calc-pop-push-list (n vals) X (if (memq nil vals) X (error "Invalid operation")) X (calc-pop-stack n) X (calc-push-list vals) X) X X(defun calc-pop-push (n &rest vals) X (calc-pop-push-list n vals) X) X X(defun calc-pop-push-record-list (n prefix vals) X (if (and (consp vals) X (or (integerp (car vals)) X (consp (car vals)))) X (if (memq nil vals) X (error "Invalid operation")) X (and vals (setq vals (list vals)))) X (calc-check-stack n) X (if prefix X (if vals X (calc-record-list vals prefix) X (calc-record nil prefix))) X (calc-pop-push-list n vals) X) X X(defun calc-enter-result (n prefix vals) X (if (and (consp vals) X (or (integerp (car vals)) X (consp (car vals)))) X (setq vals (mapcar 'calc-normalize vals)) X (setq vals (calc-normalize vals))) X (or (and (consp vals) X (or (integerp (car vals)) X (consp (car vals)))) X (setq vals (list vals))) X (if (equal vals '((nil))) X (setq vals nil)) X (calc-pop-push-record-list n prefix vals) X (calc-handle-whys) X) X X(defun calc-normalize (val) X (if (memq calc-simplify-mode '(nil none num)) X (math-normalize val) X (calc-extensions) X (cond ((eq calc-simplify-mode 'binary) X (let ((s (math-normalize val))) X (if (math-realp s) X (math-clip (math-round s)) X s))) X ((eq calc-simplify-mode 'alg) X (math-simplify val)) X ((eq calc-simplify-mode 'ext) X (math-simplify-extended val)) X ((eq calc-simplify-mode 'units) X (math-simplify-units val)))) X) X X(defun calc-handle-whys () X (setq calc-why calc-next-why X calc-next-why nil) X (if (and calc-why calc-auto-why) X (progn X (calc-explain-why (car calc-why)) X (calc-clear-command-flag 'clear-message))) X) X X(defun calc-explain-why (why) X (let* ((pred (car why)) X (msg (cond ((not pred) "Wrong type of argument") X ((stringp pred) pred) X ((eq pred 'integerp) "Integer expected") X ((eq pred 'natnump) "Nonnegative integer expected") X ((eq pred 'fixnump) "Small integer expected") X ((eq pred 'posp) "Positive number expected") X ((eq pred 'negp) "Negative number expected") X ((eq pred 'realp) "Real number expected") X ((eq pred 'anglep) "Real number expected") X ((eq pred 'hmsp) "HMS form expected") X ((eq pred 'numberp) "Number expected") X ((eq pred 'scalarp) "Number expected") X ((eq pred 'vectorp) "Vector or matrix expected") X ((eq pred 'numvecp) "Number or vector expected") X ((eq pred 'square-matrixp) "Square matrix expected") X ((eq pred 'objectp) "Number expected") X ((eq pred 'constp) "Constant expected") X ((eq pred 'range) "Argument out of range") X (t (format "%s expected" pred)))) X (punc ": ")) X (while (setq why (cdr why)) X (setq msg (concat msg punc (if (stringp (car why)) X (car why) X (math-format-flat-expr (car why) 0))) X punc ", ")) X (message "%s" msg)) X) X X(defun calc-record-why (&rest stuff) X (setq calc-next-why (cons stuff calc-next-why)) X nil X) X X(defun calc-pop-push-record (n prefix &rest vals) X (calc-pop-push-record-list n prefix vals) X) X X(defun calc-pop-stack (&optional n m) ; pop N objects at level M of stack. X (or n (setq n 1)) X (or m (setq m 1)) X (let ((mm (+ m calc-stack-top))) X (if calc-executing-macro X (if (> mm 1) X (setcdr (nthcdr (- mm 2) calc-stack) X (nthcdr (+ n mm -1) calc-stack)) X (setq calc-stack (nthcdr n calc-stack))) X (calc-record-undo (list 'pop mm (calc-top-list n m))) X (save-excursion X (calc-select-buffer) X (let ((buffer-read-only nil)) X (if (> mm 1) X (progn X (calc-cursor-stack-index (1- m)) X (let ((bot (point))) X (calc-cursor-stack-index (+ n m -1)) X (delete-region (point) bot)) X (setcdr (nthcdr (- mm 2) calc-stack) X (nthcdr (+ n mm -1) calc-stack))) X (calc-cursor-stack-index n) X (setq calc-stack (nthcdr n calc-stack)) X (delete-region (point) (point-max))) X (calc-set-command-flag 'renum-stack))))) X) X X(defun calc-top (&optional n) X "Get the Nth element of the stack (N=1 is the top element)." X (or n (setq n 1)) X (calc-check-stack n) X (car-safe (nth (+ n calc-stack-top -1) calc-stack)) X) X X(defun calc-top-n (&optional n) ; in case precision has changed X (math-check-complete (calc-normalize (calc-top n))) X) X X(defun calc-top-list (&optional n m) X (or n (setq n 1)) X (or m (setq m 1)) X (calc-check-stack (+ n m -1)) X (and (> n 0) X (let ((top (copy-sequence (nthcdr (+ m calc-stack-top -1) X calc-stack)))) X (setcdr (nthcdr (1- n) top) nil) X (nreverse (mapcar 'car-safe top)))) X) X X(defun calc-top-list-n (&optional n m) X (mapcar 'math-check-complete X (mapcar 'calc-normalize (calc-top-list n m))) X) X X(defun calc-roll-down-stack (n &optional m) X (if (< n 0) X (calc-roll-up-stack (- n) m) X (if (or (= n 0) (> n (calc-stack-size))) (setq n (calc-stack-size))) X (or m (setq m 1)) X (and (> n 1) X (< m n) X (calc-pop-push-list n X (append (calc-top-list m 1) X (calc-top-list (- n m) (1+ m)))))) X) X X(defun calc-roll-up-stack (n &optional m) X (if (< n 0) X (calc-roll-down-stack (- n) m) X (if (or (= n 0) (> n (calc-stack-size))) (setq n (calc-stack-size))) X (or m (setq m 1)) X (and (> n 1) X (< m n) X (calc-pop-push-list n X (append (calc-top-list (- n m) 1) X (calc-top-list m (- n m -1)))))) X) X X(defun calc-renumber-stack () X (if calc-line-numbering X (save-excursion X (calc-cursor-stack-index 0) X (let ((lnum 1) X (buffer-read-only nil)) X (if (re-search-forward "^[0-9]+:" nil t) X (progn X (beginning-of-line) X (while (re-search-forward "^[0-9]+:" nil t) X (let ((buffer-read-only nil)) X (beginning-of-line) X (delete-char 4) X (insert " "))) X (calc-cursor-stack-index 0))) X (while (re-search-backward "^[0-9]+:" nil t) X (delete-char 4) X (if (> lnum 999) X (insert (format "%03d:" (% lnum 1000))) X (let ((prefix (int-to-string lnum))) X (insert prefix ":" (make-string (- 3 (length prefix)) 32)))) X (beginning-of-line) X (setq lnum (1+ lnum)))))) X) X X(defun calc-refresh (&optional align) X "Refresh the contents of the Calculator buffer from memory." X (interactive) X (if (and (eq major-mode 'calc-mode) X (not calc-executing-macro)) X (let ((buffer-read-only nil) X (save-point (point)) X (save-mark (mark)) X (save-aligned (looking-at "\\.$")) X (thing calc-stack)) X (erase-buffer) X (insert "--- Emacs Calculator Mode ---\n") X (while thing X (goto-char (point-min)) X (forward-line 1) X (let ((fmt (math-format-stack-value (car (car thing))))) X (setcar (cdr (car thing)) (calc-count-lines fmt)) X (insert fmt "\n")) X (setq thing (cdr thing))) X (calc-renumber-stack) X (if (or align save-aligned) X (calc-align-stack-window) X (goto-char save-point)) X (set-mark save-mark))) X (setq calc-refresh-count (1+ calc-refresh-count)) X) X(setq calc-refresh-count 0) X X(defun calc-realign () X "Realign Calc window with cursor and top-of-stack at the bottom." X (interactive) X (calc-wrapper) X) X X X X;;;; The Calc Trail buffer. X X(defun calc-check-trail-aligned () X (save-excursion X (let ((win (get-buffer-window (current-buffer)))) X (and win X (pos-visible-in-window-p (1- (point-max)) win) X ; (not (pos-visible-in-window-p (point-max) win)) X ))) X) X X(defmacro math-showing-full-precision (body) X (list 'let X '((calc-float-format calc-full-float-format)) X body) SHAR_EOF echo "End of part 1" echo "File calc.el is continued in part 2" echo "2" > s2_seq_.tmp exit 0