| 1 | ;;; calc.el --- the GNU Emacs calculator |
| 2 | |
| 3 | ;; Copyright (C) 1990-1993, 2001-2012 Free Software Foundation, Inc. |
| 4 | |
| 5 | ;; Author: David Gillespie <daveg@synaptics.com> |
| 6 | ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> |
| 7 | ;; Keywords: convenience, extensions |
| 8 | |
| 9 | ;; This file is part of GNU Emacs. |
| 10 | |
| 11 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
| 12 | ;; it under the terms of the GNU General Public License as published by |
| 13 | ;; the Free Software Foundation, either version 3 of the License, or |
| 14 | ;; (at your option) any later version. |
| 15 | |
| 16 | ;; GNU Emacs is distributed in the hope that it will be useful, |
| 17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 19 | ;; GNU General Public License for more details. |
| 20 | |
| 21 | ;; You should have received a copy of the GNU General Public License |
| 22 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
| 23 | |
| 24 | ;;; Commentary: |
| 25 | |
| 26 | ;; Calc is split into many files. This file is the main entry point. |
| 27 | ;; This file includes autoload commands for various other basic Calc |
| 28 | ;; facilities. The more advanced features are based in calc-ext, which |
| 29 | ;; in turn contains autoloads for the rest of the Calc files. This |
| 30 | ;; odd set of interactions is designed to make Calc's loading time |
| 31 | ;; be as short as possible when only simple calculations are needed. |
| 32 | |
| 33 | ;; Original author's address: |
| 34 | ;; Dave Gillespie, daveg@synaptics.com, uunet!synaptx!daveg. |
| 35 | ;; Synaptics, Inc., 2698 Orchard Parkway, San Jose, CA 95134. |
| 36 | ;; |
| 37 | ;; The old address daveg@csvax.cs.caltech.edu will continue to |
| 38 | ;; work for the foreseeable future. |
| 39 | ;; |
| 40 | ;; Bug reports and suggestions are always welcome! (Type M-x |
| 41 | ;; report-calc-bug to send them). |
| 42 | |
| 43 | ;; All functions, macros, and Lisp variables defined here begin with one |
| 44 | ;; of the prefixes "math", "Math", or "calc", with the exceptions of |
| 45 | ;; "full-calc", "full-calc-keypad", "another-calc", "quick-calc", |
| 46 | ;; "report-calc-bug", and "defmath". User-accessible variables begin |
| 47 | ;; with "var-". |
| 48 | |
| 49 | ;;; TODO: |
| 50 | |
| 51 | ;; Fix rewrite mechanism to do less gratuitous rearrangement of terms. |
| 52 | ;; Implement a pattern-based "refers" predicate. |
| 53 | ;; |
| 54 | ;; Make it possible to Undo a selection command. |
| 55 | ;; Figure out how to allow selecting rows of matrices. |
| 56 | ;; If cursor was in selection before, move it after j n, j p, j L, etc. |
| 57 | ;; Consider reimplementing calc-delete-selection using rewrites. |
| 58 | ;; |
| 59 | ;; Implement line-breaking in non-flat compositions (is this desirable?). |
| 60 | ;; Implement matrix formatting with multi-line components. |
| 61 | ;; |
| 62 | ;; Have "Z R" define a user command based on a set of rewrite rules. |
| 63 | ;; Support "incf" and "decf" in defmath definitions. |
| 64 | ;; Have defmath generate calls to calc-binary-op or calc-unary-op. |
| 65 | ;; Make some way to define algebraic functions using keyboard macros. |
| 66 | ;; |
| 67 | ;; Allow calc-word-size=0 => Common Lisp-style signed bitwise arithmetic. |
| 68 | ;; Consider digamma function (and thus arb. prec. Euler's gamma constant). |
| 69 | ;; May as well make continued-fractions stuff available to the user. |
| 70 | ;; |
| 71 | ;; How about matrix eigenvalues, SVD, pseudo-inverse, etc.? |
| 72 | ;; Should cache matrix inverses as well as decompositions. |
| 73 | ;; If dividing by a non-square matrix, use least-squares automatically. |
| 74 | ;; Consider supporting matrix exponentials. |
| 75 | ;; |
| 76 | ;; Have ninteg detect and work around singularities at the endpoints. |
| 77 | ;; Use an adaptive subdivision algorithm for ninteg. |
| 78 | ;; Provide nsum and nprod to go along with ninteg. |
| 79 | ;; |
| 80 | ;; Handle TeX-mode parsing of \matrix{ ... } where ... contains braces. |
| 81 | ;; Support AmS-TeX's \{d,t,}frac, \{d,t,}binom notations. |
| 82 | ;; Format and parse sums and products in Eqn and Math modes. |
| 83 | ;; |
| 84 | ;; Get math-read-big-expr to read sums, products, etc. |
| 85 | ;; Change calc-grab-region to use math-read-big-expr. |
| 86 | ;; Have a way to define functions using := in Embedded Mode. |
| 87 | ;; |
| 88 | ;; Support polar plotting with GNUPLOT. |
| 89 | ;; Make a calc-graph-histogram function. |
| 90 | ;; |
| 91 | ;; Replace hokey formulas for complex functions with formulas designed |
| 92 | ;; to minimize roundoff while maintaining the proper branch cuts. |
| 93 | ;; Test accuracy of advanced math functions over whole complex plane. |
| 94 | ;; Extend Bessel functions to provide arbitrary precision. |
| 95 | ;; Extend advanced math functions to handle error forms and intervals. |
| 96 | ;; Provide a better implementation for math-sin-cos-raw. |
| 97 | ;; Provide a better implementation for math-hypot. |
| 98 | ;; Provide a better implementation for math-make-frac. |
| 99 | ;; Provide a better implementation for calcFunc-prfac. |
| 100 | ;; Provide a better implementation for calcFunc-factor. |
| 101 | ;; |
| 102 | ;; Provide more examples in the tutorial section of the manual. |
| 103 | ;; Cover in the tutorial: simplification modes, declarations, |
| 104 | ;; bitwise stuff, selections, matrix mapping, financial functions. |
| 105 | ;; Provide more Lisp programming examples in the manual. |
| 106 | ;; Finish the Internals section of the manual (and bring it up to date). |
| 107 | ;; |
| 108 | ;; Tim suggests adding spreadsheet-like features. |
| 109 | ;; Implement language modes for Gnuplot, Lisp, Ada, APL, ...? |
| 110 | ;; |
| 111 | ;; For atan series, if x > tan(pi/12) (about 0.268) reduce using the identity |
| 112 | ;; atan(x) = atan((x * sqrt(3) - 1) / (sqrt(3) + x)) + pi/6. |
| 113 | ;; |
| 114 | ;; A better integration algorithm: |
| 115 | ;; Use breadth-first instead of depth-first search, as follows: |
| 116 | ;; The integral cache allows unfinished integrals in symbolic notation |
| 117 | ;; on the righthand side. An entry with no unfinished integrals on the |
| 118 | ;; RHS is "complete"; references to it elsewhere are replaced by the |
| 119 | ;; integrated value. More than one cache entry for the same integral |
| 120 | ;; may exist, though if one becomes complete, the others may be deleted. |
| 121 | ;; The integrator works by using every applicable rule (such as |
| 122 | ;; substitution, parts, linearity, etc.) to generate possible righthand |
| 123 | ;; sides, all of which are entered into the cache. Now, as long as the |
| 124 | ;; target integral is not complete (and the time limit has not run out) |
| 125 | ;; choose an incomplete integral from the cache and, for every integral |
| 126 | ;; appearing in its RHS's, add those integrals to the cache using the |
| 127 | ;; same substitution, parts, etc. rules. The cache should be organized |
| 128 | ;; as a priority queue, choosing the "simplest" incomplete integral at |
| 129 | ;; each step, or choosing randomly among equally simple integrals. |
| 130 | ;; Simplicity equals small size, and few steps removed from the original |
| 131 | ;; target integral. Note that when the integrator finishes, incomplete |
| 132 | ;; integrals can be left in the cache, so the algorithm can start where |
| 133 | ;; it left off if another similar integral is later requested. |
| 134 | ;; Breadth-first search would avoid the nagging problem of, e.g., whether |
| 135 | ;; to use parts or substitution first, and which decomposition is best. |
| 136 | ;; All are tried, and any path that diverges will quickly be put on the |
| 137 | ;; back burner by the priority queue. |
| 138 | ;; Note: Probably a good idea to call math-simplify-extended before |
| 139 | ;; measuring a formula's simplicity. |
| 140 | |
| 141 | ;;; Code: |
| 142 | |
| 143 | (require 'calc-macs) |
| 144 | |
| 145 | ;; Declare functions which are defined elsewhere. |
| 146 | (declare-function calc-set-language "calc-lang" (lang &optional option no-refresh)) |
| 147 | (declare-function calc-edit-finish "calc-yank" (&optional keep)) |
| 148 | (declare-function calc-edit-cancel "calc-yank" ()) |
| 149 | (declare-function calc-do-quick-calc "calc-aent" ()) |
| 150 | (declare-function calc-do-calc-eval "calc-aent" (str separator args)) |
| 151 | (declare-function calc-do-keypad "calc-keypd" (&optional full-display interactive)) |
| 152 | (declare-function calcFunc-unixtime "calc-forms" (date &optional zone)) |
| 153 | (declare-function math-parse-date "calc-forms" (math-pd-str)) |
| 154 | (declare-function math-lessp "calc-ext" (a b)) |
| 155 | (declare-function math-compare "calc-ext" (a b)) |
| 156 | (declare-function calc-embedded-finish-command "calc-embed" ()) |
| 157 | (declare-function calc-embedded-select-buffer "calc-embed" ()) |
| 158 | (declare-function calc-embedded-mode-line-change "calc-embed" ()) |
| 159 | (declare-function calc-push-list-in-macro "calc-prog" (vals m sels)) |
| 160 | (declare-function calc-replace-selections "calc-sel" (n vals m)) |
| 161 | (declare-function calc-record-list "calc-misc" (vals &optional prefix)) |
| 162 | (declare-function calc-normalize-fancy "calc-ext" (val)) |
| 163 | (declare-function calc-do-handle-whys "calc-misc" ()) |
| 164 | (declare-function calc-top-selected "calc-sel" (&optional n m)) |
| 165 | (declare-function calc-sel-error "calc-sel" ()) |
| 166 | (declare-function calc-pop-stack-in-macro "calc-prog" (n mm)) |
| 167 | (declare-function calc-embedded-stack-change "calc-embed" ()) |
| 168 | (declare-function calc-refresh-evaltos "calc-ext" (&optional which-var)) |
| 169 | (declare-function calc-do-refresh "calc-misc" ()) |
| 170 | (declare-function calc-binary-op-fancy "calc-ext" (name func arg ident unary)) |
| 171 | (declare-function calc-unary-op-fancy "calc-ext" (name func arg)) |
| 172 | (declare-function calc-delete-selection "calc-sel" (n)) |
| 173 | (declare-function calc-alg-digit-entry "calc-aent" ()) |
| 174 | (declare-function calc-alg-entry "calc-aent" (&optional initial prompt)) |
| 175 | (declare-function calc-dots "calc-incom" ()) |
| 176 | (declare-function calc-temp-minibuffer-message "calc-misc" (m)) |
| 177 | (declare-function math-read-radix-digit "calc-misc" (dig)) |
| 178 | (declare-function calc-digit-dots "calc-incom" ()) |
| 179 | (declare-function math-normalize-fancy "calc-ext" (a)) |
| 180 | (declare-function math-normalize-nonstandard "calc-ext" ()) |
| 181 | (declare-function math-recompile-eval-rules "calc-alg" ()) |
| 182 | (declare-function math-apply-rewrites "calc-rewr" (expr rules &optional heads math-apply-rw-ruleset)) |
| 183 | (declare-function calc-record-why "calc-misc" (&rest stuff)) |
| 184 | (declare-function math-dimension-error "calc-vec" ()) |
| 185 | (declare-function calc-incomplete-error "calc-incom" (a)) |
| 186 | (declare-function math-float-fancy "calc-arith" (a)) |
| 187 | (declare-function math-neg-fancy "calc-arith" (a)) |
| 188 | (declare-function calc-add-fractions "calc-frac" (a b)) |
| 189 | (declare-function math-add-objects-fancy "calc-arith" (a b)) |
| 190 | (declare-function math-add-symb-fancy "calc-arith" (a b)) |
| 191 | (declare-function math-mul-zero "calc-arith" (a b)) |
| 192 | (declare-function calc-mul-fractions "calc-frac" (a b)) |
| 193 | (declare-function math-mul-objects-fancy "calc-arith" (a b)) |
| 194 | (declare-function math-mul-symb-fancy "calc-arith" (a b)) |
| 195 | (declare-function math-reject-arg "calc-misc" (&optional a p option)) |
| 196 | (declare-function math-div-by-zero "calc-arith" (a b)) |
| 197 | (declare-function math-div-zero "calc-arith" (a b)) |
| 198 | (declare-function math-make-frac "calc-frac" (num den)) |
| 199 | (declare-function calc-div-fractions "calc-frac" (a b)) |
| 200 | (declare-function math-div-objects-fancy "calc-arith" (a b)) |
| 201 | (declare-function math-div-symb-fancy "calc-arith" (a b)) |
| 202 | (declare-function math-compose-expr "calccomp" (a prec)) |
| 203 | (declare-function math-comp-width "calccomp" (c)) |
| 204 | (declare-function math-composition-to-string "calccomp" (c &optional width)) |
| 205 | (declare-function math-stack-value-offset-fancy "calccomp" ()) |
| 206 | (declare-function math-format-flat-expr-fancy "calc-ext" (a prec)) |
| 207 | (declare-function math-adjust-fraction "calc-ext" (a)) |
| 208 | (declare-function math-format-binary "calc-bin" (a)) |
| 209 | (declare-function math-format-radix "calc-bin" (a)) |
| 210 | (declare-function math-format-twos-complement "calc-bin" (a)) |
| 211 | (declare-function math-group-float "calc-ext" (str)) |
| 212 | (declare-function math-mod "calc-misc" (a b)) |
| 213 | (declare-function math-format-number-fancy "calc-ext" (a prec)) |
| 214 | (declare-function math-format-bignum-fancy "calc-ext" (a)) |
| 215 | (declare-function math-read-number-fancy "calc-ext" (s)) |
| 216 | (declare-function calc-do-grab-region "calc-yank" (top bot arg)) |
| 217 | (declare-function calc-do-grab-rectangle "calc-yank" (top bot arg &optional reduce)) |
| 218 | (declare-function calc-do-embedded "calc-embed" (calc-embed-arg end obeg oend)) |
| 219 | (declare-function calc-do-embedded-activate "calc-embed" (calc-embed-arg cbuf)) |
| 220 | (declare-function math-do-defmath "calc-prog" (func args body)) |
| 221 | (declare-function calc-load-everything "calc-ext" ()) |
| 222 | |
| 223 | |
| 224 | (defgroup calc nil |
| 225 | "GNU Calc." |
| 226 | :prefix "calc-" |
| 227 | :tag "Calc" |
| 228 | :group 'applications) |
| 229 | |
| 230 | ;; Do not autoload, so it is evaluated at run-time rather than at dump time. |
| 231 | ;; ;;;###autoload |
| 232 | (defcustom calc-settings-file |
| 233 | (locate-user-emacs-file "calc.el" ".calc.el") |
| 234 | "File in which to record permanent settings." |
| 235 | :group 'calc |
| 236 | :type '(file)) |
| 237 | |
| 238 | (defcustom calc-language-alist |
| 239 | '((latex-mode . latex) |
| 240 | (tex-mode . tex) |
| 241 | (plain-tex-mode . tex) |
| 242 | (context-mode . tex) |
| 243 | (nroff-mode . eqn) |
| 244 | (pascal-mode . pascal) |
| 245 | (c-mode . c) |
| 246 | (c++-mode . c) |
| 247 | (fortran-mode . fortran) |
| 248 | (f90-mode . fortran) |
| 249 | (texinfo-mode . calc-normal-language)) |
| 250 | "Alist of major modes with appropriate Calc languages." |
| 251 | :group 'calc |
| 252 | :type '(alist :key-type (symbol :tag "Major mode") |
| 253 | :value-type (symbol :tag "Calc language"))) |
| 254 | |
| 255 | (defcustom calc-embedded-announce-formula |
| 256 | "%Embed\n\\(% .*\n\\)*" |
| 257 | "A regular expression which is sure to be followed by a calc-embedded formula." |
| 258 | :group 'calc |
| 259 | :type '(regexp)) |
| 260 | |
| 261 | (defcustom calc-embedded-announce-formula-alist |
| 262 | '((c++-mode . "//Embed\n\\(// .*\n\\)*") |
| 263 | (c-mode . "/\\*Embed\\*/\n\\(/\\* .*\\*/\n\\)*") |
| 264 | (f90-mode . "!Embed\n\\(! .*\n\\)*") |
| 265 | (fortran-mode . "C Embed\n\\(C .*\n\\)*") |
| 266 | (html-helper-mode . "<!-- Embed -->\n\\(<!-- .* -->\n\\)*") |
| 267 | (html-mode . "<!-- Embed -->\n\\(<!-- .* -->\n\\)*") |
| 268 | (nroff-mode . "\\\\\"Embed\n\\(\\\\\" .*\n\\)*") |
| 269 | (pascal-mode . "{Embed}\n\\({.*}\n\\)*") |
| 270 | (sgml-mode . "<!-- Embed -->\n\\(<!-- .* -->\n\\)*") |
| 271 | (xml-mode . "<!-- Embed -->\n\\(<!-- .* -->\n\\)*") |
| 272 | (texinfo-mode . "@c Embed\n\\(@c .*\n\\)*")) |
| 273 | "Alist of major modes with appropriate values for `calc-embedded-announce-formula'." |
| 274 | :group 'calc |
| 275 | :type '(alist :key-type (symbol :tag "Major mode") |
| 276 | :value-type (regexp :tag "Regexp to announce formula"))) |
| 277 | |
| 278 | (defcustom calc-embedded-open-formula |
| 279 | "\\`\\|^\n\\|\\$\\$?\\|\\\\\\[\\|^\\\\begin[^{].*\n\\|^\\\\begin{.*[^x]}.*\n\\|^@.*\n\\|^\\.EQ.*\n\\|\\\\(\\|^%\n\\|^\\.\\\\\"\n" |
| 280 | "A regular expression for the opening delimiter of a formula used by calc-embedded." |
| 281 | :group 'calc |
| 282 | :type '(regexp)) |
| 283 | |
| 284 | (defcustom calc-embedded-close-formula |
| 285 | "\\'\\|\n$\\|\\$\\$?\\|\\\\]\\|^\\\\end[^{].*\n\\|^\\\\end{.*[^x]}.*\n\\|^@.*\n\\|^\\.EN.*\n\\|\\\\)\\|\n%\n\\|^\\.\\\\\"\n" |
| 286 | "A regular expression for the closing delimiter of a formula used by calc-embedded." |
| 287 | :group 'calc |
| 288 | :type '(regexp)) |
| 289 | |
| 290 | (defcustom calc-embedded-open-close-formula-alist |
| 291 | nil |
| 292 | "Alist of major modes with pairs of formula delimiters used by calc-embedded." |
| 293 | :group 'calc |
| 294 | :type '(alist :key-type (symbol :tag "Major mode") |
| 295 | :value-type (list (regexp :tag "Opening formula delimiter") |
| 296 | (regexp :tag "Closing formula delimiter")))) |
| 297 | |
| 298 | (defcustom calc-embedded-word-regexp |
| 299 | "[-+]?[0-9]+\\(\\.[0-9]+\\)?\\([eE][-+]?[0-9]+\\)?" |
| 300 | "A regular expression determining a word for calc-embedded-word." |
| 301 | :group 'calc |
| 302 | :type '(regexp)) |
| 303 | |
| 304 | (defcustom calc-embedded-word-regexp-alist |
| 305 | nil |
| 306 | "Alist of major modes with word regexps used by calc-embedded-word." |
| 307 | :group 'calc |
| 308 | :type '(alist :key-type (symbol :tag "Major mode") |
| 309 | :value-type (regexp :tag "Regexp for word"))) |
| 310 | |
| 311 | (defcustom calc-embedded-open-plain |
| 312 | "%%% " |
| 313 | "A string which is the opening delimiter for a \"plain\" formula. |
| 314 | If calc-show-plain mode is enabled, this is inserted at the front of |
| 315 | each formula." |
| 316 | :group 'calc |
| 317 | :type '(string)) |
| 318 | |
| 319 | (defcustom calc-embedded-close-plain |
| 320 | " %%%\n" |
| 321 | "A string which is the closing delimiter for a \"plain\" formula. |
| 322 | See calc-embedded-open-plain." |
| 323 | :group 'calc |
| 324 | :type '(string)) |
| 325 | |
| 326 | (defcustom calc-embedded-open-close-plain-alist |
| 327 | '((c++-mode "// %% " " %%\n") |
| 328 | (c-mode "/* %% " " %% */\n") |
| 329 | (f90-mode "! %% " " %%\n") |
| 330 | (fortran-mode "C %% " " %%\n") |
| 331 | (html-helper-mode "<!-- %% " " %% -->\n") |
| 332 | (html-mode "<!-- %% " " %% -->\n") |
| 333 | (nroff-mode "\\\" %% " " %%\n") |
| 334 | (pascal-mode "{%% " " %%}\n") |
| 335 | (sgml-mode "<!-- %% " " %% -->\n") |
| 336 | (xml-mode "<!-- %% " " %% -->\n") |
| 337 | (texinfo-mode "@c %% " " %%\n")) |
| 338 | "Alist of major modes with pairs of delimiters for \"plain\" formulas." |
| 339 | :group 'calc |
| 340 | :type '(alist :key-type (symbol :tag "Major mode") |
| 341 | :value-type (list (string :tag "Opening \"plain\" delimiter") |
| 342 | (string :tag "Closing \"plain\" delimiter")))) |
| 343 | |
| 344 | (defcustom calc-embedded-open-new-formula |
| 345 | "\n\n" |
| 346 | "A string which is inserted at front of formula by calc-embedded-new-formula." |
| 347 | :group 'calc |
| 348 | :type '(string)) |
| 349 | |
| 350 | (defcustom calc-embedded-close-new-formula |
| 351 | "\n\n" |
| 352 | "A string which is inserted at end of formula by calc-embedded-new-formula." |
| 353 | :group 'calc |
| 354 | :type '(string)) |
| 355 | |
| 356 | (defcustom calc-embedded-open-close-new-formula-alist |
| 357 | nil |
| 358 | "Alist of major modes with pairs of new formula delimiters used by calc-embedded." |
| 359 | :group 'calc |
| 360 | :type '(alist :key-type (symbol :tag "Major mode") |
| 361 | :value-type (list (string :tag "Opening new formula delimiter") |
| 362 | (string :tag "Closing new formula delimiter")))) |
| 363 | |
| 364 | (defcustom calc-embedded-open-mode |
| 365 | "% " |
| 366 | "A string which should precede calc-embedded mode annotations. |
| 367 | This is not required to be present for user-written mode annotations." |
| 368 | :group 'calc |
| 369 | :type '(string)) |
| 370 | |
| 371 | (defcustom calc-embedded-close-mode |
| 372 | "\n" |
| 373 | "A string which should follow calc-embedded mode annotations. |
| 374 | This is not required to be present for user-written mode annotations." |
| 375 | :group 'calc |
| 376 | :type '(string)) |
| 377 | |
| 378 | (defcustom calc-embedded-open-close-mode-alist |
| 379 | '((c++-mode "// " "\n") |
| 380 | (c-mode "/* " " */\n") |
| 381 | (f90-mode "! " "\n") |
| 382 | (fortran-mode "C " "\n") |
| 383 | (html-helper-mode "<!-- " " -->\n") |
| 384 | (html-mode "<!-- " " -->\n") |
| 385 | (nroff-mode "\\\" " "\n") |
| 386 | (pascal-mode "{ " " }\n") |
| 387 | (sgml-mode "<!-- " " -->\n") |
| 388 | (xml-mode "<!-- " " -->\n") |
| 389 | (texinfo-mode "@c " "\n")) |
| 390 | "Alist of major modes with pairs of strings to delimit annotations." |
| 391 | :group 'calc |
| 392 | :type '(alist :key-type (symbol :tag "Major mode") |
| 393 | :value-type (list (string :tag "Opening annotation delimiter") |
| 394 | (string :tag "Closing annotation delimiter")))) |
| 395 | |
| 396 | (defcustom calc-gnuplot-name |
| 397 | (if (eq system-type 'windows-nt) "pgnuplot" "gnuplot") |
| 398 | "Name of GNUPLOT program, for calc-graph features." |
| 399 | :group 'calc |
| 400 | :type '(string)) |
| 401 | |
| 402 | (defcustom calc-gnuplot-plot-command |
| 403 | nil |
| 404 | "Name of command for displaying GNUPLOT output; %s = file name to print." |
| 405 | :group 'calc |
| 406 | :type '(choice (string) (sexp))) |
| 407 | |
| 408 | (defcustom calc-gnuplot-print-command |
| 409 | "lp %s" |
| 410 | "Name of command for printing GNUPLOT output; %s = file name to print." |
| 411 | :group 'calc |
| 412 | :type '(choice (string) (sexp))) |
| 413 | |
| 414 | (defcustom calc-multiplication-has-precedence |
| 415 | t |
| 416 | "If non-nil, multiplication has precedence over division |
| 417 | in normal mode." |
| 418 | :group 'calc |
| 419 | :type 'boolean) |
| 420 | |
| 421 | (defcustom calc-undo-length |
| 422 | 100 |
| 423 | "The number of undo steps that will be preserved when Calc is quit." |
| 424 | :group 'calc |
| 425 | :type 'integer) |
| 426 | |
| 427 | (defcustom calc-highlight-selections-with-faces |
| 428 | nil |
| 429 | "If non-nil, use a separate face to indicate selected sub-formulas. |
| 430 | If `calc-show-selections' is non-nil, then selected sub-formulas are shown |
| 431 | by displaying the rest of the formula in `calc-nonselected-face'. |
| 432 | If `calc-show-selections' is nil, then selected sub-formulas are shown |
| 433 | by displaying the sub-formula in `calc-selected-face'." |
| 434 | :version "24.1" |
| 435 | :group 'calc |
| 436 | :type 'boolean) |
| 437 | |
| 438 | (defcustom calc-lu-field-reference |
| 439 | "20 uPa" |
| 440 | "The default reference level for logarithmic units (field)." |
| 441 | :version "24.1" |
| 442 | :group 'calc |
| 443 | :type '(string)) |
| 444 | |
| 445 | (defcustom calc-lu-power-reference |
| 446 | "mW" |
| 447 | "The default reference level for logarithmic units (power)." |
| 448 | :version "24.1" |
| 449 | :group 'calc |
| 450 | :type '(string)) |
| 451 | |
| 452 | (defcustom calc-note-threshold "1" |
| 453 | "The number of cents that a frequency should be near a note |
| 454 | to be identified as that note." |
| 455 | :version "24.1" |
| 456 | :type 'string |
| 457 | :group 'calc) |
| 458 | |
| 459 | (defface calc-nonselected-face |
| 460 | '((t :inherit shadow |
| 461 | :slant italic)) |
| 462 | "Face used to show the non-selected portion of a formula." |
| 463 | :group 'calc) |
| 464 | |
| 465 | (defface calc-selected-face |
| 466 | '((t :weight bold)) |
| 467 | "Face used to show the selected portion of a formula." |
| 468 | :group 'calc) |
| 469 | |
| 470 | (defvar calc-bug-address "jay.p.belanger@gmail.com" |
| 471 | "Address of the maintainer of Calc, for use by `report-calc-bug'.") |
| 472 | |
| 473 | (defvar calc-scan-for-dels t |
| 474 | "If t, scan keymaps to find all DEL-like keys. |
| 475 | if nil, only DEL itself is mapped to calc-pop.") |
| 476 | |
| 477 | (defvar calc-stack '((top-of-stack 1 nil)) |
| 478 | "Calculator stack. |
| 479 | Entries are 3-lists: Formula, Height (in lines), Selection (or nil).") |
| 480 | |
| 481 | (defvar calc-stack-top 1 |
| 482 | "Index into `calc-stack' of \"top\" of stack. |
| 483 | This is 1 unless `calc-truncate-stack' has been used.") |
| 484 | |
| 485 | (defvar calc-display-sci-high 0 |
| 486 | "Floating-point numbers with this positive exponent or higher above the |
| 487 | current precision are displayed in scientific notation in calc-mode.") |
| 488 | |
| 489 | (defvar calc-display-sci-low -3 |
| 490 | "Floating-point numbers with this negative exponent or lower are displayed |
| 491 | scientific notation in calc-mode.") |
| 492 | |
| 493 | (defvar calc-other-modes nil |
| 494 | "List of used-defined strings to append to Calculator mode line.") |
| 495 | |
| 496 | (defvar calc-Y-help-msgs nil |
| 497 | "List of strings for Y prefix help.") |
| 498 | |
| 499 | (defvar calc-loaded-settings-file nil |
| 500 | "t if `calc-settings-file' has been loaded yet.") |
| 501 | |
| 502 | |
| 503 | (defvar calc-mode-var-list '() |
| 504 | "List of variables used in customizing GNU Calc.") |
| 505 | |
| 506 | (defmacro defcalcmodevar (var defval &optional doc) |
| 507 | "Declare VAR as a Calc variable, with default value DEFVAL |
| 508 | and doc-string DOC. |
| 509 | The variable VAR will be added to `calc-mode-var-list'." |
| 510 | `(progn |
| 511 | (defvar ,var ,defval ,doc) |
| 512 | (add-to-list 'calc-mode-var-list (list (quote ,var) ,defval)))) |
| 513 | |
| 514 | (defun calc-mode-var-list-restore-default-values () |
| 515 | "Restore the default values of the variables in `calc-mode-var-list'." |
| 516 | (mapcar (function (lambda (v) (set (car v) (nth 1 v)))) |
| 517 | calc-mode-var-list)) |
| 518 | |
| 519 | (defun calc-mode-var-list-restore-saved-values () |
| 520 | "Restore the user-saved values of the variables in `calc-mode-var-list'." |
| 521 | (let ((newvarlist '())) |
| 522 | (save-excursion |
| 523 | (let (pos |
| 524 | (file (substitute-in-file-name calc-settings-file))) |
| 525 | (when (and |
| 526 | (file-regular-p file) |
| 527 | (set-buffer (find-file-noselect file)) |
| 528 | (goto-char (point-min)) |
| 529 | (search-forward ";;; Mode settings stored by Calc" nil t) |
| 530 | (progn |
| 531 | (forward-line 1) |
| 532 | (setq pos (point)) |
| 533 | (search-forward "\n;;; End of mode settings" nil t))) |
| 534 | (beginning-of-line) |
| 535 | (calc-mode-var-list-restore-default-values) |
| 536 | (eval-region pos (point)) |
| 537 | (let ((varlist calc-mode-var-list)) |
| 538 | (while varlist |
| 539 | (let ((var (car varlist))) |
| 540 | (setq newvarlist |
| 541 | (cons (list (car var) (symbol-value (car var))) |
| 542 | newvarlist))) |
| 543 | (setq varlist (cdr varlist))))))) |
| 544 | (if newvarlist |
| 545 | (mapcar (function (lambda (v) (set (car v) (nth 1 v)))) |
| 546 | newvarlist) |
| 547 | (calc-mode-var-list-restore-default-values)))) |
| 548 | |
| 549 | (defcalcmodevar calc-always-load-extensions nil |
| 550 | "If non-nil, load the calc-ext module automatically when Calc is loaded.") |
| 551 | |
| 552 | (defcalcmodevar calc-line-numbering t |
| 553 | "If non-nil, display line numbers in Calculator stack.") |
| 554 | |
| 555 | (defcalcmodevar calc-line-breaking t |
| 556 | "If non-nil, break long values across multiple lines in Calculator stack.") |
| 557 | |
| 558 | (defcalcmodevar calc-display-just nil |
| 559 | "If nil, stack display is left-justified. |
| 560 | If `right', stack display is right-justified. |
| 561 | If `center', stack display is centered.") |
| 562 | |
| 563 | (defcalcmodevar calc-display-origin nil |
| 564 | "Horizontal origin of displayed stack entries. |
| 565 | In left-justified mode, this is effectively indentation. (Default 0). |
| 566 | In right-justified mode, this is effectively window width. |
| 567 | In centered mode, center of stack entry is placed here.") |
| 568 | |
| 569 | (defcalcmodevar calc-number-radix 10 |
| 570 | "Radix for entry and display of numbers in calc-mode, 2-36.") |
| 571 | |
| 572 | (defcalcmodevar calc-leading-zeros nil |
| 573 | "If non-nil, leading zeros are provided to pad integers to calc-word-size.") |
| 574 | |
| 575 | (defcalcmodevar calc-group-digits nil |
| 576 | "If non-nil, group digits in large displayed integers by inserting spaces. |
| 577 | If an integer, group that many digits at a time. |
| 578 | If t, use 4 for binary and hex, 3 otherwise.") |
| 579 | |
| 580 | (defcalcmodevar calc-group-char "," |
| 581 | "The character (in the form of a string) to be used for grouping digits. |
| 582 | This is used only when calc-group-digits mode is on.") |
| 583 | |
| 584 | (defcalcmodevar calc-point-char "." |
| 585 | "The character (in the form of a string) to be used as a decimal point.") |
| 586 | |
| 587 | (defcalcmodevar calc-frac-format '(":" nil) |
| 588 | "Format of displayed fractions; a string of one or two of \":\" or \"/\".") |
| 589 | |
| 590 | (defcalcmodevar calc-prefer-frac nil |
| 591 | "If non-nil, prefer fractional over floating-point results.") |
| 592 | |
| 593 | (defcalcmodevar calc-hms-format "%s@ %s' %s\"" |
| 594 | "Format of displayed hours-minutes-seconds angles, a format string. |
| 595 | String must contain three %s marks for hours, minutes, seconds respectively.") |
| 596 | |
| 597 | (defcalcmodevar calc-date-format '((H ":" mm C SS pp " ") |
| 598 | Www " " Mmm " " D ", " YYYY) |
| 599 | "Format of displayed date forms.") |
| 600 | |
| 601 | (defcalcmodevar calc-float-format '(float 0) |
| 602 | "Format to use for display of floating-point numbers in calc-mode. |
| 603 | Must be a list of one of the following forms: |
| 604 | (float 0) Floating point format, display full precision. |
| 605 | (float N) N > 0: Floating point format, at most N significant figures. |
| 606 | (float -N) -N < 0: Floating point format, calc-internal-prec - N figs. |
| 607 | (fix N) N >= 0: Fixed point format, N places after decimal point. |
| 608 | (sci 0) Scientific notation, full precision. |
| 609 | (sci N) N > 0: Scientific notation, N significant figures. |
| 610 | (sci -N) -N < 0: Scientific notation, calc-internal-prec - N figs. |
| 611 | (eng 0) Engineering notation, full precision. |
| 612 | (eng N) N > 0: Engineering notation, N significant figures. |
| 613 | (eng -N) -N < 0: Engineering notation, calc-internal-prec - N figs.") |
| 614 | |
| 615 | (defcalcmodevar calc-full-float-format '(float 0) |
| 616 | "Format to use when full precision must be displayed.") |
| 617 | |
| 618 | (defcalcmodevar calc-complex-format nil |
| 619 | "Format to use for display of complex numbers in calc-mode. Must be one of: |
| 620 | nil Use (x, y) form. |
| 621 | i Use x + yi form. |
| 622 | j Use x + yj form.") |
| 623 | |
| 624 | (defcalcmodevar calc-complex-mode 'cplx |
| 625 | "Preferred form, either `cplx' or `polar', for complex numbers.") |
| 626 | |
| 627 | (defcalcmodevar calc-infinite-mode nil |
| 628 | "If nil, 1 / 0 is left unsimplified. |
| 629 | If 0, 1 / 0 is changed to inf (zeros are considered positive). |
| 630 | Otherwise, 1 / 0 is changed to uinf (undirected infinity).") |
| 631 | |
| 632 | (defcalcmodevar calc-display-strings nil |
| 633 | "If non-nil, display vectors of byte-sized integers as strings.") |
| 634 | |
| 635 | (defcalcmodevar calc-matrix-just 'center |
| 636 | "If nil, vector elements are left-justified. |
| 637 | If `right', vector elements are right-justified. |
| 638 | If `center', vector elements are centered.") |
| 639 | |
| 640 | (defcalcmodevar calc-break-vectors nil |
| 641 | "If non-nil, display vectors one element per line.") |
| 642 | |
| 643 | (defcalcmodevar calc-full-vectors t |
| 644 | "If non-nil, display long vectors in full. If nil, use abbreviated form.") |
| 645 | |
| 646 | (defcalcmodevar calc-full-trail-vectors t |
| 647 | "If non-nil, display long vectors in full in the trail.") |
| 648 | |
| 649 | (defcalcmodevar calc-vector-commas "," |
| 650 | "If non-nil, separate elements of displayed vectors with this string.") |
| 651 | |
| 652 | (defcalcmodevar calc-vector-brackets "[]" |
| 653 | "If non-nil, surround displayed vectors with these characters.") |
| 654 | |
| 655 | (defcalcmodevar calc-matrix-brackets '(R O) |
| 656 | "A list of code-letter symbols that control \"big\" matrix display. |
| 657 | If `R' is present, display inner brackets for matrices. |
| 658 | If `O' is present, display outer brackets for matrices (above/below). |
| 659 | If `C' is present, display outer brackets for matrices (centered).") |
| 660 | |
| 661 | (defcalcmodevar calc-language nil |
| 662 | "Language or format for entry and display of stack values. Must be one of: |
| 663 | nil Use standard Calc notation. |
| 664 | flat Use standard Calc notation, one-line format. |
| 665 | big Display formulas in 2-d notation (enter w/std notation). |
| 666 | unform Use unformatted display: add(a, mul(b,c)). |
| 667 | c Use C language notation. |
| 668 | pascal Use Pascal language notation. |
| 669 | fortran Use Fortran language notation. |
| 670 | tex Use TeX notation. |
| 671 | latex Use LaTeX notation. |
| 672 | eqn Use eqn notation. |
| 673 | yacas Use Yacas notation. |
| 674 | maxima Use Maxima notation. |
| 675 | giac Use Giac notation. |
| 676 | math Use Mathematica(tm) notation. |
| 677 | maple Use Maple notation.") |
| 678 | |
| 679 | (defcalcmodevar calc-language-option nil |
| 680 | "Numeric prefix argument for the command that set `calc-language'.") |
| 681 | |
| 682 | (defcalcmodevar calc-left-label "" |
| 683 | "Label to display at left of formula.") |
| 684 | |
| 685 | (defcalcmodevar calc-right-label "" |
| 686 | "Label to display at right of formula.") |
| 687 | |
| 688 | (defcalcmodevar calc-word-size 32 |
| 689 | "Minimum number of bits per word, if any, for binary operations in calc-mode.") |
| 690 | |
| 691 | (defcalcmodevar calc-previous-modulo nil |
| 692 | "Most recently used value of M in a modulo form.") |
| 693 | |
| 694 | (defcalcmodevar calc-simplify-mode nil |
| 695 | "Type of simplification applied to results. |
| 696 | If `none', results are not simplified when pushed on the stack. |
| 697 | If `num', functions are simplified only when args are constant. |
| 698 | If nil, only fast simplifications are applied. |
| 699 | If `binary', `math-clip' is applied if appropriate. |
| 700 | If `alg', `math-simplify' is applied. |
| 701 | If `ext', `math-simplify-extended' is applied. |
| 702 | If `units', `math-simplify-units' is applied.") |
| 703 | |
| 704 | (defcalcmodevar calc-auto-recompute t |
| 705 | "If non-nil, recompute evalto's automatically when necessary.") |
| 706 | |
| 707 | (defcalcmodevar calc-display-raw nil |
| 708 | "If non-nil, display shows unformatted Lisp exprs. (For debugging)") |
| 709 | |
| 710 | (defcalcmodevar calc-internal-prec 12 |
| 711 | "Number of digits of internal precision for calc-mode calculations.") |
| 712 | |
| 713 | (defcalcmodevar calc-angle-mode 'deg |
| 714 | "If deg, angles are in degrees; if rad, angles are in radians. |
| 715 | If hms, angles are in degrees-minutes-seconds.") |
| 716 | |
| 717 | (defcalcmodevar calc-algebraic-mode nil |
| 718 | "If non-nil, numeric entry accepts whole algebraic expressions. |
| 719 | If nil, algebraic expressions must be preceded by \"'\".") |
| 720 | |
| 721 | (defcalcmodevar calc-incomplete-algebraic-mode nil |
| 722 | "Like calc-algebraic-mode except only affects ( and [ keys.") |
| 723 | |
| 724 | (defcalcmodevar calc-symbolic-mode nil |
| 725 | "If non-nil, inexact numeric computations like sqrt(2) are postponed. |
| 726 | If nil, computations on numbers always yield numbers where possible.") |
| 727 | |
| 728 | (defcalcmodevar calc-matrix-mode nil |
| 729 | "If `matrix', variables are assumed to be matrix-valued. |
| 730 | If a number, variables are assumed to be NxN matrices. |
| 731 | If `sqmatrix', variables are assumed to be square matrices of an unspecified size. |
| 732 | If `scalar', variables are assumed to be scalar-valued. |
| 733 | If nil, symbolic math routines make no assumptions about variables.") |
| 734 | |
| 735 | (defcalcmodevar calc-twos-complement-mode nil |
| 736 | "If non-nil, display integers in two's complement mode.") |
| 737 | |
| 738 | |
| 739 | (defcalcmodevar calc-shift-prefix nil |
| 740 | "If non-nil, shifted letter keys are prefix keys rather than normal meanings.") |
| 741 | |
| 742 | (defcalcmodevar calc-window-height 7 |
| 743 | "Initial height of Calculator window.") |
| 744 | |
| 745 | (defcalcmodevar calc-display-trail t |
| 746 | "If non-nil, M-x calc creates a window to display Calculator trail.") |
| 747 | |
| 748 | (defcalcmodevar calc-show-selections t |
| 749 | "If non-nil, selected sub-formulas are shown by obscuring rest of formula. |
| 750 | If nil, selected sub-formulas are highlighted by obscuring the sub-formulas.") |
| 751 | |
| 752 | (defcalcmodevar calc-use-selections t |
| 753 | "If non-nil, commands operate only on selected portions of formulas. |
| 754 | If nil, selections displayed but ignored.") |
| 755 | |
| 756 | (defcalcmodevar calc-assoc-selections t |
| 757 | "If non-nil, selection hides deep structure of associative formulas.") |
| 758 | |
| 759 | (defcalcmodevar calc-display-working-message 'lots |
| 760 | "If non-nil, display \"Working...\" for potentially slow Calculator commands.") |
| 761 | |
| 762 | (defcalcmodevar calc-auto-why 'maybe |
| 763 | "If non-nil, automatically execute a \"why\" command to explain odd results.") |
| 764 | |
| 765 | (defcalcmodevar calc-timing nil |
| 766 | "If non-nil, display timing information on each slow command.") |
| 767 | |
| 768 | (defcalcmodevar calc-mode-save-mode 'local) |
| 769 | |
| 770 | (defcalcmodevar calc-standard-date-formats |
| 771 | '("N" |
| 772 | "<H:mm:SSpp >Www Mmm D, YYYY" |
| 773 | "D Mmm YYYY<, h:mm:SS>" |
| 774 | "Www Mmm BD< hh:mm:ss> YYYY" |
| 775 | "M/D/Y< H:mm:SSpp>" |
| 776 | "D.M.Y< h:mm:SS>" |
| 777 | "M-D-Y< H:mm:SSpp>" |
| 778 | "D-M-Y< h:mm:SS>" |
| 779 | "j<, h:mm:SS>" |
| 780 | "YYddd< hh:mm:ss>")) |
| 781 | |
| 782 | (defcalcmodevar calc-autorange-units nil |
| 783 | "If non-nil, automatically set unit prefixes to keep units in a reasonable range.") |
| 784 | |
| 785 | (defcalcmodevar calc-was-keypad-mode nil |
| 786 | "Non-nil if Calc was last invoked in keypad mode.") |
| 787 | |
| 788 | (defcalcmodevar calc-full-mode nil |
| 789 | "Non-nil if Calc was last invoked in full-screen mode.") |
| 790 | |
| 791 | (defcalcmodevar calc-user-parse-tables nil |
| 792 | "Alist of languages with user-defined parse rules.") |
| 793 | |
| 794 | (defcalcmodevar calc-gnuplot-default-device "default" |
| 795 | "The default device name for GNUPLOT plotting.") |
| 796 | |
| 797 | (defcalcmodevar calc-gnuplot-default-output "STDOUT" |
| 798 | "The default output file for GNUPLOT plotting.") |
| 799 | |
| 800 | (defcalcmodevar calc-gnuplot-print-device "postscript" |
| 801 | "The default device name for GNUPLOT printing.") |
| 802 | |
| 803 | (defcalcmodevar calc-gnuplot-print-output "auto" |
| 804 | "The default output for GNUPLOT printing.") |
| 805 | |
| 806 | (defcalcmodevar calc-gnuplot-geometry nil |
| 807 | "The default geometry for the GNUPLOT window.") |
| 808 | |
| 809 | (defcalcmodevar calc-graph-default-resolution 15 |
| 810 | "The default number of data points when plotting curves.") |
| 811 | |
| 812 | (defcalcmodevar calc-graph-default-resolution-3d 5 |
| 813 | "The default number of x- and y- data points when plotting surfaces.") |
| 814 | |
| 815 | (defcalcmodevar calc-invocation-macro nil |
| 816 | "A user defined macro for starting Calc. |
| 817 | Used by `calc-user-invocation'.") |
| 818 | |
| 819 | (defcalcmodevar calc-show-banner t |
| 820 | "*If non-nil, show a friendly greeting above the stack.") |
| 821 | |
| 822 | (defconst calc-local-var-list '(calc-stack |
| 823 | calc-stack-top |
| 824 | calc-undo-list |
| 825 | calc-redo-list |
| 826 | calc-always-load-extensions |
| 827 | calc-mode-save-mode |
| 828 | calc-display-raw |
| 829 | calc-line-numbering |
| 830 | calc-line-breaking |
| 831 | calc-display-just |
| 832 | calc-display-origin |
| 833 | calc-left-label |
| 834 | calc-right-label |
| 835 | calc-auto-why |
| 836 | calc-algebraic-mode |
| 837 | calc-incomplete-algebraic-mode |
| 838 | calc-symbolic-mode |
| 839 | calc-matrix-mode |
| 840 | calc-inverse-flag |
| 841 | calc-hyperbolic-flag |
| 842 | calc-option-flag |
| 843 | calc-keep-args-flag |
| 844 | calc-angle-mode |
| 845 | calc-number-radix |
| 846 | calc-leading-zeros |
| 847 | calc-group-digits |
| 848 | calc-group-char |
| 849 | calc-point-char |
| 850 | calc-frac-format |
| 851 | calc-prefer-frac |
| 852 | calc-hms-format |
| 853 | calc-date-format |
| 854 | calc-standard-date-formats |
| 855 | calc-float-format |
| 856 | calc-full-float-format |
| 857 | calc-complex-format |
| 858 | calc-matrix-just |
| 859 | calc-full-vectors |
| 860 | calc-full-trail-vectors |
| 861 | calc-break-vectors |
| 862 | calc-vector-commas |
| 863 | calc-vector-brackets |
| 864 | calc-matrix-brackets |
| 865 | calc-complex-mode |
| 866 | calc-infinite-mode |
| 867 | calc-display-strings |
| 868 | calc-simplify-mode |
| 869 | calc-auto-recompute |
| 870 | calc-autorange-units |
| 871 | calc-show-plain |
| 872 | calc-show-selections |
| 873 | calc-use-selections |
| 874 | calc-assoc-selections |
| 875 | calc-word-size |
| 876 | calc-internal-prec)) |
| 877 | |
| 878 | (defvar calc-mode-hook nil |
| 879 | "Hook run when entering calc-mode.") |
| 880 | |
| 881 | (defvar calc-trail-mode-hook nil |
| 882 | "Hook run when entering calc-trail-mode.") |
| 883 | |
| 884 | (defvar calc-start-hook nil |
| 885 | "Hook run when calc is started.") |
| 886 | |
| 887 | (defvar calc-end-hook nil |
| 888 | "Hook run when calc is quit.") |
| 889 | |
| 890 | (defvar calc-load-hook nil |
| 891 | "Hook run when calc.el is loaded.") |
| 892 | |
| 893 | (defvar calc-window-hook nil |
| 894 | "Hook called to create the Calc window.") |
| 895 | |
| 896 | (defvar calc-trail-window-hook nil |
| 897 | "Hook called to create the Calc trail window.") |
| 898 | |
| 899 | (defvar calc-embedded-new-buffer-hook nil |
| 900 | "Hook run when starting embedded mode in a new buffer.") |
| 901 | |
| 902 | (defvar calc-embedded-new-formula-hook nil |
| 903 | "Hook run when starting embedded mode in a new formula.") |
| 904 | |
| 905 | (defvar calc-embedded-mode-hook nil |
| 906 | "Hook run when starting embedded mode.") |
| 907 | |
| 908 | ;; Set up the autoloading linkage. |
| 909 | (let ((name (and (fboundp 'calc-dispatch) |
| 910 | (eq (car-safe (symbol-function 'calc-dispatch)) 'autoload) |
| 911 | (nth 1 (symbol-function 'calc-dispatch)))) |
| 912 | (p load-path)) |
| 913 | |
| 914 | ;; If Calc files exist on the load-path, we're all set. |
| 915 | (while (and p (not (file-exists-p |
| 916 | (expand-file-name "calc-misc.elc" (car p))))) |
| 917 | (setq p (cdr p))) |
| 918 | (or p |
| 919 | |
| 920 | ;; If Calc is autoloaded using a path name, look there for Calc files. |
| 921 | ;; This works for both relative ("calc/calc.elc") and absolute paths. |
| 922 | (and name (file-name-directory name) |
| 923 | (let ((p2 load-path) |
| 924 | (name2 (concat (file-name-directory name) |
| 925 | "calc-misc.elc"))) |
| 926 | (while (and p2 (not (file-exists-p |
| 927 | (expand-file-name name2 (car p2))))) |
| 928 | (setq p2 (cdr p2))) |
| 929 | (when p2 |
| 930 | (setq load-path (nconc load-path |
| 931 | (list |
| 932 | (directory-file-name |
| 933 | (file-name-directory |
| 934 | (expand-file-name |
| 935 | name (car p2)))))))))))) |
| 936 | |
| 937 | ;; The following modes use specially-formatted data. |
| 938 | (put 'calc-mode 'mode-class 'special) |
| 939 | (put 'calc-trail-mode 'mode-class 'special) |
| 940 | |
| 941 | ;; Define "inexact-result" as an e-lisp error symbol. |
| 942 | (put 'inexact-result 'error-conditions '(error inexact-result calc-error)) |
| 943 | (put 'inexact-result 'error-message "Calc internal error (inexact-result)") |
| 944 | |
| 945 | ;; Define "math-overflow" and "math-underflow" as e-lisp error symbols. |
| 946 | (put 'math-overflow 'error-conditions '(error math-overflow calc-error)) |
| 947 | (put 'math-overflow 'error-message "Floating-point overflow occurred") |
| 948 | (put 'math-underflow 'error-conditions '(error math-underflow calc-error)) |
| 949 | (put 'math-underflow 'error-message "Floating-point underflow occurred") |
| 950 | |
| 951 | (defvar calc-trail-pointer nil |
| 952 | "The \"current\" entry in trail buffer.") |
| 953 | (defvar calc-trail-overlay nil |
| 954 | "The value of overlay-arrow-string.") |
| 955 | (defvar calc-undo-list nil |
| 956 | "The list of previous operations for undo.") |
| 957 | (defvar calc-redo-list nil |
| 958 | "The list of recent undo operations.") |
| 959 | (defvar calc-main-buffer nil |
| 960 | "A pointer to Calculator buffer.") |
| 961 | (defvar calc-buffer-list nil |
| 962 | "A list of all Calc buffers.") |
| 963 | (defvar calc-trail-buffer nil |
| 964 | "A pointer to Calc Trail buffer.") |
| 965 | (defvar calc-why nil |
| 966 | "Explanations of most recent errors.") |
| 967 | (defvar calc-next-why nil) |
| 968 | (defvar calc-inverse-flag nil |
| 969 | "If non-nil, next operation is Inverse.") |
| 970 | (defvar calc-hyperbolic-flag nil |
| 971 | "If non-nil, next operation is Hyperbolic.") |
| 972 | (defvar calc-option-flag nil |
| 973 | "If non-nil, next operation has Optional behavior.") |
| 974 | (defvar calc-keep-args-flag nil |
| 975 | "If non-nil, next operation should not remove its arguments from stack.") |
| 976 | (defvar calc-function-open "(" |
| 977 | "Open-parenthesis string for function call notation.") |
| 978 | (defvar calc-function-close ")" |
| 979 | "Close-parenthesis string for function call notation.") |
| 980 | (defvar calc-language-output-filter nil |
| 981 | "Function through which to pass strings after formatting.") |
| 982 | (defvar calc-language-input-filter nil |
| 983 | "Function through which to pass strings before parsing.") |
| 984 | (defvar calc-radix-formatter nil |
| 985 | "Formatting function used for non-decimal numbers.") |
| 986 | (defvar calc-lang-slash-idiv nil |
| 987 | "A list of languages in which / might represent integer division.") |
| 988 | (defvar calc-lang-allow-underscores nil |
| 989 | "A list of languages which allow underscores in variable names.") |
| 990 | (defvar calc-lang-allow-percentsigns nil |
| 991 | "A list of languages which allow percent signs in variable names.") |
| 992 | (defvar calc-lang-c-type-hex nil |
| 993 | "Languages in which octal and hex numbers are written with leading 0 and 0x,") |
| 994 | (defvar calc-lang-brackets-are-subscripts nil |
| 995 | "Languages in which subscripts are indicated by brackets.") |
| 996 | (defvar calc-lang-parens-are-subscripts nil |
| 997 | "Languages in which subscripts are indicated by parentheses.") |
| 998 | |
| 999 | (defvar calc-last-kill nil |
| 1000 | "The last number killed in calc-mode.") |
| 1001 | (defvar calc-dollar-values nil |
| 1002 | "Values to be used for '$'.") |
| 1003 | (defvar calc-dollar-used nil |
| 1004 | "The highest order of '$' that occurred.") |
| 1005 | (defvar calc-hashes-used nil |
| 1006 | "The highest order of '#' that occurred.") |
| 1007 | (defvar calc-quick-prev-results nil |
| 1008 | "Previous results from Quick Calc.") |
| 1009 | (defvar calc-said-hello nil |
| 1010 | "Non-nil if the welcome message has been displayed.") |
| 1011 | (defvar calc-executing-macro nil |
| 1012 | "Non-nil if a keyboard macro is executing from the \"K\" key.") |
| 1013 | (defvar calc-any-selections nil |
| 1014 | "Non-nil if there are selections present.") |
| 1015 | (defvar calc-help-phase 0 |
| 1016 | "The number of consecutive \"?\" keystrokes.") |
| 1017 | (defvar calc-full-help-flag nil |
| 1018 | "Non-nil if `calc-full-help' is being executed.") |
| 1019 | (defvar calc-refresh-count 0 |
| 1020 | "The number of `calc-refresh' calls.") |
| 1021 | (defvar calc-display-dirty nil |
| 1022 | "Non-nil if the stack display might not reflect the latest mode settings.") |
| 1023 | (defvar calc-prepared-composition nil) |
| 1024 | (defvar calc-selection-cache-default-entry nil) |
| 1025 | (defvar calc-embedded-info nil |
| 1026 | "If non-nil, a vector consisting of information for embedded mode.") |
| 1027 | (defvar calc-embedded-active nil |
| 1028 | "Alist of buffers with sorted lists of calc-embedded-infos.") |
| 1029 | (defvar calc-standalone-flag nil |
| 1030 | "Non-nil if Emacs started with standalone Calc.") |
| 1031 | (defvar var-EvalRules nil |
| 1032 | "User defined rules that Calc will apply automatically.") |
| 1033 | (defvar math-eval-rules-cache-tag t) |
| 1034 | (defvar math-radix-explicit-format t) |
| 1035 | (defvar math-expr-function-mapping nil |
| 1036 | "Alist of language specific functions with Calc functions.") |
| 1037 | (defvar math-expr-variable-mapping nil |
| 1038 | "Alist of language specific variables with Calc variables.") |
| 1039 | (defvar math-read-expr-quotes nil) |
| 1040 | (defvar math-working-step nil) |
| 1041 | (defvar math-working-step-2 nil) |
| 1042 | (defvar var-i '(special-const (math-imaginary 1))) |
| 1043 | (defvar var-pi '(special-const (math-pi))) |
| 1044 | (defvar var-Ï€ '(special-const (math-pi))) |
| 1045 | (defvar var-e '(special-const (math-e))) |
| 1046 | (defvar var-phi '(special-const (math-phi))) |
| 1047 | (defvar var-φ '(special-const (math-phi))) |
| 1048 | (defvar var-gamma '(special-const (math-gamma-const))) |
| 1049 | (defvar var-γ '(special-const (math-gamma-const))) |
| 1050 | (defvar var-Modes '(special-const (math-get-modes-vec))) |
| 1051 | |
| 1052 | (mapc (lambda (v) (or (boundp v) (set v nil))) |
| 1053 | calc-local-var-list) |
| 1054 | |
| 1055 | (defvar calc-mode-map |
| 1056 | (let ((map (make-keymap))) |
| 1057 | (suppress-keymap map t) |
| 1058 | (define-key map "+" 'calc-plus) |
| 1059 | (define-key map "-" 'calc-minus) |
| 1060 | (define-key map "*" 'calc-times) |
| 1061 | (define-key map "/" 'calc-divide) |
| 1062 | (define-key map "%" 'calc-mod) |
| 1063 | (define-key map "&" 'calc-inv) |
| 1064 | (define-key map "^" 'calc-power) |
| 1065 | (define-key map "\M-%" 'calc-percent) |
| 1066 | (define-key map "e" 'calcDigit-start) |
| 1067 | (define-key map "i" 'calc-info) |
| 1068 | (define-key map "n" 'calc-change-sign) |
| 1069 | (define-key map "q" 'calc-quit) |
| 1070 | (define-key map "Y" 'nil) |
| 1071 | (define-key map "Y?" 'calc-shift-Y-prefix-help) |
| 1072 | (define-key map "?" 'calc-help) |
| 1073 | (define-key map " " 'calc-enter) |
| 1074 | (define-key map "'" 'calc-algebraic-entry) |
| 1075 | (define-key map "$" 'calc-auto-algebraic-entry) |
| 1076 | (define-key map "\"" 'calc-auto-algebraic-entry) |
| 1077 | (define-key map "\t" 'calc-roll-down) |
| 1078 | (define-key map "\M-\t" 'calc-roll-up) |
| 1079 | (define-key map "\C-x\C-t" 'calc-transpose-lines) |
| 1080 | (define-key map "\C-m" 'calc-enter) |
| 1081 | (define-key map "\M-\C-m" 'calc-last-args-stub) |
| 1082 | (define-key map "\C-j" 'calc-over) |
| 1083 | (define-key map "\C-y" 'calc-yank) |
| 1084 | (define-key map [mouse-2] 'calc-yank) |
| 1085 | (define-key map [remap undo] 'calc-undo) |
| 1086 | |
| 1087 | (mapc (lambda (x) (define-key map (char-to-string x) 'undefined)) |
| 1088 | "lOW") |
| 1089 | (mapc (lambda (x) (define-key map (char-to-string x) 'calc-missing-key)) |
| 1090 | (concat "ABCDEFGHIJKLMNOPQRSTUVXZabcdfghjkmoprstuvwxyz" |
| 1091 | ":\\|!()[]<>{},;=~`\C-k\C-w")) |
| 1092 | (define-key map "\M-w" 'calc-missing-key) |
| 1093 | (define-key map "\M-k" 'calc-missing-key) |
| 1094 | (define-key map "\M-\C-w" 'calc-missing-key) |
| 1095 | (mapc (lambda (x) (define-key map (char-to-string x) 'calcDigit-start)) |
| 1096 | "_0123456789.#@") |
| 1097 | map) |
| 1098 | "The key map for Calc.") |
| 1099 | |
| 1100 | (defvar calc-digit-map |
| 1101 | (let ((map (make-keymap))) |
| 1102 | (map-keymap (lambda (key bind) |
| 1103 | (define-key map (vector key) |
| 1104 | (if (eq bind 'undefined) |
| 1105 | 'undefined 'calcDigit-nondigit))) |
| 1106 | calc-mode-map) |
| 1107 | (mapc (lambda (x) (define-key map (char-to-string x) 'calcDigit-key)) |
| 1108 | "_0123456789.e+-:n#@oh'\"mspM") |
| 1109 | (mapc (lambda (x) (define-key map (char-to-string x) 'calcDigit-letter)) |
| 1110 | "abcdfgijklqrtuvwxyzABCDEFGHIJKLNOPQRSTUVWXYZ") |
| 1111 | (define-key map "'" 'calcDigit-algebraic) |
| 1112 | (define-key map "`" 'calcDigit-edit) |
| 1113 | (define-key map "\C-g" 'abort-recursive-edit) |
| 1114 | map) |
| 1115 | "The key map for entering Calc digits.") |
| 1116 | |
| 1117 | (mapc (lambda (x) |
| 1118 | (condition-case err |
| 1119 | (progn |
| 1120 | (define-key calc-digit-map x 'calcDigit-backspace) |
| 1121 | (define-key calc-mode-map x 'calc-pop) |
| 1122 | (define-key calc-mode-map |
| 1123 | (if (and (vectorp x) (featurep 'xemacs)) |
| 1124 | (if (= (length x) 1) |
| 1125 | (vector (if (consp (aref x 0)) |
| 1126 | (cons 'meta (aref x 0)) |
| 1127 | (list 'meta (aref x 0)))) |
| 1128 | "\e\C-d") |
| 1129 | (vconcat "\e" x)) |
| 1130 | 'calc-pop-above)) |
| 1131 | (error nil))) |
| 1132 | (if calc-scan-for-dels |
| 1133 | (append (where-is-internal 'delete-backward-char global-map) |
| 1134 | (where-is-internal 'backward-delete-char global-map) |
| 1135 | (where-is-internal 'backward-delete-char-untabify global-map) |
| 1136 | '("\C-d")) |
| 1137 | '("\177" "\C-d"))) |
| 1138 | |
| 1139 | (defvar calc-dispatch-map |
| 1140 | (let ((map (make-keymap))) |
| 1141 | (mapc (lambda (x) |
| 1142 | (let* ((x-chr (car x)) |
| 1143 | (x-str (char-to-string x-chr)) |
| 1144 | (x-def (cdr x))) |
| 1145 | (define-key map x-str x-def) |
| 1146 | (when (string-match "[a-z]" x-str) |
| 1147 | ;; Map upper case char to same definition. |
| 1148 | (define-key map (upcase x-str) x-def) |
| 1149 | (unless (string-match "[gmv]" x-str) |
| 1150 | ;; Map control prefixed char to same definition. |
| 1151 | (define-key map (vector (list 'control x-chr)) x-def))) |
| 1152 | (define-key map (format "\e%c" x-chr) x-def))) |
| 1153 | '( ( ?a . calc-embedded-activate ) |
| 1154 | ( ?b . calc-big-or-small ) |
| 1155 | ( ?c . calc ) |
| 1156 | ( ?d . calc-embedded-duplicate ) |
| 1157 | ( ?e . calc-embedded ) |
| 1158 | ( ?f . calc-embedded-new-formula ) |
| 1159 | ( ?g . calc-grab-region ) |
| 1160 | ( ?h . calc-dispatch-help ) |
| 1161 | ( ?i . calc-info ) |
| 1162 | ( ?j . calc-embedded-select ) |
| 1163 | ( ?k . calc-keypad ) |
| 1164 | ( ?l . calc-load-everything ) |
| 1165 | ( ?m . read-kbd-macro ) |
| 1166 | ( ?n . calc-embedded-next ) |
| 1167 | ( ?o . calc-other-window ) |
| 1168 | ( ?p . calc-embedded-previous ) |
| 1169 | ( ?q . quick-calc ) |
| 1170 | ( ?r . calc-grab-rectangle ) |
| 1171 | ( ?s . calc-info-summary ) |
| 1172 | ( ?t . calc-tutorial ) |
| 1173 | ( ?u . calc-embedded-update-formula ) |
| 1174 | ( ?w . calc-embedded-word ) |
| 1175 | ( ?x . calc-quit ) |
| 1176 | ( ?y . calc-copy-to-buffer ) |
| 1177 | ( ?z . calc-user-invocation ) |
| 1178 | ( ?\' . calc-embedded-new-formula ) |
| 1179 | ( ?\` . calc-embedded-edit ) |
| 1180 | ( ?: . calc-grab-sum-down ) |
| 1181 | ( ?_ . calc-grab-sum-across ) |
| 1182 | ( ?0 . calc-reset ) |
| 1183 | ( ?? . calc-dispatch-help ) |
| 1184 | ( ?# . calc-same-interface ) |
| 1185 | ( ?& . calc-same-interface ) |
| 1186 | ( ?\\ . calc-same-interface ) |
| 1187 | ( ?= . calc-same-interface ) |
| 1188 | ( ?* . calc-same-interface ) |
| 1189 | ( ?/ . calc-same-interface ) |
| 1190 | ( ?+ . calc-same-interface ) |
| 1191 | ( ?- . calc-same-interface ) )) |
| 1192 | map) |
| 1193 | "The key map for starting Calc.") |
| 1194 | |
| 1195 | |
| 1196 | ;;;; (Autoloads here) |
| 1197 | (load "calc-loaddefs.el" nil t) |
| 1198 | |
| 1199 | ;;;###autoload (define-key ctl-x-map "*" 'calc-dispatch) |
| 1200 | |
| 1201 | ;;;###autoload |
| 1202 | (defun calc-dispatch (&optional arg) |
| 1203 | "Invoke the GNU Emacs Calculator. See `calc-dispatch-help' for details." |
| 1204 | (interactive "P") |
| 1205 | ; (sit-for echo-keystrokes) |
| 1206 | (condition-case err ; look for other keys bound to calc-dispatch |
| 1207 | (let ((keys (this-command-keys))) |
| 1208 | (unless (or (not (stringp keys)) |
| 1209 | (string-match "\\`\C-u\\|\\`\e[-0-9#]\\|`[\M--\M-0-\M-9]" keys) |
| 1210 | (eq (lookup-key calc-dispatch-map keys) 'calc-same-interface)) |
| 1211 | (when (and (string-match "\\`[\C-@-\C-_]" keys) |
| 1212 | (symbolp |
| 1213 | (lookup-key calc-dispatch-map (substring keys 0 1)))) |
| 1214 | (define-key calc-dispatch-map (substring keys 0 1) nil)) |
| 1215 | (define-key calc-dispatch-map keys 'calc-same-interface))) |
| 1216 | (error nil)) |
| 1217 | (calc-do-dispatch arg)) |
| 1218 | |
| 1219 | (defvar calc-dispatch-help nil) |
| 1220 | (defun calc-do-dispatch (arg) |
| 1221 | "Start the Calculator." |
| 1222 | (let ((key (calc-read-key-sequence |
| 1223 | (if calc-dispatch-help |
| 1224 | "Calc options: Calc, Keypad, Quick, Embed; eXit; Info, Tutorial; Grab; ?=more" |
| 1225 | (format "%s (Type ? for a list of Calc options)" |
| 1226 | (key-description (this-command-keys)))) |
| 1227 | calc-dispatch-map))) |
| 1228 | (setq key (lookup-key calc-dispatch-map key)) |
| 1229 | (message "") |
| 1230 | (if key |
| 1231 | (progn |
| 1232 | (or (commandp key) (require 'calc-ext)) |
| 1233 | (call-interactively key)) |
| 1234 | (beep)))) |
| 1235 | |
| 1236 | (defun calc-read-key-sequence (prompt map) |
| 1237 | "Read keys, with prompt PROMPT and keymap MAP." |
| 1238 | (let ((prompt2 (format "%s " (key-description (this-command-keys)))) |
| 1239 | (glob (current-global-map)) |
| 1240 | (loc (current-local-map))) |
| 1241 | (or (input-pending-p) (message "%s" prompt)) |
| 1242 | (let ((key (calc-read-key t)) |
| 1243 | (input-method-function nil)) |
| 1244 | (calc-unread-command (cdr key)) |
| 1245 | (unwind-protect |
| 1246 | (progn |
| 1247 | (use-global-map map) |
| 1248 | (use-local-map nil) |
| 1249 | (read-key-sequence nil)) |
| 1250 | (use-global-map glob) |
| 1251 | (use-local-map loc))))) |
| 1252 | |
| 1253 | (defvar calc-alg-map) ; Defined in calc-ext.el |
| 1254 | |
| 1255 | |
| 1256 | (defvar calc-embedded-modes) ; Defined in calc-embed.el |
| 1257 | (defvar calc-override-minor-modes) ; Defined in calc-embed.el |
| 1258 | (defun calc-kill-stack-buffer () |
| 1259 | "Check to see if user wants to kill the Calc stack buffer. |
| 1260 | This will look for buffers using the Calc buffer for embedded mode, |
| 1261 | and inform the user if there are any. |
| 1262 | If the user wants to kill the Calc buffer, this will remove |
| 1263 | embedded information from the appropriate buffers and tidy up |
| 1264 | the trail buffer." |
| 1265 | (let ((cb (current-buffer)) |
| 1266 | (info-list nil) |
| 1267 | (buflist) |
| 1268 | ; (plural nil) |
| 1269 | (cea calc-embedded-active)) |
| 1270 | ;; Get a list of all buffers using this buffer for |
| 1271 | ;; embedded Calc. |
| 1272 | (while cea |
| 1273 | (when (and (eq cb (aref (nth 1 (car cea)) 1)) |
| 1274 | (buffer-name (car (car cea)))) |
| 1275 | (setq info-list (cons (car cea) info-list))) |
| 1276 | (setq cea (cdr cea))) |
| 1277 | ;; Eventually, prompt user with a list of buffers using embedded mode. |
| 1278 | (when (and |
| 1279 | info-list |
| 1280 | (yes-or-no-p |
| 1281 | (concat "This Calc stack is being used for embedded mode. Kill anyway?"))) |
| 1282 | (while info-list |
| 1283 | (with-current-buffer (car (car info-list)) |
| 1284 | (when calc-embedded-info |
| 1285 | (setq calc-embedded-info nil |
| 1286 | mode-line-buffer-identification (car calc-embedded-modes) |
| 1287 | truncate-lines (nth 2 calc-embedded-modes) |
| 1288 | buffer-read-only nil) |
| 1289 | (use-local-map (nth 1 calc-embedded-modes)) |
| 1290 | (setq minor-mode-overriding-map-alist |
| 1291 | (remq calc-override-minor-modes minor-mode-overriding-map-alist)) |
| 1292 | (let ((str mode-line-buffer-identification)) |
| 1293 | (setq mode-line-buffer-identification str)) |
| 1294 | (set-buffer-modified-p (buffer-modified-p)))) |
| 1295 | (setq calc-embedded-active |
| 1296 | (delete (car info-list) calc-embedded-active)) |
| 1297 | (setq info-list (cdr info-list)))) |
| 1298 | (if (not info-list) |
| 1299 | (progn |
| 1300 | (setq calc-buffer-list (delete cb calc-buffer-list)) |
| 1301 | (if (buffer-live-p calc-trail-buffer) |
| 1302 | (with-current-buffer calc-trail-buffer |
| 1303 | (if (eq cb calc-main-buffer) |
| 1304 | ;; If there are other Calc stacks, make another one |
| 1305 | ;; the calc-main-buffer ... |
| 1306 | (if calc-buffer-list |
| 1307 | (setq calc-main-buffer (car calc-buffer-list)) |
| 1308 | ;; ... otherwise kill the trail and its windows. |
| 1309 | (let ((wl (get-buffer-window-list calc-trail-buffer))) |
| 1310 | (while wl |
| 1311 | (delete-window (car wl)) |
| 1312 | (setq wl (cdr wl)))) |
| 1313 | (kill-buffer calc-trail-buffer))))) |
| 1314 | (setq calc-trail-buffer nil) |
| 1315 | t)))) |
| 1316 | |
| 1317 | (defun calc-mode () |
| 1318 | "Calculator major mode. |
| 1319 | |
| 1320 | This is an RPN calculator featuring arbitrary-precision integer, rational, |
| 1321 | floating-point, complex, matrix, and symbolic arithmetic. |
| 1322 | |
| 1323 | RPN calculation: 2 RET 3 + produces 5. |
| 1324 | Algebraic style: ' 2+3 RET produces 5. |
| 1325 | |
| 1326 | Basic operators are +, -, *, /, ^, & (reciprocal), % (modulo), n (change-sign). |
| 1327 | |
| 1328 | Press ? repeatedly for more complete help. Press `h i' to read the |
| 1329 | Calc manual on-line, `h s' to read the summary, or `h t' for the tutorial. |
| 1330 | |
| 1331 | Notations: 3.14e6 3.14 * 10^6 |
| 1332 | _23 negative number -23 (or type `23 n') |
| 1333 | 17:3 the fraction 17/3 |
| 1334 | 5:2:3 the fraction 5 and 2/3 |
| 1335 | 16#12C the integer 12C base 16 = 300 base 10 |
| 1336 | 8#177:100 the fraction 177:100 base 8 = 127:64 base 10 |
| 1337 | (2, 4) complex number 2 + 4i |
| 1338 | (2; 4) polar complex number (r; theta) |
| 1339 | [1, 2, 3] vector ([[1, 2], [3, 4]] is a matrix) |
| 1340 | [1 .. 4) semi-open interval, 1 <= x < 4 |
| 1341 | 2 +/- 3 (p key) number with mean 2, standard deviation 3 |
| 1342 | 2 mod 3 (M key) number 2 computed modulo 3 |
| 1343 | <1 jan 91> Date form (enter using ' key) |
| 1344 | |
| 1345 | |
| 1346 | \\{calc-mode-map} |
| 1347 | " |
| 1348 | (interactive) |
| 1349 | (mapc (function |
| 1350 | (lambda (v) (set-default v (symbol-value v)))) calc-local-var-list) |
| 1351 | (kill-all-local-variables) |
| 1352 | (use-local-map (if (eq calc-algebraic-mode 'total) |
| 1353 | (progn (require 'calc-ext) calc-alg-map) calc-mode-map)) |
| 1354 | (mapc (function (lambda (v) (make-local-variable v))) calc-local-var-list) |
| 1355 | (make-local-variable 'overlay-arrow-position) |
| 1356 | (make-local-variable 'overlay-arrow-string) |
| 1357 | (add-hook 'change-major-mode-hook 'font-lock-defontify nil t) |
| 1358 | (add-hook 'kill-buffer-query-functions |
| 1359 | 'calc-kill-stack-buffer |
| 1360 | t t) |
| 1361 | (setq truncate-lines t) |
| 1362 | (setq buffer-read-only t) |
| 1363 | (setq major-mode 'calc-mode) |
| 1364 | (setq mode-name "Calculator") |
| 1365 | (setq calc-stack-top (length (or (memq (assq 'top-of-stack calc-stack) |
| 1366 | calc-stack) |
| 1367 | (setq calc-stack (list (list 'top-of-stack |
| 1368 | 1 nil)))))) |
| 1369 | (setq calc-stack-top (- (length calc-stack) calc-stack-top -1)) |
| 1370 | (or calc-loaded-settings-file |
| 1371 | (null calc-settings-file) |
| 1372 | (equal calc-settings-file user-init-file) |
| 1373 | (progn |
| 1374 | (setq calc-loaded-settings-file t) |
| 1375 | (load (file-name-sans-extension calc-settings-file) t))) ; t = missing-ok |
| 1376 | (let ((p command-line-args)) |
| 1377 | (while p |
| 1378 | (and (equal (car p) "-f") |
| 1379 | (string-match "calc" (nth 1 p)) |
| 1380 | (string-match "full" (nth 1 p)) |
| 1381 | (setq calc-standalone-flag t)) |
| 1382 | (setq p (cdr p)))) |
| 1383 | (require 'calc-menu) |
| 1384 | (run-mode-hooks 'calc-mode-hook) |
| 1385 | (calc-refresh t) |
| 1386 | (calc-set-mode-line) |
| 1387 | (calc-check-defines) |
| 1388 | (if calc-buffer-list (setq calc-stack (copy-sequence calc-stack))) |
| 1389 | (add-to-list 'calc-buffer-list (current-buffer) t)) |
| 1390 | |
| 1391 | (defvar calc-check-defines 'calc-check-defines) ; suitable for run-hooks |
| 1392 | (defun calc-check-defines () |
| 1393 | (if (symbol-plist 'calc-define) |
| 1394 | (let ((plist (copy-sequence (symbol-plist 'calc-define)))) |
| 1395 | (while (and plist (null (nth 1 plist))) |
| 1396 | (setq plist (cdr (cdr plist)))) |
| 1397 | (if plist |
| 1398 | (save-excursion |
| 1399 | (require 'calc-ext) |
| 1400 | (require 'calc-macs) |
| 1401 | (set-buffer "*Calculator*") |
| 1402 | (while plist |
| 1403 | (put 'calc-define (car plist) nil) |
| 1404 | (eval (nth 1 plist)) |
| 1405 | (setq plist (cdr (cdr plist)))) |
| 1406 | ;; See if this has added any more calc-define properties. |
| 1407 | (calc-check-defines)) |
| 1408 | (setplist 'calc-define nil))))) |
| 1409 | |
| 1410 | (defun calc-trail-mode (&optional buf) |
| 1411 | "Calc Trail mode. |
| 1412 | This mode is used by the *Calc Trail* buffer, which records all results |
| 1413 | obtained by the GNU Emacs Calculator. |
| 1414 | |
| 1415 | Calculator commands beginning with the `t' key are used to manipulate |
| 1416 | the Trail. |
| 1417 | |
| 1418 | This buffer uses the same key map as the *Calculator* buffer; calculator |
| 1419 | commands given here will actually operate on the *Calculator* stack." |
| 1420 | (interactive) |
| 1421 | (fundamental-mode) |
| 1422 | (use-local-map calc-mode-map) |
| 1423 | (setq major-mode 'calc-trail-mode) |
| 1424 | (setq mode-name "Calc Trail") |
| 1425 | (setq truncate-lines t) |
| 1426 | (setq buffer-read-only t) |
| 1427 | (make-local-variable 'overlay-arrow-position) |
| 1428 | (make-local-variable 'overlay-arrow-string) |
| 1429 | (when buf |
| 1430 | (set (make-local-variable 'calc-main-buffer) buf)) |
| 1431 | (when (= (buffer-size) 0) |
| 1432 | (let ((buffer-read-only nil)) |
| 1433 | (insert (propertize "Emacs Calculator Trail\n" 'face 'italic)))) |
| 1434 | (run-mode-hooks 'calc-trail-mode-hook)) |
| 1435 | |
| 1436 | (defun calc-create-buffer () |
| 1437 | "Create and initialize a buffer for the Calculator." |
| 1438 | (set-buffer (get-buffer-create "*Calculator*")) |
| 1439 | (or (eq major-mode 'calc-mode) |
| 1440 | (calc-mode)) |
| 1441 | (setq max-lisp-eval-depth (max max-lisp-eval-depth 1000)) |
| 1442 | (when calc-always-load-extensions |
| 1443 | (require 'calc-ext)) |
| 1444 | (when calc-language |
| 1445 | (require 'calc-ext) |
| 1446 | (calc-set-language calc-language calc-language-option t))) |
| 1447 | |
| 1448 | ;;;###autoload |
| 1449 | (defun calc (&optional arg full-display interactive) |
| 1450 | "The Emacs Calculator. Full documentation is listed under \"calc-mode\"." |
| 1451 | (interactive "P\ni\np") |
| 1452 | (if arg |
| 1453 | (unless (eq arg 0) |
| 1454 | (require 'calc-ext) |
| 1455 | (if (= (prefix-numeric-value arg) -1) |
| 1456 | (calc-grab-region (region-beginning) (region-end) nil) |
| 1457 | (when (= (prefix-numeric-value arg) -2) |
| 1458 | (calc-keypad)))) |
| 1459 | (when (get-buffer-window "*Calc Keypad*") |
| 1460 | (calc-keypad) |
| 1461 | (set-buffer (window-buffer (selected-window)))) |
| 1462 | (if (eq major-mode 'calc-mode) |
| 1463 | (calc-quit) |
| 1464 | (let ((oldbuf (current-buffer))) |
| 1465 | (calc-create-buffer) |
| 1466 | (setq calc-was-keypad-mode nil) |
| 1467 | (if (or (eq full-display t) |
| 1468 | (and (null full-display) calc-full-mode)) |
| 1469 | (switch-to-buffer (current-buffer) t) |
| 1470 | (if (get-buffer-window (current-buffer)) |
| 1471 | (select-window (get-buffer-window (current-buffer))) |
| 1472 | (if calc-window-hook |
| 1473 | (run-hooks 'calc-window-hook) |
| 1474 | (let ((w (get-largest-window))) |
| 1475 | (if (and pop-up-windows |
| 1476 | (> (window-height w) |
| 1477 | (+ window-min-height calc-window-height 2))) |
| 1478 | (progn |
| 1479 | (setq w (split-window w |
| 1480 | (- (window-height w) |
| 1481 | calc-window-height 2) |
| 1482 | nil)) |
| 1483 | (set-window-buffer w (current-buffer)) |
| 1484 | (select-window w)) |
| 1485 | (pop-to-buffer (current-buffer))))))) |
| 1486 | (with-current-buffer (calc-trail-buffer) |
| 1487 | (and calc-display-trail |
| 1488 | (= (window-width) (frame-width)) |
| 1489 | (calc-trail-display 1 t))) |
| 1490 | (message "Welcome to the GNU Emacs Calculator! Press `?' or `h' for help, `q' to quit") |
| 1491 | (run-hooks 'calc-start-hook) |
| 1492 | (and (windowp full-display) |
| 1493 | (window-point full-display) |
| 1494 | (select-window full-display)) |
| 1495 | (calc-check-defines) |
| 1496 | (when (and calc-said-hello interactive) |
| 1497 | (sit-for 2) |
| 1498 | (message "")) |
| 1499 | (setq calc-said-hello t))))) |
| 1500 | |
| 1501 | ;;;###autoload |
| 1502 | (defun full-calc (&optional interactive) |
| 1503 | "Invoke the Calculator and give it a full-sized window." |
| 1504 | (interactive "p") |
| 1505 | (calc nil t interactive)) |
| 1506 | |
| 1507 | (defun calc-same-interface (arg) |
| 1508 | "Invoke the Calculator using the most recent interface (calc or calc-keypad)." |
| 1509 | (interactive "P") |
| 1510 | (if (and (equal (buffer-name) "*Gnuplot Trail*") |
| 1511 | (> (recursion-depth) 0)) |
| 1512 | (exit-recursive-edit) |
| 1513 | (if (eq major-mode 'calc-edit-mode) |
| 1514 | (calc-edit-finish arg) |
| 1515 | (if calc-was-keypad-mode |
| 1516 | (calc-keypad) |
| 1517 | (calc arg calc-full-mode t))))) |
| 1518 | |
| 1519 | (defun calc-quit (&optional non-fatal interactive) |
| 1520 | "Quit the Calculator in an appropriate manner." |
| 1521 | (interactive "i\np") |
| 1522 | (and calc-standalone-flag (not non-fatal) |
| 1523 | (save-buffers-kill-emacs nil)) |
| 1524 | (if (and (equal (buffer-name) "*Gnuplot Trail*") |
| 1525 | (> (recursion-depth) 0)) |
| 1526 | (exit-recursive-edit)) |
| 1527 | (if (eq major-mode 'calc-edit-mode) |
| 1528 | (calc-edit-cancel) |
| 1529 | (if (and interactive |
| 1530 | calc-embedded-info |
| 1531 | (eq (current-buffer) (aref calc-embedded-info 0))) |
| 1532 | (calc-embedded nil) |
| 1533 | (unless (eq major-mode 'calc-mode) |
| 1534 | (calc-create-buffer)) |
| 1535 | (run-hooks 'calc-end-hook) |
| 1536 | (if (integerp calc-undo-length) |
| 1537 | (cond |
| 1538 | ((= calc-undo-length 0) |
| 1539 | (setq calc-undo-list nil calc-redo-list nil)) |
| 1540 | ((> calc-undo-length 0) |
| 1541 | (let ((tail (nthcdr (1- calc-undo-length) calc-undo-list))) |
| 1542 | (if tail (setcdr tail nil))) |
| 1543 | (setq calc-redo-list nil)))) |
| 1544 | (mapc (function (lambda (v) (set-default v (symbol-value v)))) |
| 1545 | calc-local-var-list) |
| 1546 | (let ((buf (current-buffer)) |
| 1547 | (win (get-buffer-window (current-buffer))) |
| 1548 | (kbuf (get-buffer "*Calc Keypad*"))) |
| 1549 | (delete-windows-on (calc-trail-buffer)) |
| 1550 | ;; The next few lines will set `calc-window-height' so that the |
| 1551 | ;; next time Calc is called, the window will be the same size |
| 1552 | ;; as the current window. |
| 1553 | (if (and win |
| 1554 | (not (window-full-height-p win)) |
| 1555 | (window-full-width-p win) ; avoid calc-keypad |
| 1556 | (not (get-buffer-window "*Calc Keypad*"))) |
| 1557 | (setq calc-window-height (- (window-height win) 2))) |
| 1558 | (progn |
| 1559 | (delete-windows-on buf) |
| 1560 | (and kbuf (delete-windows-on kbuf))) |
| 1561 | (bury-buffer buf) |
| 1562 | (bury-buffer calc-trail-buffer) |
| 1563 | (and kbuf (bury-buffer kbuf)))))) |
| 1564 | |
| 1565 | ;;;###autoload |
| 1566 | (defun quick-calc () |
| 1567 | "Do a quick calculation in the minibuffer without invoking full Calculator." |
| 1568 | (interactive) |
| 1569 | (calc-do-quick-calc)) |
| 1570 | |
| 1571 | ;;;###autoload |
| 1572 | (defun calc-eval (str &optional separator &rest args) |
| 1573 | "Do a quick calculation and return the result as a string. |
| 1574 | Return value will either be the formatted result in string form, |
| 1575 | or a list containing a character position and an error message in string form." |
| 1576 | (calc-do-calc-eval str separator args)) |
| 1577 | |
| 1578 | ;;;###autoload |
| 1579 | (defun calc-keypad (&optional interactive) |
| 1580 | "Invoke the Calculator in \"visual keypad\" mode. |
| 1581 | This is most useful in the X window system. |
| 1582 | In this mode, click on the Calc \"buttons\" using the left mouse button. |
| 1583 | Or, position the cursor manually and do M-x calc-keypad-press." |
| 1584 | (interactive "p") |
| 1585 | (require 'calc-ext) |
| 1586 | (calc-do-keypad calc-full-mode interactive)) |
| 1587 | |
| 1588 | ;;;###autoload |
| 1589 | (defun full-calc-keypad (&optional interactive) |
| 1590 | "Invoke the Calculator in full-screen \"visual keypad\" mode. |
| 1591 | See calc-keypad for details." |
| 1592 | (interactive "p") |
| 1593 | (require 'calc-ext) |
| 1594 | (calc-do-keypad t interactive)) |
| 1595 | |
| 1596 | |
| 1597 | (defvar calc-aborted-prefix nil) |
| 1598 | (defvar calc-start-time nil) |
| 1599 | (defvar calc-command-flags nil) |
| 1600 | (defvar calc-final-point-line) |
| 1601 | (defvar calc-final-point-column) |
| 1602 | ;;; Note that modifications to this function may break calc-pass-errors. |
| 1603 | (defun calc-do (do-body &optional do-slow) |
| 1604 | (calc-check-defines) |
| 1605 | (let* ((calc-command-flags nil) |
| 1606 | (calc-start-time (and calc-timing (not calc-start-time) |
| 1607 | (require 'calc-ext) |
| 1608 | (current-time-string))) |
| 1609 | (gc-cons-threshold (max gc-cons-threshold |
| 1610 | (if calc-timing 2000000 100000))) |
| 1611 | calc-final-point-line calc-final-point-column) |
| 1612 | (setq calc-aborted-prefix "") |
| 1613 | (unwind-protect |
| 1614 | (condition-case err |
| 1615 | (save-excursion |
| 1616 | (if calc-embedded-info |
| 1617 | (calc-embedded-select-buffer) |
| 1618 | (calc-select-buffer)) |
| 1619 | (and (eq calc-algebraic-mode 'total) |
| 1620 | (require 'calc-ext) |
| 1621 | (use-local-map calc-alg-map)) |
| 1622 | (when (and do-slow calc-display-working-message) |
| 1623 | (message "Working...") |
| 1624 | (calc-set-command-flag 'clear-message)) |
| 1625 | (funcall do-body) |
| 1626 | (setq calc-aborted-prefix nil) |
| 1627 | (when (memq 'renum-stack calc-command-flags) |
| 1628 | (calc-renumber-stack)) |
| 1629 | (when (memq 'clear-message calc-command-flags) |
| 1630 | (message ""))) |
| 1631 | (error |
| 1632 | (if (and (eq (car err) 'error) |
| 1633 | (stringp (nth 1 err)) |
| 1634 | (string-match "max-specpdl-size\\|max-lisp-eval-depth" |
| 1635 | (nth 1 err))) |
| 1636 | (error "Computation got stuck or ran too long. Type `M' to increase the limit") |
| 1637 | (setq calc-aborted-prefix nil) |
| 1638 | (signal (car err) (cdr err))))) |
| 1639 | (when calc-aborted-prefix |
| 1640 | (calc-record "<Aborted>" calc-aborted-prefix)) |
| 1641 | (and calc-start-time |
| 1642 | (let* ((calc-internal-prec 12) |
| 1643 | (calc-date-format nil) |
| 1644 | (end-time (current-time-string)) |
| 1645 | (time (if (equal calc-start-time end-time) |
| 1646 | 0 |
| 1647 | (math-sub |
| 1648 | (calcFunc-unixtime (math-parse-date end-time) 0) |
| 1649 | (calcFunc-unixtime (math-parse-date calc-start-time) |
| 1650 | 0))))) |
| 1651 | (if (math-lessp 1 time) |
| 1652 | (calc-record time "(t)")))) |
| 1653 | (or (memq 'no-align calc-command-flags) |
| 1654 | (eq major-mode 'calc-trail-mode) |
| 1655 | (calc-align-stack-window)) |
| 1656 | (and (memq 'position-point calc-command-flags) |
| 1657 | (if (eq major-mode 'calc-mode) |
| 1658 | (progn |
| 1659 | (goto-char (point-min)) |
| 1660 | (forward-line (1- calc-final-point-line)) |
| 1661 | (move-to-column calc-final-point-column)) |
| 1662 | (save-current-buffer |
| 1663 | (calc-select-buffer) |
| 1664 | (goto-char (point-min)) |
| 1665 | (forward-line (1- calc-final-point-line)) |
| 1666 | (move-to-column calc-final-point-column)))) |
| 1667 | (unless (memq 'keep-flags calc-command-flags) |
| 1668 | (save-excursion |
| 1669 | (calc-select-buffer) |
| 1670 | (setq calc-inverse-flag nil |
| 1671 | calc-hyperbolic-flag nil |
| 1672 | calc-option-flag nil |
| 1673 | calc-keep-args-flag nil))) |
| 1674 | (when (memq 'do-edit calc-command-flags) |
| 1675 | (switch-to-buffer (get-buffer-create "*Calc Edit*"))) |
| 1676 | (calc-set-mode-line) |
| 1677 | (when calc-embedded-info |
| 1678 | (calc-embedded-finish-command)))) |
| 1679 | (identity nil)) ; allow a GC after timing is done |
| 1680 | |
| 1681 | |
| 1682 | (defun calc-set-command-flag (f) |
| 1683 | (unless (memq f calc-command-flags) |
| 1684 | (setq calc-command-flags (cons f calc-command-flags)))) |
| 1685 | |
| 1686 | (defun calc-select-buffer () |
| 1687 | (or (eq major-mode 'calc-mode) |
| 1688 | (if calc-main-buffer |
| 1689 | (set-buffer calc-main-buffer) |
| 1690 | (let ((buf (get-buffer "*Calculator*"))) |
| 1691 | (if buf |
| 1692 | (set-buffer buf) |
| 1693 | (error "Calculator buffer not available")))))) |
| 1694 | |
| 1695 | (defun calc-cursor-stack-index (&optional index) |
| 1696 | (goto-char (point-max)) |
| 1697 | (forward-line (- (calc-substack-height (or index 1))))) |
| 1698 | |
| 1699 | (defun calc-stack-size () |
| 1700 | (- (length calc-stack) calc-stack-top)) |
| 1701 | |
| 1702 | (defun calc-substack-height (n) |
| 1703 | (let ((sum 0) |
| 1704 | (stack calc-stack)) |
| 1705 | (setq n (+ n calc-stack-top)) |
| 1706 | (while (and (> n 0) stack) |
| 1707 | (setq sum (+ sum (nth 1 (car stack))) |
| 1708 | n (1- n) |
| 1709 | stack (cdr stack))) |
| 1710 | sum)) |
| 1711 | |
| 1712 | (defun calc-set-mode-line () |
| 1713 | (save-excursion |
| 1714 | (calc-select-buffer) |
| 1715 | (let* ((fmt (car calc-float-format)) |
| 1716 | (figs (nth 1 calc-float-format)) |
| 1717 | (new-mode-string |
| 1718 | (format "Calc%s%s: %d %s %-14s" |
| 1719 | (if (and calc-embedded-info |
| 1720 | (eq (aref calc-embedded-info 1) (current-buffer))) |
| 1721 | "Embed" "") |
| 1722 | (if (and (> (length (buffer-name)) 12) |
| 1723 | (equal (substring (buffer-name) 0 12) |
| 1724 | "*Calculator*")) |
| 1725 | (substring (buffer-name) 12) |
| 1726 | "") |
| 1727 | calc-internal-prec |
| 1728 | (capitalize (symbol-name calc-angle-mode)) |
| 1729 | (concat |
| 1730 | |
| 1731 | ;; Input-related modes |
| 1732 | (if (eq calc-algebraic-mode 'total) "Alg* " |
| 1733 | (if calc-algebraic-mode "Alg " |
| 1734 | (if calc-incomplete-algebraic-mode "Alg[( " ""))) |
| 1735 | |
| 1736 | ;; Computational modes |
| 1737 | (if calc-symbolic-mode "Symb " "") |
| 1738 | (cond ((eq calc-matrix-mode 'matrix) "Matrix ") |
| 1739 | ((integerp calc-matrix-mode) |
| 1740 | (format "Matrix%d " calc-matrix-mode)) |
| 1741 | ((eq calc-matrix-mode 'sqmatrix) "SqMatrix ") |
| 1742 | ((eq calc-matrix-mode 'scalar) "Scalar ") |
| 1743 | (t "")) |
| 1744 | (if (eq calc-complex-mode 'polar) "Polar " "") |
| 1745 | (if calc-prefer-frac "Frac " "") |
| 1746 | (cond ((null calc-infinite-mode) "") |
| 1747 | ((eq calc-infinite-mode 1) "+Inf ") |
| 1748 | (t "Inf ")) |
| 1749 | (cond ((eq calc-simplify-mode 'none) "NoSimp ") |
| 1750 | ((eq calc-simplify-mode 'num) "NumSimp ") |
| 1751 | ((eq calc-simplify-mode 'binary) |
| 1752 | (format "BinSimp%d " calc-word-size)) |
| 1753 | ((eq calc-simplify-mode 'alg) "AlgSimp ") |
| 1754 | ((eq calc-simplify-mode 'ext) "ExtSimp ") |
| 1755 | ((eq calc-simplify-mode 'units) "UnitSimp ") |
| 1756 | (t "")) |
| 1757 | |
| 1758 | ;; Display modes |
| 1759 | (cond ((= calc-number-radix 10) "") |
| 1760 | ((= calc-number-radix 2) "Bin ") |
| 1761 | ((= calc-number-radix 8) "Oct ") |
| 1762 | ((= calc-number-radix 16) "Hex ") |
| 1763 | (t (format "Radix%d " calc-number-radix))) |
| 1764 | (if calc-twos-complement-mode "TwosComp " "") |
| 1765 | (if calc-leading-zeros "Zero " "") |
| 1766 | (cond ((null calc-language) "") |
| 1767 | ((get calc-language 'math-lang-name) |
| 1768 | (concat (get calc-language 'math-lang-name) " ")) |
| 1769 | (t (concat |
| 1770 | (capitalize (symbol-name calc-language)) |
| 1771 | " "))) |
| 1772 | (cond ((eq fmt 'float) |
| 1773 | (if (zerop figs) "" (format "Norm%d " figs))) |
| 1774 | ((eq fmt 'fix) (format "Fix%d " figs)) |
| 1775 | ((eq fmt 'sci) |
| 1776 | (if (zerop figs) "Sci " (format "Sci%d " figs))) |
| 1777 | ((eq fmt 'eng) |
| 1778 | (if (zerop figs) "Eng " (format "Eng%d " figs)))) |
| 1779 | (cond ((not calc-display-just) |
| 1780 | (if calc-display-origin |
| 1781 | (format "Left%d " calc-display-origin) "")) |
| 1782 | ((eq calc-display-just 'right) |
| 1783 | (if calc-display-origin |
| 1784 | (format "Right%d " calc-display-origin) |
| 1785 | "Right ")) |
| 1786 | (t |
| 1787 | (if calc-display-origin |
| 1788 | (format "Center%d " calc-display-origin) |
| 1789 | "Center "))) |
| 1790 | (cond ((integerp calc-line-breaking) |
| 1791 | (format "Wid%d " calc-line-breaking)) |
| 1792 | (calc-line-breaking "") |
| 1793 | (t "Wide ")) |
| 1794 | |
| 1795 | ;; Miscellaneous other modes/indicators |
| 1796 | (if calc-assoc-selections "" "Break ") |
| 1797 | (cond ((eq calc-mode-save-mode 'save) "Save ") |
| 1798 | ((not calc-embedded-info) "") |
| 1799 | ((eq calc-mode-save-mode 'local) "Local ") |
| 1800 | ((eq calc-mode-save-mode 'edit) "LocEdit ") |
| 1801 | ((eq calc-mode-save-mode 'perm) "LocPerm ") |
| 1802 | ((eq calc-mode-save-mode 'global) "Global ") |
| 1803 | (t "")) |
| 1804 | (if calc-auto-recompute "" "Manual ") |
| 1805 | (if (and (fboundp 'calc-gnuplot-alive) |
| 1806 | (calc-gnuplot-alive)) "Graph " "") |
| 1807 | (if (and calc-embedded-info |
| 1808 | (> (calc-stack-size) 0) |
| 1809 | (calc-top 1 'sel)) "Sel " "") |
| 1810 | (if calc-display-dirty "Dirty " "") |
| 1811 | (if calc-option-flag "Opt " "") |
| 1812 | (if calc-inverse-flag "Inv " "") |
| 1813 | (if calc-hyperbolic-flag "Hyp " "") |
| 1814 | (if calc-keep-args-flag "Keep " "") |
| 1815 | (if (/= calc-stack-top 1) "Narrow " "") |
| 1816 | (apply 'concat calc-other-modes))))) |
| 1817 | (if (equal new-mode-string mode-line-buffer-identification) |
| 1818 | nil |
| 1819 | (setq mode-line-buffer-identification new-mode-string) |
| 1820 | (set-buffer-modified-p (buffer-modified-p)) |
| 1821 | (and calc-embedded-info (calc-embedded-mode-line-change)))))) |
| 1822 | |
| 1823 | (defun calc-align-stack-window () |
| 1824 | (if (eq major-mode 'calc-mode) |
| 1825 | (progn |
| 1826 | (let ((win (get-buffer-window (current-buffer)))) |
| 1827 | (if win |
| 1828 | (progn |
| 1829 | (calc-cursor-stack-index 0) |
| 1830 | (vertical-motion (- 2 (window-height win))) |
| 1831 | (set-window-start win (point))))) |
| 1832 | (calc-cursor-stack-index 0) |
| 1833 | (if (looking-at " *\\.$") |
| 1834 | (goto-char (1- (match-end 0))))) |
| 1835 | (save-excursion |
| 1836 | (calc-select-buffer) |
| 1837 | (calc-align-stack-window)))) |
| 1838 | |
| 1839 | (defun calc-check-stack (n) |
| 1840 | (if (> n (calc-stack-size)) |
| 1841 | (error "Too few elements on stack")) |
| 1842 | (if (< n 0) |
| 1843 | (error "Invalid argument"))) |
| 1844 | |
| 1845 | (defun calc-push-list (vals &optional m sels) |
| 1846 | (while vals |
| 1847 | (if calc-executing-macro |
| 1848 | (calc-push-list-in-macro vals m sels) |
| 1849 | (save-excursion |
| 1850 | (calc-select-buffer) |
| 1851 | (let* ((val (car vals)) |
| 1852 | (entry (list val 1 (car sels))) |
| 1853 | (mm (+ (or m 1) calc-stack-top))) |
| 1854 | (calc-cursor-stack-index (1- (or m 1))) |
| 1855 | (if (> mm 1) |
| 1856 | (setcdr (nthcdr (- mm 2) calc-stack) |
| 1857 | (cons entry (nthcdr (1- mm) calc-stack))) |
| 1858 | (setq calc-stack (cons entry calc-stack))) |
| 1859 | (let ((buffer-read-only nil)) |
| 1860 | (insert (math-format-stack-value entry) "\n")) |
| 1861 | (calc-record-undo (list 'push mm)) |
| 1862 | (calc-set-command-flag 'renum-stack)))) |
| 1863 | (setq vals (cdr vals) |
| 1864 | sels (cdr sels)))) |
| 1865 | |
| 1866 | (defun calc-pop-push-list (n vals &optional m sels) |
| 1867 | (if (and calc-any-selections (null sels)) |
| 1868 | (calc-replace-selections n vals m) |
| 1869 | (calc-pop-stack n m sels) |
| 1870 | (calc-push-list vals m sels))) |
| 1871 | |
| 1872 | (defun calc-pop-push-record-list (n prefix vals &optional m sels) |
| 1873 | (or (and (consp vals) |
| 1874 | (or (integerp (car vals)) |
| 1875 | (consp (car vals)))) |
| 1876 | (and vals (setq vals (list vals) |
| 1877 | sels (and sels (list sels))))) |
| 1878 | (calc-check-stack (+ n (or m 1) -1)) |
| 1879 | (if prefix |
| 1880 | (if (cdr vals) |
| 1881 | (calc-record-list vals prefix) |
| 1882 | (calc-record (car vals) prefix))) |
| 1883 | (calc-pop-push-list n vals m sels)) |
| 1884 | |
| 1885 | (defun calc-enter-result (n prefix vals &optional m) |
| 1886 | (setq calc-aborted-prefix prefix) |
| 1887 | (if (and (consp vals) |
| 1888 | (or (integerp (car vals)) |
| 1889 | (consp (car vals)))) |
| 1890 | (setq vals (mapcar 'calc-normalize vals)) |
| 1891 | (setq vals (calc-normalize vals))) |
| 1892 | (or (and (consp vals) |
| 1893 | (or (integerp (car vals)) |
| 1894 | (consp (car vals)))) |
| 1895 | (setq vals (list vals))) |
| 1896 | (if (equal vals '((nil))) |
| 1897 | (setq vals nil)) |
| 1898 | (calc-pop-push-record-list n prefix vals m) |
| 1899 | (calc-handle-whys)) |
| 1900 | |
| 1901 | (defun calc-normalize (val) |
| 1902 | (if (memq calc-simplify-mode '(nil none num)) |
| 1903 | (math-normalize val) |
| 1904 | (require 'calc-ext) |
| 1905 | (calc-normalize-fancy val))) |
| 1906 | |
| 1907 | (defun calc-handle-whys () |
| 1908 | (if calc-next-why |
| 1909 | (calc-do-handle-whys))) |
| 1910 | |
| 1911 | |
| 1912 | (defun calc-pop-stack (&optional n m sel-ok) ; pop N objs at level M of stack. |
| 1913 | (or n (setq n 1)) |
| 1914 | (or m (setq m 1)) |
| 1915 | (or calc-keep-args-flag |
| 1916 | (let ((mm (+ m calc-stack-top))) |
| 1917 | (if (and calc-any-selections (not sel-ok) |
| 1918 | (calc-top-selected n m)) |
| 1919 | (calc-sel-error)) |
| 1920 | (if calc-executing-macro |
| 1921 | (calc-pop-stack-in-macro n mm) |
| 1922 | (calc-record-undo (list 'pop mm (calc-top-list n m 'full))) |
| 1923 | (save-excursion |
| 1924 | (calc-select-buffer) |
| 1925 | (let ((buffer-read-only nil)) |
| 1926 | (if (> mm 1) |
| 1927 | (progn |
| 1928 | (calc-cursor-stack-index (1- m)) |
| 1929 | (let ((bot (point))) |
| 1930 | (calc-cursor-stack-index (+ n m -1)) |
| 1931 | (delete-region (point) bot)) |
| 1932 | (setcdr (nthcdr (- mm 2) calc-stack) |
| 1933 | (nthcdr (+ n mm -1) calc-stack))) |
| 1934 | (calc-cursor-stack-index n) |
| 1935 | (setq calc-stack (nthcdr n calc-stack)) |
| 1936 | (delete-region (point) (point-max)))) |
| 1937 | (calc-set-command-flag 'renum-stack)))))) |
| 1938 | |
| 1939 | (defvar sel-mode) |
| 1940 | (defun calc-get-stack-element (x) |
| 1941 | (cond ((eq sel-mode 'entry) |
| 1942 | x) |
| 1943 | ((eq sel-mode 'sel) |
| 1944 | (nth 2 x)) |
| 1945 | ((or (null (nth 2 x)) |
| 1946 | (eq sel-mode 'full) |
| 1947 | (not calc-use-selections)) |
| 1948 | (car x)) |
| 1949 | (sel-mode |
| 1950 | (calc-sel-error)) |
| 1951 | (t (nth 2 x)))) |
| 1952 | |
| 1953 | ;; Get the Nth element of the stack (N=1 is the top element). |
| 1954 | (defun calc-top (&optional n sel-mode) |
| 1955 | (or n (setq n 1)) |
| 1956 | (calc-check-stack n) |
| 1957 | (calc-get-stack-element (nth (+ n calc-stack-top -1) calc-stack))) |
| 1958 | |
| 1959 | (defun calc-top-n (&optional n sel-mode) ; in case precision has changed |
| 1960 | (math-check-complete (calc-normalize (calc-top n sel-mode)))) |
| 1961 | |
| 1962 | (defun calc-top-list (&optional n m sel-mode) |
| 1963 | (or n (setq n 1)) |
| 1964 | (or m (setq m 1)) |
| 1965 | (calc-check-stack (+ n m -1)) |
| 1966 | (and (> n 0) |
| 1967 | (let ((top (copy-sequence (nthcdr (+ m calc-stack-top -1) |
| 1968 | calc-stack)))) |
| 1969 | (setcdr (nthcdr (1- n) top) nil) |
| 1970 | (nreverse (mapcar 'calc-get-stack-element top))))) |
| 1971 | |
| 1972 | (defun calc-top-list-n (&optional n m sel-mode) |
| 1973 | (mapcar 'math-check-complete |
| 1974 | (mapcar 'calc-normalize (calc-top-list n m sel-mode)))) |
| 1975 | |
| 1976 | |
| 1977 | (defun calc-renumber-stack () |
| 1978 | (if calc-line-numbering |
| 1979 | (save-excursion |
| 1980 | (calc-cursor-stack-index 0) |
| 1981 | (let ((lnum 1) |
| 1982 | (buffer-read-only nil) |
| 1983 | (stack (nthcdr calc-stack-top calc-stack))) |
| 1984 | (if (re-search-forward "^[0-9]+[:*]" nil t) |
| 1985 | (progn |
| 1986 | (beginning-of-line) |
| 1987 | (while (re-search-forward "^[0-9]+[:*]" nil t) |
| 1988 | (let ((buffer-read-only nil)) |
| 1989 | (beginning-of-line) |
| 1990 | (delete-char 4) |
| 1991 | (insert " "))) |
| 1992 | (calc-cursor-stack-index 0))) |
| 1993 | (while (re-search-backward "^[0-9]+[:*]" nil t) |
| 1994 | (delete-char 4) |
| 1995 | (if (> lnum 999) |
| 1996 | (insert (format "%03d%s" (% lnum 1000) |
| 1997 | (if (and (nth 2 (car stack)) |
| 1998 | calc-use-selections) "*" ":"))) |
| 1999 | (let ((prefix (int-to-string lnum))) |
| 2000 | (insert prefix (if (and (nth 2 (car stack)) |
| 2001 | calc-use-selections) "*" ":") |
| 2002 | (make-string (- 3 (length prefix)) 32)))) |
| 2003 | (beginning-of-line) |
| 2004 | (setq lnum (1+ lnum) |
| 2005 | stack (cdr stack)))))) |
| 2006 | (and calc-embedded-info (calc-embedded-stack-change))) |
| 2007 | |
| 2008 | (defvar calc-any-evaltos nil) |
| 2009 | (defun calc-refresh (&optional align) |
| 2010 | (interactive) |
| 2011 | (and (eq major-mode 'calc-mode) |
| 2012 | (not calc-executing-macro) |
| 2013 | (let* ((buffer-read-only nil) |
| 2014 | (save-point (point)) |
| 2015 | (save-mark (condition-case err (mark) (error nil))) |
| 2016 | (save-aligned (looking-at "\\.$")) |
| 2017 | (thing calc-stack) |
| 2018 | (calc-any-evaltos nil)) |
| 2019 | (setq calc-any-selections nil) |
| 2020 | (erase-buffer) |
| 2021 | (when calc-show-banner |
| 2022 | (insert (propertize "--- Emacs Calculator Mode ---\n" |
| 2023 | 'face 'italic))) |
| 2024 | (while thing |
| 2025 | (goto-char (point-min)) |
| 2026 | (when calc-show-banner |
| 2027 | (forward-line 1)) |
| 2028 | (insert (math-format-stack-value (car thing)) "\n") |
| 2029 | (setq thing (cdr thing))) |
| 2030 | (calc-renumber-stack) |
| 2031 | (if calc-display-dirty |
| 2032 | (calc-wrapper (setq calc-display-dirty nil))) |
| 2033 | (and calc-any-evaltos calc-auto-recompute |
| 2034 | (calc-wrapper (calc-refresh-evaltos))) |
| 2035 | (if (or align save-aligned) |
| 2036 | (calc-align-stack-window) |
| 2037 | (goto-char save-point)) |
| 2038 | (if save-mark (set-mark save-mark)))) |
| 2039 | (and calc-embedded-info (not (eq major-mode 'calc-mode)) |
| 2040 | (with-current-buffer (aref calc-embedded-info 1) |
| 2041 | (calc-refresh align))) |
| 2042 | (setq calc-refresh-count (1+ calc-refresh-count))) |
| 2043 | |
| 2044 | ;;;; The Calc Trail buffer. |
| 2045 | |
| 2046 | (defun calc-check-trail-aligned () |
| 2047 | (save-excursion |
| 2048 | (let ((win (get-buffer-window (current-buffer)))) |
| 2049 | (and win |
| 2050 | (pos-visible-in-window-p (1- (point-max)) win))))) |
| 2051 | |
| 2052 | (defun calc-trail-buffer () |
| 2053 | (and (or (null calc-trail-buffer) |
| 2054 | (null (buffer-name calc-trail-buffer))) |
| 2055 | (save-excursion |
| 2056 | (setq calc-trail-buffer (get-buffer-create "*Calc Trail*")) |
| 2057 | (let ((buf (or (and (not (eq major-mode 'calc-mode)) |
| 2058 | (get-buffer "*Calculator*")) |
| 2059 | (current-buffer)))) |
| 2060 | (set-buffer calc-trail-buffer) |
| 2061 | (or (eq major-mode 'calc-trail-mode) |
| 2062 | (calc-trail-mode buf))))) |
| 2063 | (or (and calc-trail-pointer |
| 2064 | (eq (marker-buffer calc-trail-pointer) calc-trail-buffer)) |
| 2065 | (with-current-buffer calc-trail-buffer |
| 2066 | (goto-char (point-min)) |
| 2067 | (forward-line 1) |
| 2068 | (setq calc-trail-pointer (point-marker)))) |
| 2069 | calc-trail-buffer) |
| 2070 | |
| 2071 | (defun calc-record (val &optional prefix) |
| 2072 | (setq calc-aborted-prefix nil) |
| 2073 | (or calc-executing-macro |
| 2074 | (let* ((mainbuf (current-buffer)) |
| 2075 | (buf (calc-trail-buffer)) |
| 2076 | (calc-display-raw nil) |
| 2077 | (calc-can-abbrev-vectors t) |
| 2078 | (fval (if val |
| 2079 | (if (stringp val) |
| 2080 | val |
| 2081 | (math-showing-full-precision |
| 2082 | (math-format-flat-expr val 0))) |
| 2083 | ""))) |
| 2084 | (with-current-buffer buf |
| 2085 | (let ((aligned (calc-check-trail-aligned)) |
| 2086 | (buffer-read-only nil)) |
| 2087 | (goto-char (point-max)) |
| 2088 | (cond ((null prefix) (insert " ")) |
| 2089 | ((and (> (length prefix) 4) |
| 2090 | (string-match " " prefix 4)) |
| 2091 | (insert (substring prefix 0 4) " ")) |
| 2092 | (t (insert (format "%4s " prefix)))) |
| 2093 | (insert fval "\n") |
| 2094 | (let ((win (get-buffer-window buf))) |
| 2095 | (if (and aligned win (not (memq 'hold-trail calc-command-flags))) |
| 2096 | (calc-trail-here)) |
| 2097 | (goto-char (1- (point-max)))))))) |
| 2098 | val) |
| 2099 | |
| 2100 | |
| 2101 | (defun calc-trail-display (flag &optional no-refresh interactive) |
| 2102 | (interactive "P\ni\np") |
| 2103 | (let ((win (get-buffer-window (calc-trail-buffer)))) |
| 2104 | (if (setq calc-display-trail |
| 2105 | (not (if flag (memq flag '(nil 0)) win))) |
| 2106 | (if (null win) |
| 2107 | (progn |
| 2108 | (if calc-trail-window-hook |
| 2109 | (run-hooks 'calc-trail-window-hook) |
| 2110 | (let ((w (split-window nil (/ (* (window-width) 2) 3) t))) |
| 2111 | (set-window-buffer w calc-trail-buffer))) |
| 2112 | (calc-wrapper |
| 2113 | (setq overlay-arrow-string calc-trail-overlay |
| 2114 | overlay-arrow-position calc-trail-pointer) |
| 2115 | (or no-refresh |
| 2116 | (if interactive |
| 2117 | (calc-do-refresh) |
| 2118 | (calc-refresh)))))) |
| 2119 | (if win |
| 2120 | (progn |
| 2121 | (delete-window win) |
| 2122 | (calc-wrapper |
| 2123 | (or no-refresh |
| 2124 | (if interactive |
| 2125 | (calc-do-refresh) |
| 2126 | (calc-refresh)))))))) |
| 2127 | calc-trail-buffer) |
| 2128 | |
| 2129 | (defun calc-trail-here () |
| 2130 | (interactive) |
| 2131 | (if (eq major-mode 'calc-trail-mode) |
| 2132 | (progn |
| 2133 | (beginning-of-line) |
| 2134 | (if (bobp) |
| 2135 | (forward-line 1) |
| 2136 | (if (eobp) |
| 2137 | (forward-line -1))) |
| 2138 | (if (or (bobp) (eobp)) |
| 2139 | (setq overlay-arrow-position nil) ; trail is empty |
| 2140 | (set-marker calc-trail-pointer (point) (current-buffer)) |
| 2141 | (setq calc-trail-overlay (concat (buffer-substring (point) |
| 2142 | (+ (point) 4)) |
| 2143 | ">") |
| 2144 | overlay-arrow-string calc-trail-overlay |
| 2145 | overlay-arrow-position calc-trail-pointer) |
| 2146 | (forward-char 4) |
| 2147 | (let ((win (get-buffer-window (current-buffer)))) |
| 2148 | (if win |
| 2149 | (save-excursion |
| 2150 | (forward-line (/ (window-height win) 2)) |
| 2151 | (forward-line (- 1 (window-height win))) |
| 2152 | (set-window-start win (point)) |
| 2153 | (set-window-point win (+ calc-trail-pointer 4)) |
| 2154 | (set-buffer calc-main-buffer) |
| 2155 | (setq overlay-arrow-string calc-trail-overlay |
| 2156 | overlay-arrow-position calc-trail-pointer)))))) |
| 2157 | (error "Not in Calc Trail buffer"))) |
| 2158 | |
| 2159 | |
| 2160 | |
| 2161 | |
| 2162 | ;;;; The Undo list. |
| 2163 | |
| 2164 | (defun calc-record-undo (rec) |
| 2165 | (or calc-executing-macro |
| 2166 | (if (memq 'undo calc-command-flags) |
| 2167 | (setq calc-undo-list (cons (cons rec (car calc-undo-list)) |
| 2168 | (cdr calc-undo-list))) |
| 2169 | (setq calc-undo-list (cons (list rec) calc-undo-list) |
| 2170 | calc-redo-list nil) |
| 2171 | (calc-set-command-flag 'undo)))) |
| 2172 | |
| 2173 | |
| 2174 | |
| 2175 | |
| 2176 | ;;; Arithmetic commands. |
| 2177 | |
| 2178 | (defun calc-binary-op (name func arg &optional ident unary func2) |
| 2179 | (setq calc-aborted-prefix name) |
| 2180 | (if (null arg) |
| 2181 | (calc-enter-result 2 name (cons (or func2 func) |
| 2182 | (mapcar 'math-check-complete |
| 2183 | (calc-top-list 2)))) |
| 2184 | (require 'calc-ext) |
| 2185 | (calc-binary-op-fancy name func arg ident unary))) |
| 2186 | |
| 2187 | (defun calc-unary-op (name func arg &optional func2) |
| 2188 | (setq calc-aborted-prefix name) |
| 2189 | (if (null arg) |
| 2190 | (calc-enter-result 1 name (list (or func2 func) |
| 2191 | (math-check-complete (calc-top 1)))) |
| 2192 | (require 'calc-ext) |
| 2193 | (calc-unary-op-fancy name func arg))) |
| 2194 | |
| 2195 | |
| 2196 | (defun calc-plus (arg) |
| 2197 | (interactive "P") |
| 2198 | (calc-slow-wrapper |
| 2199 | (calc-binary-op "+" 'calcFunc-add arg 0 nil '+))) |
| 2200 | |
| 2201 | (defun calc-minus (arg) |
| 2202 | (interactive "P") |
| 2203 | (calc-slow-wrapper |
| 2204 | (calc-binary-op "-" 'calcFunc-sub arg 0 'neg '-))) |
| 2205 | |
| 2206 | (defun calc-times (arg) |
| 2207 | (interactive "P") |
| 2208 | (calc-slow-wrapper |
| 2209 | (calc-binary-op "*" 'calcFunc-mul arg 1 nil '*))) |
| 2210 | |
| 2211 | (defun calc-divide (arg) |
| 2212 | (interactive "P") |
| 2213 | (calc-slow-wrapper |
| 2214 | (calc-binary-op "/" 'calcFunc-div arg 0 'calcFunc-inv '/))) |
| 2215 | |
| 2216 | (defun calc-left-divide (arg) |
| 2217 | (interactive "P") |
| 2218 | (calc-slow-wrapper |
| 2219 | (calc-binary-op "ldiv" 'calcFunc-ldiv arg 0 nil nil))) |
| 2220 | |
| 2221 | (defun calc-change-sign (arg) |
| 2222 | (interactive "P") |
| 2223 | (calc-wrapper |
| 2224 | (calc-unary-op "chs" 'neg arg))) |
| 2225 | |
| 2226 | |
| 2227 | |
| 2228 | ;;; Stack management commands. |
| 2229 | |
| 2230 | (defun calc-enter (n) |
| 2231 | (interactive "p") |
| 2232 | (calc-wrapper |
| 2233 | (cond ((< n 0) |
| 2234 | (calc-push-list (calc-top-list 1 (- n)))) |
| 2235 | ((= n 0) |
| 2236 | (calc-push-list (calc-top-list (calc-stack-size)))) |
| 2237 | (t |
| 2238 | (calc-push-list (calc-top-list n)))))) |
| 2239 | |
| 2240 | |
| 2241 | (defun calc-pop (n) |
| 2242 | (interactive "P") |
| 2243 | (calc-wrapper |
| 2244 | (let* ((nn (prefix-numeric-value n)) |
| 2245 | (top (and (null n) (calc-top 1)))) |
| 2246 | (cond ((and (null n) |
| 2247 | (eq (car-safe top) 'incomplete) |
| 2248 | (> (length top) (if (eq (nth 1 top) 'intv) 3 2))) |
| 2249 | (calc-pop-push-list 1 (let ((tt (copy-sequence top))) |
| 2250 | (setcdr (nthcdr (- (length tt) 2) tt) nil) |
| 2251 | (list tt)))) |
| 2252 | ((< nn 0) |
| 2253 | (if (and calc-any-selections |
| 2254 | (calc-top-selected 1 (- nn))) |
| 2255 | (calc-delete-selection (- nn)) |
| 2256 | (calc-pop-stack 1 (- nn) t))) |
| 2257 | ((= nn 0) |
| 2258 | (calc-pop-stack (calc-stack-size) 1 t)) |
| 2259 | (t |
| 2260 | (if (and calc-any-selections |
| 2261 | (= nn 1) |
| 2262 | (calc-top-selected 1 1)) |
| 2263 | (calc-delete-selection 1) |
| 2264 | (calc-pop-stack nn))))))) |
| 2265 | |
| 2266 | |
| 2267 | |
| 2268 | |
| 2269 | ;;;; Reading a number using the minibuffer. |
| 2270 | (defvar calc-buffer) |
| 2271 | (defvar calc-prev-char) |
| 2272 | (defvar calc-prev-prev-char) |
| 2273 | (defvar calc-digit-value) |
| 2274 | (defun calcDigit-start () |
| 2275 | (interactive) |
| 2276 | (calc-wrapper |
| 2277 | (if (or calc-algebraic-mode |
| 2278 | (and (> calc-number-radix 14) (eq last-command-event ?e))) |
| 2279 | (calc-alg-digit-entry) |
| 2280 | (calc-unread-command) |
| 2281 | (setq calc-aborted-prefix nil) |
| 2282 | (let* ((calc-digit-value nil) |
| 2283 | (calc-prev-char nil) |
| 2284 | (calc-prev-prev-char nil) |
| 2285 | (calc-buffer (current-buffer)) |
| 2286 | (buf (if (featurep 'xemacs) |
| 2287 | (catch 'calc-foo |
| 2288 | (catch 'execute-kbd-macro |
| 2289 | (throw 'calc-foo |
| 2290 | (read-from-minibuffer |
| 2291 | "Calc: " "" calc-digit-map))) |
| 2292 | (error "XEmacs requires RET after %s" |
| 2293 | "digit entry in kbd macro")) |
| 2294 | (let ((old-esc (lookup-key global-map "\e"))) |
| 2295 | (unwind-protect |
| 2296 | (progn |
| 2297 | (define-key global-map "\e" nil) |
| 2298 | (read-from-minibuffer "Calc: " "" calc-digit-map)) |
| 2299 | (define-key global-map "\e" old-esc)))))) |
| 2300 | (or calc-digit-value (setq calc-digit-value (math-read-number buf))) |
| 2301 | (if (stringp calc-digit-value) |
| 2302 | (calc-alg-entry calc-digit-value) |
| 2303 | (if calc-digit-value |
| 2304 | (calc-push-list (list (calc-record (calc-normalize |
| 2305 | calc-digit-value)))))) |
| 2306 | (if (eq calc-prev-char 'dots) |
| 2307 | (progn |
| 2308 | (require 'calc-ext) |
| 2309 | (calc-dots))))))) |
| 2310 | |
| 2311 | (defsubst calc-minibuffer-size () |
| 2312 | (- (point-max) (minibuffer-prompt-end))) |
| 2313 | |
| 2314 | (defun calcDigit-nondigit () |
| 2315 | (interactive) |
| 2316 | ;; Exercise for the reader: Figure out why this is a good precaution! |
| 2317 | (or (boundp 'calc-buffer) |
| 2318 | (use-local-map minibuffer-local-map)) |
| 2319 | (let ((str (minibuffer-contents))) |
| 2320 | (setq calc-digit-value (with-current-buffer calc-buffer |
| 2321 | (math-read-number str)))) |
| 2322 | (if (and (null calc-digit-value) (> (calc-minibuffer-size) 0)) |
| 2323 | (progn |
| 2324 | (beep) |
| 2325 | (calc-temp-minibuffer-message " [Bad format]")) |
| 2326 | (or (memq last-command-event '(32 13)) |
| 2327 | (progn (setq prefix-arg current-prefix-arg) |
| 2328 | (calc-unread-command (if (and (eq last-command-event 27) |
| 2329 | (>= last-input-event 128)) |
| 2330 | last-input-event |
| 2331 | nil)))) |
| 2332 | (exit-minibuffer))) |
| 2333 | |
| 2334 | |
| 2335 | (defun calc-minibuffer-contains (rex) |
| 2336 | (save-excursion |
| 2337 | (goto-char (minibuffer-prompt-end)) |
| 2338 | (looking-at rex))) |
| 2339 | |
| 2340 | (defun calcDigit-key () |
| 2341 | (interactive) |
| 2342 | (goto-char (point-max)) |
| 2343 | (if (or (and (memq last-command-event '(?+ ?-)) |
| 2344 | (> (buffer-size) 0) |
| 2345 | (/= (preceding-char) ?e)) |
| 2346 | (and (memq last-command-event '(?m ?s)) |
| 2347 | (not (calc-minibuffer-contains "[-+]?[0-9]+\\.?0*[@oh].*")) |
| 2348 | (not (calc-minibuffer-contains "[-+]?\\(1[1-9]\\|[2-9][0-9]\\)#.*")))) |
| 2349 | (calcDigit-nondigit) |
| 2350 | (if (calc-minibuffer-contains "\\([-+]?\\|.* \\)\\'") |
| 2351 | (cond ((memq last-command-event '(?. ?@)) (insert "0")) |
| 2352 | ((and (memq last-command-event '(?o ?h ?m)) |
| 2353 | (not (calc-minibuffer-contains ".*#.*"))) (insert "0")) |
| 2354 | ((memq last-command-event '(?: ?e)) (insert "1")) |
| 2355 | ((eq last-command-event ?#) |
| 2356 | (insert (int-to-string calc-number-radix))))) |
| 2357 | (if (and (calc-minibuffer-contains "\\([-+]?[0-9]+#\\|[^:]*:\\)\\'") |
| 2358 | (eq last-command-event ?:)) |
| 2359 | (insert "1")) |
| 2360 | (if (and (calc-minibuffer-contains "[-+]?[0-9]+#\\'") |
| 2361 | (eq last-command-event ?.)) |
| 2362 | (insert "0")) |
| 2363 | (if (and (calc-minibuffer-contains "[-+]?0*\\([2-9]\\|1[0-4]\\)#\\'") |
| 2364 | (eq last-command-event ?e)) |
| 2365 | (insert "1")) |
| 2366 | (if (or (and (memq last-command-event '(?h ?o ?m ?s ?p)) |
| 2367 | (calc-minibuffer-contains ".*#.*")) |
| 2368 | (and (eq last-command-event ?e) |
| 2369 | (calc-minibuffer-contains "[-+]?\\(1[5-9]\\|[2-9][0-9]\\)#.*")) |
| 2370 | (and (eq last-command-event ?n) |
| 2371 | (calc-minibuffer-contains "[-+]?\\(2[4-9]\\|[3-9][0-9]\\)#.*"))) |
| 2372 | (setq last-command-event (upcase last-command-event))) |
| 2373 | (cond |
| 2374 | ((memq last-command-event '(?_ ?n)) |
| 2375 | (goto-char (minibuffer-prompt-end)) |
| 2376 | (if (and (search-forward " +/- " nil t) |
| 2377 | (not (search-forward "e" nil t))) |
| 2378 | (beep) |
| 2379 | (and (not (calc-minibuffer-contains "[-+]?\\(1[5-9]\\|[2-9][0-9]\\)#.*")) |
| 2380 | (search-forward "e" nil t)) |
| 2381 | (if (looking-at "+") |
| 2382 | (delete-char 1)) |
| 2383 | (if (looking-at "-") |
| 2384 | (delete-char 1) |
| 2385 | (insert "-"))) |
| 2386 | (goto-char (point-max))) |
| 2387 | ((eq last-command-event ?p) |
| 2388 | (if (or (calc-minibuffer-contains ".*\\+/-.*") |
| 2389 | (calc-minibuffer-contains ".*mod.*") |
| 2390 | (calc-minibuffer-contains ".*#.*") |
| 2391 | (calc-minibuffer-contains ".*[-+e:]\\'")) |
| 2392 | (beep) |
| 2393 | (if (not (calc-minibuffer-contains ".* \\'")) |
| 2394 | (insert " ")) |
| 2395 | (insert "+/- "))) |
| 2396 | ((and (eq last-command-event ?M) |
| 2397 | (not (calc-minibuffer-contains |
| 2398 | "[-+]?\\(2[3-9]\\|[3-9][0-9]\\)#.*"))) |
| 2399 | (if (or (calc-minibuffer-contains ".*\\+/-.*") |
| 2400 | (calc-minibuffer-contains ".*mod *[^ ]+") |
| 2401 | (calc-minibuffer-contains ".*[-+e:]\\'")) |
| 2402 | (beep) |
| 2403 | (if (calc-minibuffer-contains ".*mod \\'") |
| 2404 | (if calc-previous-modulo |
| 2405 | (insert (math-format-flat-expr calc-previous-modulo 0)) |
| 2406 | (beep)) |
| 2407 | (if (not (calc-minibuffer-contains ".* \\'")) |
| 2408 | (insert " ")) |
| 2409 | (insert "mod ")))) |
| 2410 | (t |
| 2411 | (insert (char-to-string last-command-event)) |
| 2412 | (if (or (and (calc-minibuffer-contains "[-+]?\\(.*\\+/- *\\|.*mod *\\)?\\([0-9][0-9]?\\)#[#]?[0-9a-zA-Z]*\\(:[0-9a-zA-Z]*\\(:[0-9a-zA-Z]*\\)?\\|.[0-9a-zA-Z]*\\(e[-+]?[0-9]*\\)?\\)?\\'") |
| 2413 | (let ((radix (string-to-number |
| 2414 | (buffer-substring |
| 2415 | (match-beginning 2) (match-end 2))))) |
| 2416 | (and (>= radix 2) |
| 2417 | (<= radix 36) |
| 2418 | (or (memq last-command-event '(?# ?: ?. ?e ?+ ?-)) |
| 2419 | (let ((dig (math-read-radix-digit |
| 2420 | (upcase last-command-event)))) |
| 2421 | (and dig |
| 2422 | (< dig radix))))))) |
| 2423 | (calc-minibuffer-contains |
| 2424 | "[-+]?\\(.*\\+/- *\\|.*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]?\\'")) |
| 2425 | (if (and (memq last-command-event '(?@ ?o ?h ?\' ?m)) |
| 2426 | (string-match " " calc-hms-format)) |
| 2427 | (insert " ")) |
| 2428 | (if (and (eq this-command last-command) |
| 2429 | (eq last-command-event ?.)) |
| 2430 | (progn |
| 2431 | (require 'calc-ext) |
| 2432 | (calc-digit-dots)) |
| 2433 | (delete-char -1) |
| 2434 | (beep) |
| 2435 | (calc-temp-minibuffer-message " [Bad format]")))))) |
| 2436 | (setq calc-prev-prev-char calc-prev-char |
| 2437 | calc-prev-char last-command-event)) |
| 2438 | |
| 2439 | |
| 2440 | (defun calcDigit-backspace () |
| 2441 | (interactive) |
| 2442 | (goto-char (point-max)) |
| 2443 | (cond ((calc-minibuffer-contains ".* \\+/- \\'") |
| 2444 | (backward-delete-char 5)) |
| 2445 | ((calc-minibuffer-contains ".* mod \\'") |
| 2446 | (backward-delete-char 5)) |
| 2447 | ((calc-minibuffer-contains ".* \\'") |
| 2448 | (backward-delete-char 2)) |
| 2449 | ((eq last-command 'calcDigit-start) |
| 2450 | (erase-buffer)) |
| 2451 | (t (backward-delete-char 1))) |
| 2452 | (if (= (calc-minibuffer-size) 0) |
| 2453 | (progn |
| 2454 | (setq last-command-event 13) |
| 2455 | (calcDigit-nondigit)))) |
| 2456 | |
| 2457 | |
| 2458 | |
| 2459 | |
| 2460 | (defconst math-bignum-digit-length |
| 2461 | (truncate (/ (log10 (/ most-positive-fixnum 2)) 2)) |
| 2462 | "The length of a \"digit\" in Calc bignums. |
| 2463 | If a big integer is of the form (bigpos N0 N1 ...), this is the |
| 2464 | length of the allowable Emacs integers N0, N1,... |
| 2465 | The value of 2*10^(2*MATH-BIGNUM-DIGIT-LENGTH) must be less than the |
| 2466 | largest Emacs integer.") |
| 2467 | |
| 2468 | (defconst math-bignum-digit-size |
| 2469 | (expt 10 math-bignum-digit-length) |
| 2470 | "An upper bound for the size of the \"digit\"s in Calc bignums.") |
| 2471 | |
| 2472 | (defconst math-small-integer-size |
| 2473 | (expt math-bignum-digit-size 2) |
| 2474 | "An upper bound for the size of \"small integer\"s in Calc.") |
| 2475 | |
| 2476 | |
| 2477 | ;;;; Arithmetic routines. |
| 2478 | ;; |
| 2479 | ;; An object as manipulated by one of these routines may take any of the |
| 2480 | ;; following forms: |
| 2481 | ;; |
| 2482 | ;; integer An integer. For normalized numbers, this format |
| 2483 | ;; is used only for |
| 2484 | ;; negative math-small-integer-size + 1 to |
| 2485 | ;; math-small-integer-size - 1 |
| 2486 | ;; |
| 2487 | ;; (bigpos N0 N1 N2 ...) A big positive integer, |
| 2488 | ;; N0 + N1*math-bignum-digit-size |
| 2489 | ;; + N2*(math-bignum-digit-size)^2 ... |
| 2490 | ;; (bigneg N0 N1 N2 ...) A big negative integer, |
| 2491 | ;; - N0 - N1*math-bignum-digit-size ... |
| 2492 | ;; Each digit N is in the range |
| 2493 | ;; 0 ... math-bignum-digit-size -1. |
| 2494 | ;; Normalized, always at least three N present, |
| 2495 | ;; and the most significant N is nonzero. |
| 2496 | ;; |
| 2497 | ;; (frac NUM DEN) A fraction. NUM and DEN are small or big integers. |
| 2498 | ;; Normalized, DEN > 1. |
| 2499 | ;; |
| 2500 | ;; (float NUM EXP) A floating-point number, NUM * 10^EXP; |
| 2501 | ;; NUM is a small or big integer, EXP is a small int. |
| 2502 | ;; Normalized, NUM is not a multiple of 10, and |
| 2503 | ;; abs(NUM) < 10^calc-internal-prec. |
| 2504 | ;; Normalized zero is stored as (float 0 0). |
| 2505 | ;; |
| 2506 | ;; (cplx REAL IMAG) A complex number; REAL and IMAG are any of above. |
| 2507 | ;; Normalized, IMAG is nonzero. |
| 2508 | ;; |
| 2509 | ;; (polar R THETA) Polar complex number. Normalized, R > 0 and THETA |
| 2510 | ;; is neither zero nor 180 degrees (pi radians). |
| 2511 | ;; |
| 2512 | ;; (vec A B C ...) Vector of objects A, B, C, ... A matrix is a |
| 2513 | ;; vector of vectors. |
| 2514 | ;; |
| 2515 | ;; (hms H M S) Angle in hours-minutes-seconds form. All three |
| 2516 | ;; components have the same sign; H and M must be |
| 2517 | ;; numerically integers; M and S are expected to |
| 2518 | ;; lie in the range [0,60). |
| 2519 | ;; |
| 2520 | ;; (date N) A date or date/time object. N is an integer to |
| 2521 | ;; store a date only, or a fraction or float to |
| 2522 | ;; store a date and time. |
| 2523 | ;; |
| 2524 | ;; (sdev X SIGMA) Error form, X +/- SIGMA. When normalized, |
| 2525 | ;; SIGMA > 0. X is any complex number and SIGMA |
| 2526 | ;; is real numbers; or these may be symbolic |
| 2527 | ;; expressions where SIGMA is assumed real. |
| 2528 | ;; |
| 2529 | ;; (intv MASK LO HI) Interval form. MASK is 0=(), 1=(], 2=[), or 3=[]. |
| 2530 | ;; LO and HI are any real numbers, or symbolic |
| 2531 | ;; expressions which are assumed real, and LO < HI. |
| 2532 | ;; For [LO..HI], if LO = HI normalization produces LO, |
| 2533 | ;; and if LO > HI normalization produces [LO..LO). |
| 2534 | ;; For other intervals, if LO > HI normalization |
| 2535 | ;; sets HI equal to LO. |
| 2536 | ;; |
| 2537 | ;; (mod N M) Number modulo M. When normalized, 0 <= N < M. |
| 2538 | ;; N and M are real numbers. |
| 2539 | ;; |
| 2540 | ;; (var V S) Symbolic variable. V is a Lisp symbol which |
| 2541 | ;; represents the variable's visible name. S is |
| 2542 | ;; the symbol which actually stores the variable's |
| 2543 | ;; value: (var pi var-pi). |
| 2544 | ;; |
| 2545 | ;; In general, combining rational numbers in a calculation always produces |
| 2546 | ;; a rational result, but if either argument is a float, result is a float. |
| 2547 | |
| 2548 | ;; In the following comments, [x y z] means result is x, args must be y, z, |
| 2549 | ;; respectively, where the code letters are: |
| 2550 | ;; |
| 2551 | ;; O Normalized object (vector or number) |
| 2552 | ;; V Normalized vector |
| 2553 | ;; N Normalized number of any type |
| 2554 | ;; N Normalized complex number |
| 2555 | ;; R Normalized real number (float or rational) |
| 2556 | ;; F Normalized floating-point number |
| 2557 | ;; T Normalized rational number |
| 2558 | ;; I Normalized integer |
| 2559 | ;; B Normalized big integer |
| 2560 | ;; S Normalized small integer |
| 2561 | ;; D Digit (small integer, 0..999) |
| 2562 | ;; L Normalized bignum digit list (without "bigpos" or "bigneg" symbol) |
| 2563 | ;; or normalized vector element list (without "vec") |
| 2564 | ;; P Predicate (truth value) |
| 2565 | ;; X Any Lisp object |
| 2566 | ;; Z "nil" |
| 2567 | ;; |
| 2568 | ;; Lower-case letters signify possibly un-normalized values. |
| 2569 | ;; "L.D" means a cons of an L and a D. |
| 2570 | ;; [N N; n n] means result will be normalized if argument is. |
| 2571 | ;; Also, [Public] marks routines intended to be called from outside. |
| 2572 | ;; [This notation has been neglected in many recent routines.] |
| 2573 | |
| 2574 | (defvar math-eval-rules-cache) |
| 2575 | (defvar math-eval-rules-cache-other) |
| 2576 | ;;; Reduce an object to canonical (normalized) form. [O o; Z Z] [Public] |
| 2577 | |
| 2578 | (defvar math-normalize-a) |
| 2579 | (defun math-normalize (math-normalize-a) |
| 2580 | (cond |
| 2581 | ((not (consp math-normalize-a)) |
| 2582 | (if (integerp math-normalize-a) |
| 2583 | (if (or (>= math-normalize-a math-small-integer-size) |
| 2584 | (<= math-normalize-a (- math-small-integer-size))) |
| 2585 | (math-bignum math-normalize-a) |
| 2586 | math-normalize-a) |
| 2587 | math-normalize-a)) |
| 2588 | ((eq (car math-normalize-a) 'bigpos) |
| 2589 | (if (eq (nth (1- (length math-normalize-a)) math-normalize-a) 0) |
| 2590 | (let* ((last (setq math-normalize-a |
| 2591 | (copy-sequence math-normalize-a))) (digs math-normalize-a)) |
| 2592 | (while (setq digs (cdr digs)) |
| 2593 | (or (eq (car digs) 0) (setq last digs))) |
| 2594 | (setcdr last nil))) |
| 2595 | (if (cdr (cdr (cdr math-normalize-a))) |
| 2596 | math-normalize-a |
| 2597 | (cond |
| 2598 | ((cdr (cdr math-normalize-a)) (+ (nth 1 math-normalize-a) |
| 2599 | (* (nth 2 math-normalize-a) |
| 2600 | math-bignum-digit-size))) |
| 2601 | ((cdr math-normalize-a) (nth 1 math-normalize-a)) |
| 2602 | (t 0)))) |
| 2603 | ((eq (car math-normalize-a) 'bigneg) |
| 2604 | (if (eq (nth (1- (length math-normalize-a)) math-normalize-a) 0) |
| 2605 | (let* ((last (setq math-normalize-a (copy-sequence math-normalize-a))) |
| 2606 | (digs math-normalize-a)) |
| 2607 | (while (setq digs (cdr digs)) |
| 2608 | (or (eq (car digs) 0) (setq last digs))) |
| 2609 | (setcdr last nil))) |
| 2610 | (if (cdr (cdr (cdr math-normalize-a))) |
| 2611 | math-normalize-a |
| 2612 | (cond |
| 2613 | ((cdr (cdr math-normalize-a)) (- (+ (nth 1 math-normalize-a) |
| 2614 | (* (nth 2 math-normalize-a) |
| 2615 | math-bignum-digit-size)))) |
| 2616 | ((cdr math-normalize-a) (- (nth 1 math-normalize-a))) |
| 2617 | (t 0)))) |
| 2618 | ((eq (car math-normalize-a) 'float) |
| 2619 | (math-make-float (math-normalize (nth 1 math-normalize-a)) |
| 2620 | (nth 2 math-normalize-a))) |
| 2621 | ((or (memq (car math-normalize-a) |
| 2622 | '(frac cplx polar hms date mod sdev intv vec var quote |
| 2623 | special-const calcFunc-if calcFunc-lambda |
| 2624 | calcFunc-quote calcFunc-condition |
| 2625 | calcFunc-evalto)) |
| 2626 | (integerp (car math-normalize-a)) |
| 2627 | (and (consp (car math-normalize-a)) |
| 2628 | (not (eq (car (car math-normalize-a)) 'lambda)))) |
| 2629 | (require 'calc-ext) |
| 2630 | (math-normalize-fancy math-normalize-a)) |
| 2631 | (t |
| 2632 | (or (and calc-simplify-mode |
| 2633 | (require 'calc-ext) |
| 2634 | (math-normalize-nonstandard)) |
| 2635 | (let ((args (mapcar 'math-normalize (cdr math-normalize-a)))) |
| 2636 | (or (condition-case err |
| 2637 | (let ((func |
| 2638 | (assq (car math-normalize-a) '( ( + . math-add ) |
| 2639 | ( - . math-sub ) |
| 2640 | ( * . math-mul ) |
| 2641 | ( / . math-div ) |
| 2642 | ( % . math-mod ) |
| 2643 | ( ^ . math-pow ) |
| 2644 | ( neg . math-neg ) |
| 2645 | ( | . math-concat ) )))) |
| 2646 | (or (and var-EvalRules |
| 2647 | (progn |
| 2648 | (or (eq var-EvalRules math-eval-rules-cache-tag) |
| 2649 | (progn |
| 2650 | (require 'calc-ext) |
| 2651 | (math-recompile-eval-rules))) |
| 2652 | (and (or math-eval-rules-cache-other |
| 2653 | (assq (car math-normalize-a) |
| 2654 | math-eval-rules-cache)) |
| 2655 | (math-apply-rewrites |
| 2656 | (cons (car math-normalize-a) args) |
| 2657 | (cdr math-eval-rules-cache) |
| 2658 | nil math-eval-rules-cache)))) |
| 2659 | (if func |
| 2660 | (apply (cdr func) args) |
| 2661 | (and (or (consp (car math-normalize-a)) |
| 2662 | (fboundp (car math-normalize-a)) |
| 2663 | (and (not (featurep 'calc-ext)) |
| 2664 | (require 'calc-ext) |
| 2665 | (fboundp (car math-normalize-a)))) |
| 2666 | (apply (car math-normalize-a) args))))) |
| 2667 | (wrong-number-of-arguments |
| 2668 | (calc-record-why "*Wrong number of arguments" |
| 2669 | (cons (car math-normalize-a) args)) |
| 2670 | nil) |
| 2671 | (wrong-type-argument |
| 2672 | (or calc-next-why |
| 2673 | (calc-record-why "Wrong type of argument" |
| 2674 | (cons (car math-normalize-a) args))) |
| 2675 | nil) |
| 2676 | (args-out-of-range |
| 2677 | (calc-record-why "*Argument out of range" |
| 2678 | (cons (car math-normalize-a) args)) |
| 2679 | nil) |
| 2680 | (inexact-result |
| 2681 | (calc-record-why "No exact representation for result" |
| 2682 | (cons (car math-normalize-a) args)) |
| 2683 | nil) |
| 2684 | (math-overflow |
| 2685 | (calc-record-why "*Floating-point overflow occurred" |
| 2686 | (cons (car math-normalize-a) args)) |
| 2687 | nil) |
| 2688 | (math-underflow |
| 2689 | (calc-record-why "*Floating-point underflow occurred" |
| 2690 | (cons (car math-normalize-a) args)) |
| 2691 | nil) |
| 2692 | (void-variable |
| 2693 | (if (eq (nth 1 err) 'var-EvalRules) |
| 2694 | (progn |
| 2695 | (setq var-EvalRules nil) |
| 2696 | (math-normalize (cons (car math-normalize-a) args))) |
| 2697 | (calc-record-why "*Variable is void" (nth 1 err))))) |
| 2698 | (if (consp (car math-normalize-a)) |
| 2699 | (math-dimension-error) |
| 2700 | (cons (car math-normalize-a) args)))))))) |
| 2701 | |
| 2702 | |
| 2703 | |
| 2704 | ;; True if A is a floating-point real or complex number. [P x] [Public] |
| 2705 | (defun math-floatp (a) |
| 2706 | (cond ((eq (car-safe a) 'float) t) |
| 2707 | ((memq (car-safe a) '(cplx polar mod sdev intv)) |
| 2708 | (or (math-floatp (nth 1 a)) |
| 2709 | (math-floatp (nth 2 a)) |
| 2710 | (and (eq (car a) 'intv) (math-floatp (nth 3 a))))) |
| 2711 | ((eq (car-safe a) 'date) |
| 2712 | (math-floatp (nth 1 a))))) |
| 2713 | |
| 2714 | |
| 2715 | |
| 2716 | ;; Verify that A is a complete object and return A. [x x] [Public] |
| 2717 | (defun math-check-complete (a) |
| 2718 | (cond ((integerp a) a) |
| 2719 | ((eq (car-safe a) 'incomplete) |
| 2720 | (calc-incomplete-error a)) |
| 2721 | ((consp a) a) |
| 2722 | (t (error "Invalid data object encountered")))) |
| 2723 | |
| 2724 | |
| 2725 | |
| 2726 | ;; Coerce integer A to be a bignum. [B S] |
| 2727 | (defun math-bignum (a) |
| 2728 | (if (>= a 0) |
| 2729 | (cons 'bigpos (math-bignum-big a)) |
| 2730 | (cons 'bigneg (math-bignum-big (- a))))) |
| 2731 | |
| 2732 | (defun math-bignum-big (a) ; [L s] |
| 2733 | (if (= a 0) |
| 2734 | nil |
| 2735 | (cons (% a math-bignum-digit-size) |
| 2736 | (math-bignum-big (/ a math-bignum-digit-size))))) |
| 2737 | |
| 2738 | |
| 2739 | ;; Build a normalized floating-point number. [F I S] |
| 2740 | (defun math-make-float (mant exp) |
| 2741 | (if (eq mant 0) |
| 2742 | '(float 0 0) |
| 2743 | (let* ((ldiff (- calc-internal-prec (math-numdigs mant)))) |
| 2744 | (if (< ldiff 0) |
| 2745 | (setq mant (math-scale-rounding mant ldiff) |
| 2746 | exp (- exp ldiff)))) |
| 2747 | (if (consp mant) |
| 2748 | (let ((digs (cdr mant))) |
| 2749 | (if (= (% (car digs) 10) 0) |
| 2750 | (progn |
| 2751 | (while (= (car digs) 0) |
| 2752 | (setq digs (cdr digs) |
| 2753 | exp (+ exp math-bignum-digit-length))) |
| 2754 | (while (= (% (car digs) 10) 0) |
| 2755 | (setq digs (math-div10-bignum digs) |
| 2756 | exp (1+ exp))) |
| 2757 | (setq mant (math-normalize (cons (car mant) digs)))))) |
| 2758 | (while (= (% mant 10) 0) |
| 2759 | (setq mant (/ mant 10) |
| 2760 | exp (1+ exp)))) |
| 2761 | (if (and (<= exp -4000000) |
| 2762 | (<= (+ exp (math-numdigs mant) -1) -4000000)) |
| 2763 | (signal 'math-underflow nil) |
| 2764 | (if (and (>= exp 3000000) |
| 2765 | (>= (+ exp (math-numdigs mant) -1) 4000000)) |
| 2766 | (signal 'math-overflow nil) |
| 2767 | (list 'float mant exp))))) |
| 2768 | |
| 2769 | (defun math-div10-bignum (a) ; [l l] |
| 2770 | (if (cdr a) |
| 2771 | (cons (+ (/ (car a) 10) (* (% (nth 1 a) 10) |
| 2772 | (expt 10 (1- math-bignum-digit-length)))) |
| 2773 | (math-div10-bignum (cdr a))) |
| 2774 | (list (/ (car a) 10)))) |
| 2775 | |
| 2776 | ;;; Coerce A to be a float. [F N; V V] [Public] |
| 2777 | (defun math-float (a) |
| 2778 | (cond ((Math-integerp a) (math-make-float a 0)) |
| 2779 | ((eq (car a) 'frac) (math-div (math-float (nth 1 a)) (nth 2 a))) |
| 2780 | ((eq (car a) 'float) a) |
| 2781 | ((memq (car a) '(cplx polar vec hms date sdev mod)) |
| 2782 | (cons (car a) (mapcar 'math-float (cdr a)))) |
| 2783 | (t (math-float-fancy a)))) |
| 2784 | |
| 2785 | |
| 2786 | (defun math-neg (a) |
| 2787 | (cond ((not (consp a)) (- a)) |
| 2788 | ((eq (car a) 'bigpos) (cons 'bigneg (cdr a))) |
| 2789 | ((eq (car a) 'bigneg) (cons 'bigpos (cdr a))) |
| 2790 | ((memq (car a) '(frac float)) |
| 2791 | (list (car a) (Math-integer-neg (nth 1 a)) (nth 2 a))) |
| 2792 | ((memq (car a) '(cplx vec hms date calcFunc-idn)) |
| 2793 | (cons (car a) (mapcar 'math-neg (cdr a)))) |
| 2794 | (t (math-neg-fancy a)))) |
| 2795 | |
| 2796 | |
| 2797 | ;;; Compute the number of decimal digits in integer A. [S I] |
| 2798 | (defun math-numdigs (a) |
| 2799 | (if (consp a) |
| 2800 | (if (cdr a) |
| 2801 | (let* ((len (1- (length a))) |
| 2802 | (top (nth len a))) |
| 2803 | (+ (* (1- len) math-bignum-digit-length) (math-numdigs top))) |
| 2804 | 0) |
| 2805 | (cond ((>= a 100) (+ (math-numdigs (/ a 1000)) 3)) |
| 2806 | ((>= a 10) 2) |
| 2807 | ((>= a 1) 1) |
| 2808 | ((= a 0) 0) |
| 2809 | ((> a -10) 1) |
| 2810 | ((> a -100) 2) |
| 2811 | (t (math-numdigs (- a)))))) |
| 2812 | |
| 2813 | ;;; Multiply (with truncation toward 0) the integer A by 10^N. [I i S] |
| 2814 | (defun math-scale-int (a n) |
| 2815 | (cond ((= n 0) a) |
| 2816 | ((> n 0) (math-scale-left a n)) |
| 2817 | (t (math-normalize (math-scale-right a (- n)))))) |
| 2818 | |
| 2819 | (defun math-scale-left (a n) ; [I I S] |
| 2820 | (if (= n 0) |
| 2821 | a |
| 2822 | (if (consp a) |
| 2823 | (cons (car a) (math-scale-left-bignum (cdr a) n)) |
| 2824 | (if (>= n math-bignum-digit-length) |
| 2825 | (if (or (>= a math-bignum-digit-size) |
| 2826 | (<= a (- math-bignum-digit-size))) |
| 2827 | (math-scale-left (math-bignum a) n) |
| 2828 | (math-scale-left (* a math-bignum-digit-size) |
| 2829 | (- n math-bignum-digit-length))) |
| 2830 | (let ((sz (expt 10 (- (* 2 math-bignum-digit-length) n)))) |
| 2831 | (if (or (>= a sz) (<= a (- sz))) |
| 2832 | (math-scale-left (math-bignum a) n) |
| 2833 | (* a (expt 10 n)))))))) |
| 2834 | |
| 2835 | (defun math-scale-left-bignum (a n) |
| 2836 | (if (>= n math-bignum-digit-length) |
| 2837 | (while (>= (setq a (cons 0 a) |
| 2838 | n (- n math-bignum-digit-length)) |
| 2839 | math-bignum-digit-length))) |
| 2840 | (if (> n 0) |
| 2841 | (math-mul-bignum-digit a (expt 10 n) 0) |
| 2842 | a)) |
| 2843 | |
| 2844 | (defun math-scale-right (a n) ; [i i S] |
| 2845 | (if (= n 0) |
| 2846 | a |
| 2847 | (if (consp a) |
| 2848 | (cons (car a) (math-scale-right-bignum (cdr a) n)) |
| 2849 | (if (<= a 0) |
| 2850 | (if (= a 0) |
| 2851 | 0 |
| 2852 | (- (math-scale-right (- a) n))) |
| 2853 | (if (>= n math-bignum-digit-length) |
| 2854 | (while (and (> (setq a (/ a math-bignum-digit-size)) 0) |
| 2855 | (>= (setq n (- n math-bignum-digit-length)) |
| 2856 | math-bignum-digit-length)))) |
| 2857 | (if (> n 0) |
| 2858 | (/ a (expt 10 n)) |
| 2859 | a))))) |
| 2860 | |
| 2861 | (defun math-scale-right-bignum (a n) ; [L L S; l l S] |
| 2862 | (if (>= n math-bignum-digit-length) |
| 2863 | (setq a (nthcdr (/ n math-bignum-digit-length) a) |
| 2864 | n (% n math-bignum-digit-length))) |
| 2865 | (if (> n 0) |
| 2866 | (cdr (math-mul-bignum-digit a (expt 10 (- math-bignum-digit-length n)) 0)) |
| 2867 | a)) |
| 2868 | |
| 2869 | ;;; Multiply (with rounding) the integer A by 10^N. [I i S] |
| 2870 | (defun math-scale-rounding (a n) |
| 2871 | (cond ((>= n 0) |
| 2872 | (math-scale-left a n)) |
| 2873 | ((consp a) |
| 2874 | (math-normalize |
| 2875 | (cons (car a) |
| 2876 | (let ((val (if (< n (- math-bignum-digit-length)) |
| 2877 | (math-scale-right-bignum |
| 2878 | (cdr a) |
| 2879 | (- (- math-bignum-digit-length) n)) |
| 2880 | (if (< n 0) |
| 2881 | (math-mul-bignum-digit |
| 2882 | (cdr a) |
| 2883 | (expt 10 (+ math-bignum-digit-length n)) 0) |
| 2884 | (cdr a))))) ; n = -math-bignum-digit-length |
| 2885 | (if (and val (>= (car val) (/ math-bignum-digit-size 2))) |
| 2886 | (if (cdr val) |
| 2887 | (if (eq (car (cdr val)) (1- math-bignum-digit-size)) |
| 2888 | (math-add-bignum (cdr val) '(1)) |
| 2889 | (cons (1+ (car (cdr val))) (cdr (cdr val)))) |
| 2890 | '(1)) |
| 2891 | (cdr val)))))) |
| 2892 | (t |
| 2893 | (if (< a 0) |
| 2894 | (- (math-scale-rounding (- a) n)) |
| 2895 | (if (= n -1) |
| 2896 | (/ (+ a 5) 10) |
| 2897 | (/ (+ (math-scale-right a (- -1 n)) 5) 10)))))) |
| 2898 | |
| 2899 | |
| 2900 | ;;; Compute the sum of A and B. [O O O] [Public] |
| 2901 | (defun math-add (a b) |
| 2902 | (or |
| 2903 | (and (not (or (consp a) (consp b))) |
| 2904 | (progn |
| 2905 | (setq a (+ a b)) |
| 2906 | (if (or (<= a (- math-small-integer-size)) (>= a math-small-integer-size)) |
| 2907 | (math-bignum a) |
| 2908 | a))) |
| 2909 | (and (Math-zerop a) (not (eq (car-safe a) 'mod)) |
| 2910 | (if (and (math-floatp a) (Math-ratp b)) (math-float b) b)) |
| 2911 | (and (Math-zerop b) (not (eq (car-safe b) 'mod)) |
| 2912 | (if (and (math-floatp b) (Math-ratp a)) (math-float a) a)) |
| 2913 | (and (Math-objvecp a) (Math-objvecp b) |
| 2914 | (or |
| 2915 | (and (Math-integerp a) (Math-integerp b) |
| 2916 | (progn |
| 2917 | (or (consp a) (setq a (math-bignum a))) |
| 2918 | (or (consp b) (setq b (math-bignum b))) |
| 2919 | (if (eq (car a) 'bigneg) |
| 2920 | (if (eq (car b) 'bigneg) |
| 2921 | (cons 'bigneg (math-add-bignum (cdr a) (cdr b))) |
| 2922 | (math-normalize |
| 2923 | (let ((diff (math-sub-bignum (cdr b) (cdr a)))) |
| 2924 | (if (eq diff 'neg) |
| 2925 | (cons 'bigneg (math-sub-bignum (cdr a) (cdr b))) |
| 2926 | (cons 'bigpos diff))))) |
| 2927 | (if (eq (car b) 'bigneg) |
| 2928 | (math-normalize |
| 2929 | (let ((diff (math-sub-bignum (cdr a) (cdr b)))) |
| 2930 | (if (eq diff 'neg) |
| 2931 | (cons 'bigneg (math-sub-bignum (cdr b) (cdr a))) |
| 2932 | (cons 'bigpos diff)))) |
| 2933 | (cons 'bigpos (math-add-bignum (cdr a) (cdr b))))))) |
| 2934 | (and (Math-ratp a) (Math-ratp b) |
| 2935 | (require 'calc-ext) |
| 2936 | (calc-add-fractions a b)) |
| 2937 | (and (Math-realp a) (Math-realp b) |
| 2938 | (progn |
| 2939 | (or (and (consp a) (eq (car a) 'float)) |
| 2940 | (setq a (math-float a))) |
| 2941 | (or (and (consp b) (eq (car b) 'float)) |
| 2942 | (setq b (math-float b))) |
| 2943 | (math-add-float a b))) |
| 2944 | (and (require 'calc-ext) |
| 2945 | (math-add-objects-fancy a b)))) |
| 2946 | (and (require 'calc-ext) |
| 2947 | (math-add-symb-fancy a b)))) |
| 2948 | |
| 2949 | (defun math-add-bignum (a b) ; [L L L; l l l] |
| 2950 | (if a |
| 2951 | (if b |
| 2952 | (let* ((a (copy-sequence a)) (aa a) (carry nil) sum) |
| 2953 | (while (and aa b) |
| 2954 | (if carry |
| 2955 | (if (< (setq sum (+ (car aa) (car b))) |
| 2956 | (1- math-bignum-digit-size)) |
| 2957 | (progn |
| 2958 | (setcar aa (1+ sum)) |
| 2959 | (setq carry nil)) |
| 2960 | (setcar aa (- sum (1- math-bignum-digit-size)))) |
| 2961 | (if (< (setq sum (+ (car aa) (car b))) math-bignum-digit-size) |
| 2962 | (setcar aa sum) |
| 2963 | (setcar aa (- sum math-bignum-digit-size)) |
| 2964 | (setq carry t))) |
| 2965 | (setq aa (cdr aa) |
| 2966 | b (cdr b))) |
| 2967 | (if carry |
| 2968 | (if b |
| 2969 | (nconc a (math-add-bignum b '(1))) |
| 2970 | (while (eq (car aa) (1- math-bignum-digit-size)) |
| 2971 | (setcar aa 0) |
| 2972 | (setq aa (cdr aa))) |
| 2973 | (if aa |
| 2974 | (progn |
| 2975 | (setcar aa (1+ (car aa))) |
| 2976 | a) |
| 2977 | (nconc a '(1)))) |
| 2978 | (if b |
| 2979 | (nconc a b) |
| 2980 | a))) |
| 2981 | a) |
| 2982 | b)) |
| 2983 | |
| 2984 | (defun math-sub-bignum (a b) ; [l l l] |
| 2985 | (if b |
| 2986 | (if a |
| 2987 | (let* ((a (copy-sequence a)) (aa a) (borrow nil) sum diff) |
| 2988 | (while (and aa b) |
| 2989 | (if borrow |
| 2990 | (if (>= (setq diff (- (car aa) (car b))) 1) |
| 2991 | (progn |
| 2992 | (setcar aa (1- diff)) |
| 2993 | (setq borrow nil)) |
| 2994 | (setcar aa (+ diff (1- math-bignum-digit-size)))) |
| 2995 | (if (>= (setq diff (- (car aa) (car b))) 0) |
| 2996 | (setcar aa diff) |
| 2997 | (setcar aa (+ diff math-bignum-digit-size)) |
| 2998 | (setq borrow t))) |
| 2999 | (setq aa (cdr aa) |
| 3000 | b (cdr b))) |
| 3001 | (if borrow |
| 3002 | (progn |
| 3003 | (while (eq (car aa) 0) |
| 3004 | (setcar aa (1- math-bignum-digit-size)) |
| 3005 | (setq aa (cdr aa))) |
| 3006 | (if aa |
| 3007 | (progn |
| 3008 | (setcar aa (1- (car aa))) |
| 3009 | a) |
| 3010 | 'neg)) |
| 3011 | (while (eq (car b) 0) |
| 3012 | (setq b (cdr b))) |
| 3013 | (if b |
| 3014 | 'neg |
| 3015 | a))) |
| 3016 | (while (eq (car b) 0) |
| 3017 | (setq b (cdr b))) |
| 3018 | (and b |
| 3019 | 'neg)) |
| 3020 | a)) |
| 3021 | |
| 3022 | (defun math-add-float (a b) ; [F F F] |
| 3023 | (let ((ediff (- (nth 2 a) (nth 2 b)))) |
| 3024 | (if (>= ediff 0) |
| 3025 | (if (>= ediff (+ calc-internal-prec calc-internal-prec)) |
| 3026 | a |
| 3027 | (math-make-float (math-add (nth 1 b) |
| 3028 | (if (eq ediff 0) |
| 3029 | (nth 1 a) |
| 3030 | (math-scale-left (nth 1 a) ediff))) |
| 3031 | (nth 2 b))) |
| 3032 | (if (>= (setq ediff (- ediff)) |
| 3033 | (+ calc-internal-prec calc-internal-prec)) |
| 3034 | b |
| 3035 | (math-make-float (math-add (nth 1 a) |
| 3036 | (math-scale-left (nth 1 b) ediff)) |
| 3037 | (nth 2 a)))))) |
| 3038 | |
| 3039 | ;;; Compute the difference of A and B. [O O O] [Public] |
| 3040 | (defun math-sub (a b) |
| 3041 | (if (or (consp a) (consp b)) |
| 3042 | (math-add a (math-neg b)) |
| 3043 | (setq a (- a b)) |
| 3044 | (if (or (<= a (- math-small-integer-size)) (>= a math-small-integer-size)) |
| 3045 | (math-bignum a) |
| 3046 | a))) |
| 3047 | |
| 3048 | (defun math-sub-float (a b) ; [F F F] |
| 3049 | (let ((ediff (- (nth 2 a) (nth 2 b)))) |
| 3050 | (if (>= ediff 0) |
| 3051 | (if (>= ediff (+ calc-internal-prec calc-internal-prec)) |
| 3052 | a |
| 3053 | (math-make-float (math-add (Math-integer-neg (nth 1 b)) |
| 3054 | (if (eq ediff 0) |
| 3055 | (nth 1 a) |
| 3056 | (math-scale-left (nth 1 a) ediff))) |
| 3057 | (nth 2 b))) |
| 3058 | (if (>= (setq ediff (- ediff)) |
| 3059 | (+ calc-internal-prec calc-internal-prec)) |
| 3060 | b |
| 3061 | (math-make-float (math-add (nth 1 a) |
| 3062 | (Math-integer-neg |
| 3063 | (math-scale-left (nth 1 b) ediff))) |
| 3064 | (nth 2 a)))))) |
| 3065 | |
| 3066 | |
| 3067 | ;;; Compute the product of A and B. [O O O] [Public] |
| 3068 | (defun math-mul (a b) |
| 3069 | (or |
| 3070 | (and (not (consp a)) (not (consp b)) |
| 3071 | (< a math-bignum-digit-size) (> a (- math-bignum-digit-size)) |
| 3072 | (< b math-bignum-digit-size) (> b (- math-bignum-digit-size)) |
| 3073 | (* a b)) |
| 3074 | (and (Math-zerop a) (not (eq (car-safe b) 'mod)) |
| 3075 | (if (Math-scalarp b) |
| 3076 | (if (and (math-floatp b) (Math-ratp a)) (math-float a) a) |
| 3077 | (require 'calc-ext) |
| 3078 | (math-mul-zero a b))) |
| 3079 | (and (Math-zerop b) (not (eq (car-safe a) 'mod)) |
| 3080 | (if (Math-scalarp a) |
| 3081 | (if (and (math-floatp a) (Math-ratp b)) (math-float b) b) |
| 3082 | (require 'calc-ext) |
| 3083 | (math-mul-zero b a))) |
| 3084 | (and (Math-objvecp a) (Math-objvecp b) |
| 3085 | (or |
| 3086 | (and (Math-integerp a) (Math-integerp b) |
| 3087 | (progn |
| 3088 | (or (consp a) (setq a (math-bignum a))) |
| 3089 | (or (consp b) (setq b (math-bignum b))) |
| 3090 | (math-normalize |
| 3091 | (cons (if (eq (car a) (car b)) 'bigpos 'bigneg) |
| 3092 | (if (cdr (cdr a)) |
| 3093 | (if (cdr (cdr b)) |
| 3094 | (math-mul-bignum (cdr a) (cdr b)) |
| 3095 | (math-mul-bignum-digit (cdr a) (nth 1 b) 0)) |
| 3096 | (math-mul-bignum-digit (cdr b) (nth 1 a) 0)))))) |
| 3097 | (and (Math-ratp a) (Math-ratp b) |
| 3098 | (require 'calc-ext) |
| 3099 | (calc-mul-fractions a b)) |
| 3100 | (and (Math-realp a) (Math-realp b) |
| 3101 | (progn |
| 3102 | (or (and (consp a) (eq (car a) 'float)) |
| 3103 | (setq a (math-float a))) |
| 3104 | (or (and (consp b) (eq (car b) 'float)) |
| 3105 | (setq b (math-float b))) |
| 3106 | (math-make-float (math-mul (nth 1 a) (nth 1 b)) |
| 3107 | (+ (nth 2 a) (nth 2 b))))) |
| 3108 | (and (require 'calc-ext) |
| 3109 | (math-mul-objects-fancy a b)))) |
| 3110 | (and (require 'calc-ext) |
| 3111 | (math-mul-symb-fancy a b)))) |
| 3112 | |
| 3113 | (defun math-infinitep (a &optional undir) |
| 3114 | (while (and (consp a) (memq (car a) '(* / neg))) |
| 3115 | (if (or (not (eq (car a) '*)) (math-infinitep (nth 1 a))) |
| 3116 | (setq a (nth 1 a)) |
| 3117 | (setq a (nth 2 a)))) |
| 3118 | (and (consp a) |
| 3119 | (eq (car a) 'var) |
| 3120 | (memq (nth 2 a) '(var-inf var-uinf var-nan)) |
| 3121 | (if (and undir (eq (nth 2 a) 'var-inf)) |
| 3122 | '(var uinf var-uinf) |
| 3123 | a))) |
| 3124 | |
| 3125 | ;;; Multiply digit lists A and B. [L L L; l l l] |
| 3126 | (defun math-mul-bignum (a b) |
| 3127 | (and a b |
| 3128 | (let* ((sum (if (<= (car b) 1) |
| 3129 | (if (= (car b) 0) |
| 3130 | (list 0) |
| 3131 | (copy-sequence a)) |
| 3132 | (math-mul-bignum-digit a (car b) 0))) |
| 3133 | (sump sum) c d aa ss prod) |
| 3134 | (while (setq b (cdr b)) |
| 3135 | (setq ss (setq sump (or (cdr sump) (setcdr sump (list 0)))) |
| 3136 | d (car b) |
| 3137 | c 0 |
| 3138 | aa a) |
| 3139 | (while (progn |
| 3140 | (setcar ss (% (setq prod (+ (+ (car ss) (* (car aa) d)) |
| 3141 | c)) math-bignum-digit-size)) |
| 3142 | (setq aa (cdr aa))) |
| 3143 | (setq c (/ prod math-bignum-digit-size) |
| 3144 | ss (or (cdr ss) (setcdr ss (list 0))))) |
| 3145 | (if (>= prod math-bignum-digit-size) |
| 3146 | (if (cdr ss) |
| 3147 | (setcar (cdr ss) (+ (/ prod math-bignum-digit-size) (car (cdr ss)))) |
| 3148 | (setcdr ss (list (/ prod math-bignum-digit-size)))))) |
| 3149 | sum))) |
| 3150 | |
| 3151 | ;;; Multiply digit list A by digit D. [L L D D; l l D D] |
| 3152 | (defun math-mul-bignum-digit (a d c) |
| 3153 | (if a |
| 3154 | (if (<= d 1) |
| 3155 | (and (= d 1) a) |
| 3156 | (let* ((a (copy-sequence a)) (aa a) prod) |
| 3157 | (while (progn |
| 3158 | (setcar aa |
| 3159 | (% (setq prod (+ (* (car aa) d) c)) |
| 3160 | math-bignum-digit-size)) |
| 3161 | (cdr aa)) |
| 3162 | (setq aa (cdr aa) |
| 3163 | c (/ prod math-bignum-digit-size))) |
| 3164 | (if (>= prod math-bignum-digit-size) |
| 3165 | (setcdr aa (list (/ prod math-bignum-digit-size)))) |
| 3166 | a)) |
| 3167 | (and (> c 0) |
| 3168 | (list c)))) |
| 3169 | |
| 3170 | |
| 3171 | ;;; Compute the integer (quotient . remainder) of A and B, which may be |
| 3172 | ;;; small or big integers. Type and consistency of truncation is undefined |
| 3173 | ;;; if A or B is negative. B must be nonzero. [I.I I I] [Public] |
| 3174 | (defun math-idivmod (a b) |
| 3175 | (if (eq b 0) |
| 3176 | (math-reject-arg a "*Division by zero")) |
| 3177 | (if (or (consp a) (consp b)) |
| 3178 | (if (and (natnump b) (< b math-bignum-digit-size)) |
| 3179 | (let ((res (math-div-bignum-digit (cdr a) b))) |
| 3180 | (cons |
| 3181 | (math-normalize (cons (car a) (car res))) |
| 3182 | (cdr res))) |
| 3183 | (or (consp a) (setq a (math-bignum a))) |
| 3184 | (or (consp b) (setq b (math-bignum b))) |
| 3185 | (let ((res (math-div-bignum (cdr a) (cdr b)))) |
| 3186 | (cons |
| 3187 | (math-normalize (cons (if (eq (car a) (car b)) 'bigpos 'bigneg) |
| 3188 | (car res))) |
| 3189 | (math-normalize (cons (car a) (cdr res)))))) |
| 3190 | (cons (/ a b) (% a b)))) |
| 3191 | |
| 3192 | (defun math-quotient (a b) ; [I I I] [Public] |
| 3193 | (if (and (not (consp a)) (not (consp b))) |
| 3194 | (if (= b 0) |
| 3195 | (math-reject-arg a "*Division by zero") |
| 3196 | (/ a b)) |
| 3197 | (if (and (natnump b) (< b math-bignum-digit-size)) |
| 3198 | (if (= b 0) |
| 3199 | (math-reject-arg a "*Division by zero") |
| 3200 | (math-normalize (cons (car a) |
| 3201 | (car (math-div-bignum-digit (cdr a) b))))) |
| 3202 | (or (consp a) (setq a (math-bignum a))) |
| 3203 | (or (consp b) (setq b (math-bignum b))) |
| 3204 | (let* ((alen (1- (length a))) |
| 3205 | (blen (1- (length b))) |
| 3206 | (d (/ math-bignum-digit-size (1+ (nth (1- blen) (cdr b))))) |
| 3207 | (res (math-div-bignum-big (math-mul-bignum-digit (cdr a) d 0) |
| 3208 | (math-mul-bignum-digit (cdr b) d 0) |
| 3209 | alen blen))) |
| 3210 | (math-normalize (cons (if (eq (car a) (car b)) 'bigpos 'bigneg) |
| 3211 | (car res))))))) |
| 3212 | |
| 3213 | |
| 3214 | ;;; Divide a bignum digit list by another. [l.l l L] |
| 3215 | ;;; The following division algorithm is borrowed from Knuth vol. II, sec. 4.3.1 |
| 3216 | (defun math-div-bignum (a b) |
| 3217 | (if (cdr b) |
| 3218 | (let* ((alen (length a)) |
| 3219 | (blen (length b)) |
| 3220 | (d (/ math-bignum-digit-size (1+ (nth (1- blen) b)))) |
| 3221 | (res (math-div-bignum-big (math-mul-bignum-digit a d 0) |
| 3222 | (math-mul-bignum-digit b d 0) |
| 3223 | alen blen))) |
| 3224 | (if (= d 1) |
| 3225 | res |
| 3226 | (cons (car res) |
| 3227 | (car (math-div-bignum-digit (cdr res) d))))) |
| 3228 | (let ((res (math-div-bignum-digit a (car b)))) |
| 3229 | (cons (car res) (list (cdr res)))))) |
| 3230 | |
| 3231 | ;;; Divide a bignum digit list by a digit. [l.D l D] |
| 3232 | (defun math-div-bignum-digit (a b) |
| 3233 | (if a |
| 3234 | (let* ((res (math-div-bignum-digit (cdr a) b)) |
| 3235 | (num (+ (* (cdr res) math-bignum-digit-size) (car a)))) |
| 3236 | (cons |
| 3237 | (cons (/ num b) (car res)) |
| 3238 | (% num b))) |
| 3239 | '(nil . 0))) |
| 3240 | |
| 3241 | (defun math-div-bignum-big (a b alen blen) ; [l.l l L] |
| 3242 | (if (< alen blen) |
| 3243 | (cons nil a) |
| 3244 | (let* ((res (math-div-bignum-big (cdr a) b (1- alen) blen)) |
| 3245 | (num (cons (car a) (cdr res))) |
| 3246 | (res2 (math-div-bignum-part num b blen))) |
| 3247 | (cons |
| 3248 | (cons (car res2) (car res)) |
| 3249 | (cdr res2))))) |
| 3250 | |
| 3251 | (defun math-div-bignum-part (a b blen) ; a < b*math-bignum-digit-size [D.l l L] |
| 3252 | (let* ((num (+ (* (or (nth blen a) 0) math-bignum-digit-size) |
| 3253 | (or (nth (1- blen) a) 0))) |
| 3254 | (den (nth (1- blen) b)) |
| 3255 | (guess (min (/ num den) (1- math-bignum-digit-size)))) |
| 3256 | (math-div-bignum-try a b (math-mul-bignum-digit b guess 0) guess))) |
| 3257 | |
| 3258 | (defun math-div-bignum-try (a b c guess) ; [D.l l l D] |
| 3259 | (let ((rem (math-sub-bignum a c))) |
| 3260 | (if (eq rem 'neg) |
| 3261 | (math-div-bignum-try a b (math-sub-bignum c b) (1- guess)) |
| 3262 | (cons guess rem)))) |
| 3263 | |
| 3264 | |
| 3265 | ;;; Compute the quotient of A and B. [O O N] [Public] |
| 3266 | (defun math-div (a b) |
| 3267 | (or |
| 3268 | (and (Math-zerop b) |
| 3269 | (require 'calc-ext) |
| 3270 | (math-div-by-zero a b)) |
| 3271 | (and (Math-zerop a) (not (eq (car-safe b) 'mod)) |
| 3272 | (if (Math-scalarp b) |
| 3273 | (if (and (math-floatp b) (Math-ratp a)) (math-float a) a) |
| 3274 | (require 'calc-ext) |
| 3275 | (math-div-zero a b))) |
| 3276 | (and (Math-objvecp a) (Math-objvecp b) |
| 3277 | (or |
| 3278 | (and (Math-integerp a) (Math-integerp b) |
| 3279 | (let ((q (math-idivmod a b))) |
| 3280 | (if (eq (cdr q) 0) |
| 3281 | (car q) |
| 3282 | (if calc-prefer-frac |
| 3283 | (progn |
| 3284 | (require 'calc-ext) |
| 3285 | (math-make-frac a b)) |
| 3286 | (math-div-float (math-make-float a 0) |
| 3287 | (math-make-float b 0)))))) |
| 3288 | (and (Math-ratp a) (Math-ratp b) |
| 3289 | (require 'calc-ext) |
| 3290 | (calc-div-fractions a b)) |
| 3291 | (and (Math-realp a) (Math-realp b) |
| 3292 | (progn |
| 3293 | (or (and (consp a) (eq (car a) 'float)) |
| 3294 | (setq a (math-float a))) |
| 3295 | (or (and (consp b) (eq (car b) 'float)) |
| 3296 | (setq b (math-float b))) |
| 3297 | (math-div-float a b))) |
| 3298 | (and (require 'calc-ext) |
| 3299 | (math-div-objects-fancy a b)))) |
| 3300 | (and (require 'calc-ext) |
| 3301 | (math-div-symb-fancy a b)))) |
| 3302 | |
| 3303 | (defun math-div-float (a b) ; [F F F] |
| 3304 | (let ((ldiff (max (- (1+ calc-internal-prec) |
| 3305 | (- (math-numdigs (nth 1 a)) (math-numdigs (nth 1 b)))) |
| 3306 | 0))) |
| 3307 | (math-make-float (math-quotient (math-scale-int (nth 1 a) ldiff) (nth 1 b)) |
| 3308 | (- (- (nth 2 a) (nth 2 b)) ldiff)))) |
| 3309 | |
| 3310 | |
| 3311 | |
| 3312 | |
| 3313 | (defvar calc-selection-cache-entry) |
| 3314 | ;;; Format the number A as a string. [X N; X Z] [Public] |
| 3315 | (defun math-format-stack-value (entry) |
| 3316 | (setq calc-selection-cache-entry calc-selection-cache-default-entry) |
| 3317 | (let* ((a (car entry)) |
| 3318 | (math-comp-selected (nth 2 entry)) |
| 3319 | (c (cond ((null a) "<nil>") |
| 3320 | ((eq calc-display-raw t) (format "%s" a)) |
| 3321 | ((stringp a) a) |
| 3322 | ((eq a 'top-of-stack) (propertize "." 'font-lock-face 'bold)) |
| 3323 | (calc-prepared-composition |
| 3324 | calc-prepared-composition) |
| 3325 | ((and (Math-scalarp a) |
| 3326 | (memq calc-language '(nil flat unform)) |
| 3327 | (null math-comp-selected)) |
| 3328 | (math-format-number a)) |
| 3329 | (t (require 'calc-ext) |
| 3330 | (math-compose-expr a 0)))) |
| 3331 | (off (math-stack-value-offset c)) |
| 3332 | s w) |
| 3333 | (and math-comp-selected (setq calc-any-selections t)) |
| 3334 | (setq w (cdr off) |
| 3335 | off (car off)) |
| 3336 | (when (> off 0) |
| 3337 | (setq c (math-comp-concat (make-string off ?\s) c))) |
| 3338 | (or (equal calc-left-label "") |
| 3339 | (setq c (math-comp-concat (if (eq a 'top-of-stack) |
| 3340 | (make-string (length calc-left-label) ?\s) |
| 3341 | calc-left-label) |
| 3342 | c))) |
| 3343 | (when calc-line-numbering |
| 3344 | (setq c (math-comp-concat (if (eq calc-language 'big) |
| 3345 | (if math-comp-selected |
| 3346 | '(tag t "1: ") |
| 3347 | "1: ") |
| 3348 | " ") |
| 3349 | c))) |
| 3350 | (unless (or (equal calc-right-label "") |
| 3351 | (eq a 'top-of-stack)) |
| 3352 | (require 'calc-ext) |
| 3353 | (setq c (list 'horiz c |
| 3354 | (make-string (max (- w (math-comp-width c) |
| 3355 | (length calc-right-label)) 0) ?\s) |
| 3356 | '(break -1) |
| 3357 | calc-right-label))) |
| 3358 | (setq s (if (stringp c) |
| 3359 | (if calc-display-raw |
| 3360 | (prin1-to-string c) |
| 3361 | c) |
| 3362 | (math-composition-to-string c w))) |
| 3363 | (when calc-language-output-filter |
| 3364 | (setq s (funcall calc-language-output-filter s))) |
| 3365 | (if (eq calc-language 'big) |
| 3366 | (setq s (concat s "\n")) |
| 3367 | (when calc-line-numbering |
| 3368 | (setq s (concat "1:" (substring s 2))))) |
| 3369 | (setcar (cdr entry) (calc-count-lines s)) |
| 3370 | s)) |
| 3371 | |
| 3372 | ;; The variables math-svo-c, math-svo-wid and math-svo-off are local |
| 3373 | ;; to math-stack-value-offset, but are used by math-stack-value-offset-fancy |
| 3374 | ;; in calccomp.el. |
| 3375 | |
| 3376 | (defun math-stack-value-offset (math-svo-c) |
| 3377 | (let* ((num (if calc-line-numbering 4 0)) |
| 3378 | (math-svo-wid (calc-window-width)) |
| 3379 | math-svo-off) |
| 3380 | (if calc-display-just |
| 3381 | (progn |
| 3382 | (require 'calc-ext) |
| 3383 | (math-stack-value-offset-fancy)) |
| 3384 | (setq math-svo-off (or calc-display-origin 0)) |
| 3385 | (when (integerp calc-line-breaking) |
| 3386 | (setq math-svo-wid calc-line-breaking))) |
| 3387 | (cons (max (- math-svo-off (length calc-left-label)) 0) |
| 3388 | (+ math-svo-wid num)))) |
| 3389 | |
| 3390 | (defun calc-count-lines (s) |
| 3391 | (let ((pos 0) |
| 3392 | (num 1)) |
| 3393 | (while (setq pos (string-match "\n" s pos)) |
| 3394 | (setq pos (1+ pos) |
| 3395 | num (1+ num))) |
| 3396 | num)) |
| 3397 | |
| 3398 | (defun math-format-value (a &optional w) |
| 3399 | (if (and (Math-scalarp a) |
| 3400 | (memq calc-language '(nil flat unform))) |
| 3401 | (math-format-number a) |
| 3402 | (require 'calc-ext) |
| 3403 | (let ((calc-line-breaking nil)) |
| 3404 | (math-composition-to-string (math-compose-expr a 0) w)))) |
| 3405 | |
| 3406 | (defun calc-window-width () |
| 3407 | (if calc-embedded-info |
| 3408 | (let ((win (get-buffer-window (aref calc-embedded-info 0)))) |
| 3409 | (1- (if win (window-width win) (frame-width)))) |
| 3410 | (- (window-width (get-buffer-window (current-buffer))) |
| 3411 | (if calc-line-numbering 5 1)))) |
| 3412 | |
| 3413 | (defun math-comp-concat (c1 c2) |
| 3414 | (if (and (stringp c1) (stringp c2)) |
| 3415 | (concat c1 c2) |
| 3416 | (list 'horiz c1 c2))) |
| 3417 | |
| 3418 | |
| 3419 | |
| 3420 | ;;; Format an expression as a one-line string suitable for re-reading. |
| 3421 | |
| 3422 | (defun math-format-flat-expr (a prec) |
| 3423 | (cond |
| 3424 | ((or (not (or (consp a) (integerp a))) |
| 3425 | (eq calc-display-raw t)) |
| 3426 | (let ((print-escape-newlines t)) |
| 3427 | (concat "'" (prin1-to-string a)))) |
| 3428 | ((Math-scalarp a) |
| 3429 | (let ((calc-group-digits nil) |
| 3430 | (calc-point-char ".") |
| 3431 | (calc-frac-format (if (> (length (car calc-frac-format)) 1) |
| 3432 | '("::" nil) '(":" nil))) |
| 3433 | (calc-complex-format nil) |
| 3434 | (calc-hms-format "%s@ %s' %s\"") |
| 3435 | (calc-language nil)) |
| 3436 | (math-format-number a))) |
| 3437 | (t |
| 3438 | (require 'calc-ext) |
| 3439 | (math-format-flat-expr-fancy a prec)))) |
| 3440 | |
| 3441 | |
| 3442 | |
| 3443 | ;;; Format a number as a string. |
| 3444 | (defvar math-half-2-word-size) |
| 3445 | (defun math-format-number (a &optional prec) ; [X N] [Public] |
| 3446 | (cond |
| 3447 | ((eq calc-display-raw t) (format "%s" a)) |
| 3448 | ((and calc-twos-complement-mode |
| 3449 | math-radix-explicit-format |
| 3450 | (Math-integerp a) |
| 3451 | (or (eq a 0) |
| 3452 | (and (Math-integer-posp a) |
| 3453 | (Math-lessp a math-half-2-word-size)) |
| 3454 | (and (Math-integer-negp a) |
| 3455 | (require 'calc-ext) |
| 3456 | (let ((comparison |
| 3457 | (math-compare (Math-integer-neg a) math-half-2-word-size))) |
| 3458 | (or (= comparison 0) |
| 3459 | (= comparison -1)))))) |
| 3460 | (require 'calc-bin) |
| 3461 | (math-format-twos-complement a)) |
| 3462 | ((and (nth 1 calc-frac-format) (Math-integerp a)) |
| 3463 | (require 'calc-ext) |
| 3464 | (math-format-number (math-adjust-fraction a))) |
| 3465 | ((integerp a) |
| 3466 | (if (not (or calc-group-digits calc-leading-zeros)) |
| 3467 | (if (= calc-number-radix 10) |
| 3468 | (int-to-string a) |
| 3469 | (if (< a 0) |
| 3470 | (concat "-" (math-format-number (- a))) |
| 3471 | (require 'calc-ext) |
| 3472 | (if math-radix-explicit-format |
| 3473 | (if calc-radix-formatter |
| 3474 | (funcall calc-radix-formatter |
| 3475 | calc-number-radix |
| 3476 | (if (= calc-number-radix 2) |
| 3477 | (math-format-binary a) |
| 3478 | (math-format-radix a))) |
| 3479 | (format "%d#%s" calc-number-radix |
| 3480 | (if (= calc-number-radix 2) |
| 3481 | (math-format-binary a) |
| 3482 | (math-format-radix a)))) |
| 3483 | (math-format-radix a)))) |
| 3484 | (math-format-number (math-bignum a)))) |
| 3485 | ((stringp a) a) |
| 3486 | ((not (consp a)) (prin1-to-string a)) |
| 3487 | ((eq (car a) 'bigpos) (math-format-bignum (cdr a))) |
| 3488 | ((eq (car a) 'bigneg) (concat "-" (math-format-bignum (cdr a)))) |
| 3489 | ((and (eq (car a) 'float) (= calc-number-radix 10)) |
| 3490 | (if (Math-integer-negp (nth 1 a)) |
| 3491 | (concat "-" (math-format-number (math-neg a))) |
| 3492 | (let ((mant (nth 1 a)) |
| 3493 | (exp (nth 2 a)) |
| 3494 | (fmt (car calc-float-format)) |
| 3495 | (figs (nth 1 calc-float-format)) |
| 3496 | (point calc-point-char) |
| 3497 | str) |
| 3498 | (if (and (eq fmt 'fix) |
| 3499 | (or (and (< figs 0) (setq figs (- figs))) |
| 3500 | (> (+ exp (math-numdigs mant)) (- figs)))) |
| 3501 | (progn |
| 3502 | (setq mant (math-scale-rounding mant (+ exp figs)) |
| 3503 | str (if (integerp mant) |
| 3504 | (int-to-string mant) |
| 3505 | (math-format-bignum-decimal (cdr mant)))) |
| 3506 | (if (<= (length str) figs) |
| 3507 | (setq str (concat (make-string (1+ (- figs (length str))) ?0) |
| 3508 | str))) |
| 3509 | (if (> figs 0) |
| 3510 | (setq str (concat (substring str 0 (- figs)) point |
| 3511 | (substring str (- figs)))) |
| 3512 | (setq str (concat str point))) |
| 3513 | (when calc-group-digits |
| 3514 | (require 'calc-ext) |
| 3515 | (setq str (math-group-float str)))) |
| 3516 | (when (< figs 0) |
| 3517 | (setq figs (+ calc-internal-prec figs))) |
| 3518 | (when (> figs 0) |
| 3519 | (let ((adj (- figs (math-numdigs mant)))) |
| 3520 | (when (< adj 0) |
| 3521 | (setq mant (math-scale-rounding mant adj) |
| 3522 | exp (- exp adj))))) |
| 3523 | (setq str (if (integerp mant) |
| 3524 | (int-to-string mant) |
| 3525 | (math-format-bignum-decimal (cdr mant)))) |
| 3526 | (let* ((len (length str)) |
| 3527 | (dpos (+ exp len))) |
| 3528 | (if (and (eq fmt 'float) |
| 3529 | (<= dpos (+ calc-internal-prec calc-display-sci-high)) |
| 3530 | (>= dpos (+ calc-display-sci-low 2))) |
| 3531 | (progn |
| 3532 | (cond |
| 3533 | ((= dpos 0) |
| 3534 | (setq str (concat "0" point str))) |
| 3535 | ((and (<= exp 0) (> dpos 0)) |
| 3536 | (setq str (concat (substring str 0 dpos) point |
| 3537 | (substring str dpos)))) |
| 3538 | ((> exp 0) |
| 3539 | (setq str (concat str (make-string exp ?0) point))) |
| 3540 | (t ; (< dpos 0) |
| 3541 | (setq str (concat "0" point |
| 3542 | (make-string (- dpos) ?0) str)))) |
| 3543 | (when calc-group-digits |
| 3544 | (require 'calc-ext) |
| 3545 | (setq str (math-group-float str)))) |
| 3546 | (let* ((eadj (+ exp len)) |
| 3547 | (scale (if (eq fmt 'eng) |
| 3548 | (1+ (math-mod (+ eadj 300002) 3)) |
| 3549 | 1))) |
| 3550 | (if (> scale (length str)) |
| 3551 | (setq str (concat str (make-string (- scale (length str)) |
| 3552 | ?0)))) |
| 3553 | (if (< scale (length str)) |
| 3554 | (setq str (concat (substring str 0 scale) point |
| 3555 | (substring str scale)))) |
| 3556 | (when calc-group-digits |
| 3557 | (require 'calc-ext) |
| 3558 | (setq str (math-group-float str))) |
| 3559 | (setq str (format (if (memq calc-language '(math maple)) |
| 3560 | (if (and prec (> prec 191)) |
| 3561 | "(%s*10.^%d)" "%s*10.^%d") |
| 3562 | "%se%d") |
| 3563 | str (- eadj scale))))))) |
| 3564 | str))) |
| 3565 | (t |
| 3566 | (require 'calc-ext) |
| 3567 | (math-format-number-fancy a prec)))) |
| 3568 | |
| 3569 | (defun math-format-bignum (a) ; [X L] |
| 3570 | (if (and (= calc-number-radix 10) |
| 3571 | (not calc-leading-zeros) |
| 3572 | (not calc-group-digits)) |
| 3573 | (math-format-bignum-decimal a) |
| 3574 | (require 'calc-ext) |
| 3575 | (math-format-bignum-fancy a))) |
| 3576 | |
| 3577 | (defun math-format-bignum-decimal (a) ; [X L] |
| 3578 | (if a |
| 3579 | (let ((s "")) |
| 3580 | (while (cdr (cdr a)) |
| 3581 | (setq s (concat |
| 3582 | (format |
| 3583 | (concat "%0" |
| 3584 | (number-to-string (* 2 math-bignum-digit-length)) |
| 3585 | "d") |
| 3586 | (+ (* (nth 1 a) math-bignum-digit-size) (car a))) s) |
| 3587 | a (cdr (cdr a)))) |
| 3588 | (concat (int-to-string |
| 3589 | (+ (* (or (nth 1 a) 0) math-bignum-digit-size) (car a))) s)) |
| 3590 | "0")) |
| 3591 | |
| 3592 | |
| 3593 | |
| 3594 | ;;; Parse a simple number in string form. [N X] [Public] |
| 3595 | (defun math-read-number (s &optional decimal) |
| 3596 | "Convert the string S into a Calc number." |
| 3597 | (math-normalize |
| 3598 | (save-match-data |
| 3599 | (cond |
| 3600 | |
| 3601 | ;; Integers (most common case) |
| 3602 | ((string-match "\\` *\\([0-9]+\\) *\\'" s) |
| 3603 | (let ((digs (math-match-substring s 1))) |
| 3604 | (if (and (memq calc-language calc-lang-c-type-hex) |
| 3605 | (> (length digs) 1) |
| 3606 | (eq (aref digs 0) ?0) |
| 3607 | (null decimal)) |
| 3608 | (math-read-number (concat "8#" digs)) |
| 3609 | (if (<= (length digs) (* 2 math-bignum-digit-length)) |
| 3610 | (string-to-number digs) |
| 3611 | (cons 'bigpos (math-read-bignum digs)))))) |
| 3612 | |
| 3613 | ;; Clean up the string if necessary |
| 3614 | ((string-match "\\`\\(.*\\)[ \t\n]+\\([^\001]*\\)\\'" s) |
| 3615 | (math-read-number (concat (math-match-substring s 1) |
| 3616 | (math-match-substring s 2)))) |
| 3617 | |
| 3618 | ;; Plus and minus signs |
| 3619 | ((string-match "^[-_+]\\(.*\\)$" s) |
| 3620 | (let ((val (math-read-number (math-match-substring s 1)))) |
| 3621 | (and val (if (eq (aref s 0) ?+) val (math-neg val))))) |
| 3622 | |
| 3623 | ;; Forms that require extensions module |
| 3624 | ((string-match "[^-+0-9eE.]" s) |
| 3625 | (require 'calc-ext) |
| 3626 | (math-read-number-fancy s)) |
| 3627 | |
| 3628 | ;; Decimal point |
| 3629 | ((string-match "^\\([0-9]*\\)\\.\\([0-9]*\\)$" s) |
| 3630 | (let ((int (math-match-substring s 1)) |
| 3631 | (frac (math-match-substring s 2))) |
| 3632 | (let ((ilen (length int)) |
| 3633 | (flen (length frac))) |
| 3634 | (let ((int (if (> ilen 0) (math-read-number int t) 0)) |
| 3635 | (frac (if (> flen 0) (math-read-number frac t) 0))) |
| 3636 | (and int frac (or (> ilen 0) (> flen 0)) |
| 3637 | (list 'float |
| 3638 | (math-add (math-scale-int int flen) frac) |
| 3639 | (- flen))))))) |
| 3640 | |
| 3641 | ;; "e" notation |
| 3642 | ((string-match "^\\(.*\\)[eE]\\([-+]?[0-9]+\\)$" s) |
| 3643 | (let ((mant (math-match-substring s 1)) |
| 3644 | (exp (math-match-substring s 2))) |
| 3645 | (let ((mant (if (> (length mant) 0) (math-read-number mant t) 1)) |
| 3646 | (exp (if (<= (length exp) (if (memq (aref exp 0) '(?+ ?-)) 8 7)) |
| 3647 | (string-to-number exp)))) |
| 3648 | (and mant exp (Math-realp mant) (> exp -4000000) (< exp 4000000) |
| 3649 | (let ((mant (math-float mant))) |
| 3650 | (list 'float (nth 1 mant) (+ (nth 2 mant) exp))))))) |
| 3651 | |
| 3652 | ;; Syntax error! |
| 3653 | (t nil))))) |
| 3654 | |
| 3655 | ;;; Parse a very simple number, keeping all digits. |
| 3656 | (defun math-read-number-simple (s) |
| 3657 | "Convert the string S into a Calc number. |
| 3658 | S is assumed to be a simple number (integer or float without an exponent) |
| 3659 | and all digits are kept, regardless of Calc's current precision." |
| 3660 | (save-match-data |
| 3661 | (cond |
| 3662 | ;; Integer |
| 3663 | ((string-match "^[0-9]+$" s) |
| 3664 | (if (string-match "^\\(0+\\)" s) |
| 3665 | (setq s (substring s (match-end 0)))) |
| 3666 | (if (<= (length s) (* 2 math-bignum-digit-length)) |
| 3667 | (string-to-number s) |
| 3668 | (cons 'bigpos (math-read-bignum s)))) |
| 3669 | ;; Minus sign |
| 3670 | ((string-match "^-[0-9]+$" s) |
| 3671 | (if (<= (length s) (1+ (* 2 math-bignum-digit-length))) |
| 3672 | (string-to-number s) |
| 3673 | (cons 'bigneg (math-read-bignum (substring s 1))))) |
| 3674 | ;; Decimal point |
| 3675 | ((string-match "^\\(-?[0-9]*\\)\\.\\([0-9]*\\)$" s) |
| 3676 | (let ((int (math-match-substring s 1)) |
| 3677 | (frac (math-match-substring s 2))) |
| 3678 | (list 'float (math-read-number-simple (concat int frac)) |
| 3679 | (- (length frac))))) |
| 3680 | ;; Syntax error! |
| 3681 | (t nil)))) |
| 3682 | |
| 3683 | (defun math-match-substring (s n) |
| 3684 | (if (match-beginning n) |
| 3685 | (substring s (match-beginning n) (match-end n)) |
| 3686 | "")) |
| 3687 | |
| 3688 | (defun math-read-bignum (s) ; [l X] |
| 3689 | (if (> (length s) math-bignum-digit-length) |
| 3690 | (cons (string-to-number (substring s (- math-bignum-digit-length))) |
| 3691 | (math-read-bignum (substring s 0 (- math-bignum-digit-length)))) |
| 3692 | (list (string-to-number s)))) |
| 3693 | |
| 3694 | (defconst math-standard-opers |
| 3695 | '( ( "_" calcFunc-subscr 1200 1201 ) |
| 3696 | ( "%" calcFunc-percent 1100 -1 ) |
| 3697 | ( "u!" calcFunc-lnot -1 1000 ) |
| 3698 | ( "mod" mod 400 400 185 ) |
| 3699 | ( "+/-" sdev 300 300 185 ) |
| 3700 | ( "!!" calcFunc-dfact 210 -1 ) |
| 3701 | ( "!" calcFunc-fact 210 -1 ) |
| 3702 | ( "^" ^ 201 200 ) |
| 3703 | ( "**" ^ 201 200 ) |
| 3704 | ( "u+" ident -1 197 ) |
| 3705 | ( "u-" neg -1 197 ) |
| 3706 | ( "/" / 190 191 ) |
| 3707 | ( "%" % 190 191 ) |
| 3708 | ( "\\" calcFunc-idiv 190 191 ) |
| 3709 | ( "+" + 180 181 ) |
| 3710 | ( "-" - 180 181 ) |
| 3711 | ( "|" | 170 171 ) |
| 3712 | ( "<" calcFunc-lt 160 161 ) |
| 3713 | ( ">" calcFunc-gt 160 161 ) |
| 3714 | ( "<=" calcFunc-leq 160 161 ) |
| 3715 | ( ">=" calcFunc-geq 160 161 ) |
| 3716 | ( "=" calcFunc-eq 160 161 ) |
| 3717 | ( "==" calcFunc-eq 160 161 ) |
| 3718 | ( "!=" calcFunc-neq 160 161 ) |
| 3719 | ( "&&" calcFunc-land 110 111 ) |
| 3720 | ( "||" calcFunc-lor 100 101 ) |
| 3721 | ( "?" (math-read-if) 91 90 ) |
| 3722 | ( "!!!" calcFunc-pnot -1 85 ) |
| 3723 | ( "&&&" calcFunc-pand 80 81 ) |
| 3724 | ( "|||" calcFunc-por 75 76 ) |
| 3725 | ( ":=" calcFunc-assign 51 50 ) |
| 3726 | ( "::" calcFunc-condition 45 46 ) |
| 3727 | ( "=>" calcFunc-evalto 40 41 ) |
| 3728 | ( "=>" calcFunc-evalto 40 -1 ))) |
| 3729 | |
| 3730 | (defun math-standard-ops () |
| 3731 | (if calc-multiplication-has-precedence |
| 3732 | (cons |
| 3733 | '( "*" * 196 195 ) |
| 3734 | (cons |
| 3735 | '( "2x" * 196 195 ) |
| 3736 | math-standard-opers)) |
| 3737 | (cons |
| 3738 | '( "*" * 190 191 ) |
| 3739 | (cons |
| 3740 | '( "2x" * 190 191 ) |
| 3741 | math-standard-opers)))) |
| 3742 | |
| 3743 | (defvar math-expr-opers (math-standard-ops)) |
| 3744 | |
| 3745 | (defun math-standard-ops-p () |
| 3746 | (let ((meo (caar math-expr-opers))) |
| 3747 | (and (stringp meo) |
| 3748 | (string= meo "*")))) |
| 3749 | |
| 3750 | (defun math-expr-ops () |
| 3751 | (if (math-standard-ops-p) |
| 3752 | (math-standard-ops) |
| 3753 | math-expr-opers)) |
| 3754 | |
| 3755 | ;;;###autoload |
| 3756 | (defun calc-grab-region (top bot arg) |
| 3757 | "Parse the region as a vector of numbers and push it on the Calculator stack." |
| 3758 | (interactive "r\nP") |
| 3759 | (require 'calc-ext) |
| 3760 | (calc-do-grab-region top bot arg)) |
| 3761 | |
| 3762 | ;;;###autoload |
| 3763 | (defun calc-grab-rectangle (top bot arg) |
| 3764 | "Parse a rectangle as a matrix of numbers and push it on the Calculator stack." |
| 3765 | (interactive "r\nP") |
| 3766 | (require 'calc-ext) |
| 3767 | (calc-do-grab-rectangle top bot arg)) |
| 3768 | |
| 3769 | (defun calc-grab-sum-down (top bot arg) |
| 3770 | "Parse a rectangle as a matrix of numbers and sum its columns." |
| 3771 | (interactive "r\nP") |
| 3772 | (require 'calc-ext) |
| 3773 | (calc-do-grab-rectangle top bot arg 'calcFunc-reduced)) |
| 3774 | |
| 3775 | (defun calc-grab-sum-across (top bot arg) |
| 3776 | "Parse a rectangle as a matrix of numbers and sum its rows." |
| 3777 | (interactive "r\nP") |
| 3778 | (require 'calc-ext) |
| 3779 | (calc-do-grab-rectangle top bot arg 'calcFunc-reducea)) |
| 3780 | |
| 3781 | |
| 3782 | ;;;###autoload |
| 3783 | (defun calc-embedded (arg &optional end obeg oend) |
| 3784 | "Start Calc Embedded mode on the formula surrounding point." |
| 3785 | (interactive "P") |
| 3786 | (require 'calc-ext) |
| 3787 | (calc-do-embedded arg end obeg oend)) |
| 3788 | |
| 3789 | ;;;###autoload |
| 3790 | (defun calc-embedded-activate (&optional arg cbuf) |
| 3791 | "Scan the current editing buffer for all embedded := and => formulas. |
| 3792 | Also looks for the equivalent TeX words, \\gets and \\evalto." |
| 3793 | (interactive "P") |
| 3794 | (calc-do-embedded-activate arg cbuf)) |
| 3795 | |
| 3796 | (defun calc-user-invocation () |
| 3797 | (interactive) |
| 3798 | (unless calc-invocation-macro |
| 3799 | (error "Use `Z I' inside Calc to define a `C-x * Z' keyboard macro")) |
| 3800 | (execute-kbd-macro calc-invocation-macro nil)) |
| 3801 | |
| 3802 | ;;; User-programmability. |
| 3803 | |
| 3804 | ;;;###autoload |
| 3805 | (defmacro defmath (func args &rest body) ; [Public] |
| 3806 | "Define Calc function. |
| 3807 | |
| 3808 | Like `defun' except that code in the body of the definition can |
| 3809 | make use of the full range of Calc data types and the usual |
| 3810 | arithmetic operations are converted to their Calc equivalents. |
| 3811 | |
| 3812 | The prefix `calcFunc-' is added to the specified name to get the |
| 3813 | actual Lisp function name. |
| 3814 | |
| 3815 | See Info node `(calc)Defining Functions'." |
| 3816 | (declare (doc-string 3)) |
| 3817 | (require 'calc-ext) |
| 3818 | (math-do-defmath func args body)) |
| 3819 | |
| 3820 | ;;; Functions needed for Lucid Emacs support. |
| 3821 | |
| 3822 | (defun calc-read-key (&optional optkey) |
| 3823 | (cond ((featurep 'xemacs) |
| 3824 | (let ((event (next-command-event))) |
| 3825 | (let ((key (event-to-character event t t))) |
| 3826 | (or key optkey (error "Expected a plain keystroke")) |
| 3827 | (cons key event)))) |
| 3828 | (t |
| 3829 | (let ((key (read-event))) |
| 3830 | (cons key key))))) |
| 3831 | |
| 3832 | (defun calc-unread-command (&optional input) |
| 3833 | (if (featurep 'xemacs) |
| 3834 | (setq unread-command-event |
| 3835 | (if (integerp input) (character-to-event input) |
| 3836 | (or input last-command-event))) |
| 3837 | (push (or input last-command-event) unread-command-events))) |
| 3838 | |
| 3839 | (defun calc-clear-unread-commands () |
| 3840 | (if (featurep 'xemacs) |
| 3841 | (setq unread-command-event nil) |
| 3842 | (setq unread-command-events nil))) |
| 3843 | |
| 3844 | (defcalcmodevar math-2-word-size |
| 3845 | (math-read-number-simple "4294967296") |
| 3846 | "Two to the power of `calc-word-size'.") |
| 3847 | |
| 3848 | (defcalcmodevar math-half-2-word-size |
| 3849 | (math-read-number-simple "2147483648") |
| 3850 | "One-half of two to the power of `calc-word-size'.") |
| 3851 | |
| 3852 | (when calc-always-load-extensions |
| 3853 | (require 'calc-ext) |
| 3854 | (calc-load-everything)) |
| 3855 | |
| 3856 | |
| 3857 | (run-hooks 'calc-load-hook) |
| 3858 | |
| 3859 | (provide 'calc) |
| 3860 | |
| 3861 | ;; Local variables: |
| 3862 | ;; coding: utf-8 |
| 3863 | ;; End: |
| 3864 | |
| 3865 | ;;; calc.el ends here |