Mercurial > emacs
comparison lisp/calc/calc.el @ 88155:d7ddb3e565de
sync with trunk
author | Henrik Enberg <henrik.enberg@telia.com> |
---|---|
date | Mon, 16 Jan 2006 00:03:54 +0000 |
parents | 0d8b17d428b5 |
children |
comparison
equal
deleted
inserted
replaced
88154:8ce476d3ba36 | 88155:d7ddb3e565de |
---|---|
1 ;;; calc.el --- the GNU Emacs calculator | 1 ;;; calc.el --- the GNU Emacs calculator |
2 | 2 |
3 ;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002 Free Software Foundation, Inc. | 3 ;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, |
4 ;; 2005 Free Software Foundation, Inc. | |
4 | 5 |
5 ;; Author: David Gillespie <daveg@synaptics.com> | 6 ;; Author: David Gillespie <daveg@synaptics.com> |
6 ;; Maintainers: D. Goel <deego@gnufans.org> | 7 ;; Maintainer: Jay Belanger <belanger@truman.edu> |
7 ;; Colin Walters <walters@debian.org> | |
8 ;; Keywords: convenience, extensions | 8 ;; Keywords: convenience, extensions |
9 ;; Version: 2.02g | 9 ;; Version: 2.1 |
10 | 10 |
11 ;; This file is part of GNU Emacs. | 11 ;; This file is part of GNU Emacs. |
12 | 12 |
13 ;; GNU Emacs is distributed in the hope that it will be useful, | 13 ;; GNU Emacs is distributed in the hope that it will be useful, |
14 ;; but WITHOUT ANY WARRANTY. No author or distributor | 14 ;; but WITHOUT ANY WARRANTY. No author or distributor |
202 ;; what may be useful set of confidence levels for different amounts of | 202 ;; what may be useful set of confidence levels for different amounts of |
203 ;; initial information.) | 203 ;; initial information.) |
204 | 204 |
205 ;;; Code: | 205 ;;; Code: |
206 | 206 |
207 (provide 'calc) | |
208 (require 'calc-macs) | 207 (require 'calc-macs) |
209 | 208 |
210 ;;; The "###autoload" comment will be used by Emacs version 19 for | 209 (defgroup calc nil |
211 ;;; maintaining the loaddefs.el file automatically. | 210 "GNU Calc." |
211 :prefix "calc-" | |
212 :tag "Calc" | |
213 :group 'applications) | |
212 | 214 |
213 ;;;###autoload | 215 ;;;###autoload |
214 (defvar calc-info-filename "calc.info" | 216 (defcustom calc-settings-file |
215 "*File name in which to look for the Calculator's Info documentation.") | 217 (convert-standard-filename "~/.calc.el") |
216 | 218 "*File in which to record permanent settings." |
217 ;;;###autoload | 219 :group 'calc |
218 (defvar calc-settings-file user-init-file | 220 :type '(file)) |
219 "*File in which to record permanent settings; default is `user-init-file'.") | 221 |
220 | 222 (defcustom calc-language-alist |
221 ;;;###autoload | 223 '((latex-mode . latex) |
222 (defvar calc-autoload-directory nil | 224 (tex-mode . tex) |
223 "Name of directory from which additional \".elc\" files for Calc should be | 225 (plain-tex-mode . tex) |
224 loaded. Should include a trailing \"/\". | 226 (context-mode . tex) |
225 If nil, use original installation directory. | 227 (nroff-mode . eqn) |
226 This can safely be nil as long as the Calc files are on the load-path.") | 228 (pascal-mode . pascal) |
227 | 229 (c-mode . c) |
228 ;;;###autoload | 230 (c++-mode . c) |
229 (defvar calc-gnuplot-name "gnuplot" | 231 (fortran-mode . fortran) |
230 "*Name of GNUPLOT program, for calc-graph features.") | 232 (f90-mode . fortran)) |
231 | 233 "*Alist of major modes with appropriate Calc languages." |
232 ;;;###autoload | 234 :group 'calc |
233 (defvar calc-gnuplot-plot-command nil | 235 :type '(alist :key-type (symbol :tag "Major mode") |
234 "*Name of command for displaying GNUPLOT output; %s = file name to print.") | 236 :value-type (symbol :tag "Calc language"))) |
235 | 237 |
236 ;;;###autoload | 238 (defcustom calc-embedded-announce-formula |
237 (defvar calc-gnuplot-print-command "lp %s" | 239 "%Embed\n\\(% .*\n\\)*" |
238 "*Name of command for printing GNUPLOT output; %s = file name to print.") | 240 "*A regular expression which is sure to be followed by a calc-embedded formula." |
239 | 241 :group 'calc |
240 (defvar calc-bug-address "deego@gnufans.org" | 242 :type '(regexp)) |
241 "Address of the author of Calc, for use by `report-calc-bug'.") | 243 |
244 (defcustom calc-embedded-announce-formula-alist | |
245 '((c++-mode . "//Embed\n\\(// .*\n\\)*") | |
246 (c-mode . "/\\*Embed\\*/\n\\(/\\* .*\\*/\n\\)*") | |
247 (f90-mode . "!Embed\n\\(! .*\n\\)*") | |
248 (fortran-mode . "C Embed\n\\(C .*\n\\)*") | |
249 (html-helper-mode . "<!-- Embed -->\n\\(<!-- .* -->\n\\)*") | |
250 (html-mode . "<!-- Embed -->\n\\(<!-- .* -->\n\\)*") | |
251 (nroff-mode . "\\\\\"Embed\n\\(\\\\\" .*\n\\)*") | |
252 (pascal-mode . "{Embed}\n\\({.*}\n\\)*") | |
253 (sgml-mode . "<!-- Embed -->\n\\(<!-- .* -->\n\\)*") | |
254 (xml-mode . "<!-- Embed -->\n\\(<!-- .* -->\n\\)*") | |
255 (texinfo-mode . "@c Embed\n\\(@c .*\n\\)*")) | |
256 "*Alist of major modes with appropriate values for `calc-embedded-announce-formula'." | |
257 :group 'calc | |
258 :type '(alist :key-type (symbol :tag "Major mode") | |
259 :value-type (regexp :tag "Regexp to announce formula"))) | |
260 | |
261 (defcustom calc-embedded-open-formula | |
262 "\\`\\|^\n\\|\\$\\$?\\|\\\\\\[\\|^\\\\begin[^{].*\n\\|^\\\\begin{.*[^x]}.*\n\\|^@.*\n\\|^\\.EQ.*\n\\|\\\\(\\|^%\n\\|^\\.\\\\\"\n" | |
263 "*A regular expression for the opening delimiter of a formula used by calc-embedded." | |
264 :group 'calc | |
265 :type '(regexp)) | |
266 | |
267 (defcustom calc-embedded-close-formula | |
268 "\\'\\|\n$\\|\\$\\$?\\|\\\\]\\|^\\\\end[^{].*\n\\|^\\\\end{.*[^x]}.*\n\\|^@.*\n\\|^\\.EN.*\n\\|\\\\)\\|\n%\n\\|^\\.\\\\\"\n" | |
269 "*A regular expression for the closing delimiter of a formula used by calc-embedded." | |
270 :group 'calc | |
271 :type '(regexp)) | |
272 | |
273 (defcustom calc-embedded-open-close-formula-alist | |
274 nil | |
275 "*Alist of major modes with pairs of formula delimiters used by calc-embedded." | |
276 :group 'calc | |
277 :type '(alist :key-type (symbol :tag "Major mode") | |
278 :value-type (list (regexp :tag "Opening formula delimiter") | |
279 (regexp :tag "Closing formula delimiter")))) | |
280 | |
281 (defcustom calc-embedded-open-word | |
282 "^\\|[^-+0-9.eE]" | |
283 "*A regular expression for the opening delimiter of a formula used by calc-embedded-word." | |
284 :group 'calc | |
285 :type '(regexp)) | |
286 | |
287 (defcustom calc-embedded-close-word | |
288 "$\\|[^-+0-9.eE]" | |
289 "*A regular expression for the closing delimiter of a formula used by calc-embedded-word." | |
290 :group 'calc | |
291 :type '(regexp)) | |
292 | |
293 (defcustom calc-embedded-open-close-word-alist | |
294 nil | |
295 "*Alist of major modes with pairs of word delimiters used by calc-embedded." | |
296 :group 'calc | |
297 :type '(alist :key-type (symbol :tag "Major mode") | |
298 :value-type (list (regexp :tag "Opening word delimiter") | |
299 (regexp :tag "Closing word delimiter")))) | |
300 | |
301 (defcustom calc-embedded-open-plain | |
302 "%%% " | |
303 "*A string which is the opening delimiter for a \"plain\" formula. | |
304 If calc-show-plain mode is enabled, this is inserted at the front of | |
305 each formula." | |
306 :group 'calc | |
307 :type '(string)) | |
308 | |
309 (defcustom calc-embedded-close-plain | |
310 " %%%\n" | |
311 "*A string which is the closing delimiter for a \"plain\" formula. | |
312 See calc-embedded-open-plain." | |
313 :group 'calc | |
314 :type '(string)) | |
315 | |
316 (defcustom calc-embedded-open-close-plain-alist | |
317 '((c++-mode "// %% " " %%\n") | |
318 (c-mode "/* %% " " %% */\n") | |
319 (f90-mode "! %% " " %%\n") | |
320 (fortran-mode "C %% " " %%\n") | |
321 (html-helper-mode "<!-- %% " " %% -->\n") | |
322 (html-mode "<!-- %% " " %% -->\n") | |
323 (nroff-mode "\\\" %% " " %%\n") | |
324 (pascal-mode "{%% " " %%}\n") | |
325 (sgml-mode "<!-- %% " " %% -->\n") | |
326 (xml-mode "<!-- %% " " %% -->\n") | |
327 (texinfo-mode "@c %% " " %%\n")) | |
328 "*Alist of major modes with pairs of delimiters for \"plain\" formulas." | |
329 :group 'calc | |
330 :type '(alist :key-type (symbol :tag "Major mode") | |
331 :value-type (list (string :tag "Opening \"plain\" delimiter") | |
332 (string :tag "Closing \"plain\" delimiter")))) | |
333 | |
334 (defcustom calc-embedded-open-new-formula | |
335 "\n\n" | |
336 "*A string which is inserted at front of formula by calc-embedded-new-formula." | |
337 :group 'calc | |
338 :type '(string)) | |
339 | |
340 (defcustom calc-embedded-close-new-formula | |
341 "\n\n" | |
342 "*A string which is inserted at end of formula by calc-embedded-new-formula." | |
343 :group 'calc | |
344 :type '(string)) | |
345 | |
346 (defcustom calc-embedded-open-close-new-formula-alist | |
347 nil | |
348 "*Alist of major modes with pairs of new formula delimiters used by calc-embedded." | |
349 :group 'calc | |
350 :type '(alist :key-type (symbol :tag "Major mode") | |
351 :value-type (list (string :tag "Opening new formula delimiter") | |
352 (string :tag "Closing new formula delimiter")))) | |
353 | |
354 (defcustom calc-embedded-open-mode | |
355 "% " | |
356 "*A string which should precede calc-embedded mode annotations. | |
357 This is not required to be present for user-written mode annotations." | |
358 :group 'calc | |
359 :type '(string)) | |
360 | |
361 (defcustom calc-embedded-close-mode | |
362 "\n" | |
363 "*A string which should follow calc-embedded mode annotations. | |
364 This is not required to be present for user-written mode annotations." | |
365 :group 'calc | |
366 :type '(string)) | |
367 | |
368 (defcustom calc-embedded-open-close-mode-alist | |
369 '((c++-mode "// " "\n") | |
370 (c-mode "/* " " */\n") | |
371 (f90-mode "! " "\n") | |
372 (fortran-mode "C " "\n") | |
373 (html-helper-mode "<!-- " " -->\n") | |
374 (html-mode "<!-- " " -->\n") | |
375 (nroff-mode "\\\" " "\n") | |
376 (pascal-mode "{ " " }\n") | |
377 (sgml-mode "<!-- " " -->\n") | |
378 (xml-mode "<!-- " " -->\n") | |
379 (texinfo-mode "@c " "\n")) | |
380 "*Alist of major modes with pairs of strings to delimit annotations." | |
381 :group 'calc | |
382 :type '(alist :key-type (symbol :tag "Major mode") | |
383 :value-type (list (string :tag "Opening annotation delimiter") | |
384 (string :tag "Closing annotation delimiter")))) | |
385 | |
386 (defcustom calc-gnuplot-name | |
387 "gnuplot" | |
388 "*Name of GNUPLOT program, for calc-graph features." | |
389 :group 'calc | |
390 :type '(string)) | |
391 | |
392 (defcustom calc-gnuplot-plot-command | |
393 nil | |
394 "*Name of command for displaying GNUPLOT output; %s = file name to print." | |
395 :group 'calc | |
396 :type '(choice (string) (sexp))) | |
397 | |
398 (defcustom calc-gnuplot-print-command | |
399 "lp %s" | |
400 "*Name of command for printing GNUPLOT output; %s = file name to print." | |
401 :group 'calc | |
402 :type '(choice (string) (sexp))) | |
403 | |
404 (defvar calc-bug-address "belanger@truman.edu" | |
405 "Address of the maintainer of Calc, for use by `report-calc-bug'.") | |
242 | 406 |
243 (defvar calc-scan-for-dels t | 407 (defvar calc-scan-for-dels t |
244 "If t, scan keymaps to find all DEL-like keys. | 408 "If t, scan keymaps to find all DEL-like keys. |
245 if nil, only DEL itself is mapped to calc-pop.") | 409 if nil, only DEL itself is mapped to calc-pop.") |
246 | 410 |
247 (defvar calc-extensions-loaded nil) | |
248 | |
249 (defvar calc-stack '((top-of-stack 1 nil)) | 411 (defvar calc-stack '((top-of-stack 1 nil)) |
250 "Calculator stack. | 412 "Calculator stack. |
251 Entries are 3-lists: Formula, Height (in lines), Selection (or nil).") | 413 Entries are 3-lists: Formula, Height (in lines), Selection (or nil).") |
252 | 414 |
253 (defvar calc-show-banner t | |
254 "*If non-nil, show a friendly greeting above the stack.") | |
255 | |
256 (defvar calc-stack-top 1 | 415 (defvar calc-stack-top 1 |
257 "Index into `calc-stack' of \"top\" of stack. | 416 "Index into `calc-stack' of \"top\" of stack. |
258 This is 1 unless `calc-truncate-stack' has been used.") | 417 This is 1 unless `calc-truncate-stack' has been used.") |
259 | 418 |
260 (defvar calc-always-load-extensions nil | 419 (defvar calc-display-sci-high 0 |
420 "Floating-point numbers with this positive exponent or higher above the | |
421 current precision are displayed in scientific notation in calc-mode.") | |
422 | |
423 (defvar calc-display-sci-low -3 | |
424 "Floating-point numbers with this negative exponent or lower are displayed | |
425 scientific notation in calc-mode.") | |
426 | |
427 (defvar calc-other-modes nil | |
428 "List of used-defined strings to append to Calculator mode line.") | |
429 | |
430 (defvar calc-Y-help-msgs nil | |
431 "List of strings for Y prefix help.") | |
432 | |
433 (defvar calc-loaded-settings-file nil | |
434 "t if `calc-settings-file' has been loaded yet.") | |
435 | |
436 | |
437 (defvar calc-mode-var-list '() | |
438 "List of variables used in customizing GNU Calc.") | |
439 | |
440 (defmacro defcalcmodevar (var defval &optional doc) | |
441 `(progn | |
442 (defvar ,var ,defval ,doc) | |
443 (add-to-list 'calc-mode-var-list (list (quote ,var) ,defval)))) | |
444 | |
445 (defun calc-mode-var-list-restore-default-values () | |
446 (mapcar (function (lambda (v) (set (car v) (nth 1 v)))) | |
447 calc-mode-var-list)) | |
448 | |
449 (defun calc-mode-var-list-restore-saved-values () | |
450 (let ((newvarlist '())) | |
451 (save-excursion | |
452 (let (pos | |
453 (file (substitute-in-file-name calc-settings-file))) | |
454 (when (and | |
455 (file-regular-p file) | |
456 (set-buffer (find-file-noselect file)) | |
457 (goto-char (point-min)) | |
458 (search-forward ";;; Mode settings stored by Calc" nil t) | |
459 (progn | |
460 (forward-line 1) | |
461 (setq pos (point)) | |
462 (search-forward "\n;;; End of mode settings" nil t))) | |
463 (beginning-of-line) | |
464 (calc-mode-var-list-restore-default-values) | |
465 (eval-region pos (point)) | |
466 (let ((varlist calc-mode-var-list)) | |
467 (while varlist | |
468 (let ((var (car varlist))) | |
469 (setq newvarlist | |
470 (cons (list (car var) (symbol-value (car var))) | |
471 newvarlist))) | |
472 (setq varlist (cdr varlist))))))) | |
473 (if newvarlist | |
474 (mapcar (function (lambda (v) (set (car v) (nth 1 v)))) | |
475 newvarlist) | |
476 (calc-mode-var-list-restore-default-values)))) | |
477 | |
478 (defcalcmodevar calc-always-load-extensions nil | |
261 "If non-nil, load the calc-ext module automatically when calc is loaded.") | 479 "If non-nil, load the calc-ext module automatically when calc is loaded.") |
262 | 480 |
263 (defvar calc-line-numbering t | 481 (defcalcmodevar calc-line-numbering t |
264 "If non-nil, display line numbers in Calculator stack.") | 482 "If non-nil, display line numbers in Calculator stack.") |
265 | 483 |
266 (defvar calc-line-breaking t | 484 (defcalcmodevar calc-line-breaking t |
267 "If non-nil, break long values across multiple lines in Calculator stack.") | 485 "If non-nil, break long values across multiple lines in Calculator stack.") |
268 | 486 |
269 (defvar calc-display-just nil | 487 (defcalcmodevar calc-display-just nil |
270 "If nil, stack display is left-justified. | 488 "If nil, stack display is left-justified. |
271 If `right', stack display is right-justified. | 489 If `right', stack display is right-justified. |
272 If `center', stack display is centered.") | 490 If `center', stack display is centered.") |
273 | 491 |
274 (defvar calc-display-origin nil | 492 (defcalcmodevar calc-display-origin nil |
275 "Horizontal origin of displayed stack entries. | 493 "Horizontal origin of displayed stack entries. |
276 In left-justified mode, this is effectively indentation. (Default 0). | 494 In left-justified mode, this is effectively indentation. (Default 0). |
277 In right-justified mode, this is effectively window width. | 495 In right-justified mode, this is effectively window width. |
278 In centered mode, center of stack entry is placed here.") | 496 In centered mode, center of stack entry is placed here.") |
279 | 497 |
280 (defvar calc-number-radix 10 | 498 (defcalcmodevar calc-number-radix 10 |
281 "Radix for entry and display of numbers in calc-mode, 2-36.") | 499 "Radix for entry and display of numbers in calc-mode, 2-36.") |
282 | 500 |
283 (defvar calc-leading-zeros nil | 501 (defcalcmodevar calc-leading-zeros nil |
284 "If non-nil, leading zeros are provided to pad integers to calc-word-size.") | 502 "If non-nil, leading zeros are provided to pad integers to calc-word-size.") |
285 | 503 |
286 (defvar calc-group-digits nil | 504 (defcalcmodevar calc-group-digits nil |
287 "If non-nil, group digits in large displayed integers by inserting spaces. | 505 "If non-nil, group digits in large displayed integers by inserting spaces. |
288 If an integer, group that many digits at a time. | 506 If an integer, group that many digits at a time. |
289 If t, use 4 for binary and hex, 3 otherwise.") | 507 If t, use 4 for binary and hex, 3 otherwise.") |
290 | 508 |
291 (defvar calc-group-char "," | 509 (defcalcmodevar calc-group-char "," |
292 "The character (in the form of a string) to be used for grouping digits. | 510 "The character (in the form of a string) to be used for grouping digits. |
293 This is used only when calc-group-digits mode is on.") | 511 This is used only when calc-group-digits mode is on.") |
294 | 512 |
295 (defvar calc-point-char "." | 513 (defcalcmodevar calc-point-char "." |
296 "The character (in the form of a string) to be used as a decimal point.") | 514 "The character (in the form of a string) to be used as a decimal point.") |
297 | 515 |
298 (defvar calc-frac-format '(":" nil) | 516 (defcalcmodevar calc-frac-format '(":" nil) |
299 "Format of displayed fractions; a string of one or two of \":\" or \"/\".") | 517 "Format of displayed fractions; a string of one or two of \":\" or \"/\".") |
300 | 518 |
301 (defvar calc-prefer-frac nil | 519 (defcalcmodevar calc-prefer-frac nil |
302 "If non-nil, prefer fractional over floating-point results.") | 520 "If non-nil, prefer fractional over floating-point results.") |
303 | 521 |
304 (defvar calc-hms-format "%s@ %s' %s\"" | 522 (defcalcmodevar calc-hms-format "%s@ %s' %s\"" |
305 "Format of displayed hours-minutes-seconds angles, a format string. | 523 "Format of displayed hours-minutes-seconds angles, a format string. |
306 String must contain three %s marks for hours, minutes, seconds respectively.") | 524 String must contain three %s marks for hours, minutes, seconds respectively.") |
307 | 525 |
308 (defvar calc-date-format '((H ":" mm C SS pp " ") | 526 (defcalcmodevar calc-date-format '((H ":" mm C SS pp " ") |
309 Www " " Mmm " " D ", " YYYY) | 527 Www " " Mmm " " D ", " YYYY) |
310 "Format of displayed date forms.") | 528 "Format of displayed date forms.") |
311 | 529 |
312 (defvar calc-float-format '(float 0) | 530 (defcalcmodevar calc-float-format '(float 0) |
313 "Format to use for display of floating-point numbers in calc-mode. | 531 "Format to use for display of floating-point numbers in calc-mode. |
314 Must be a list of one of the following forms: | 532 Must be a list of one of the following forms: |
315 (float 0) Floating point format, display full precision. | 533 (float 0) Floating point format, display full precision. |
316 (float N) N > 0: Floating point format, at most N significant figures. | 534 (float N) N > 0: Floating point format, at most N significant figures. |
317 (float -N) -N < 0: Floating point format, calc-internal-prec - N figs. | 535 (float -N) -N < 0: Floating point format, calc-internal-prec - N figs. |
321 (sci -N) -N < 0: Scientific notation, calc-internal-prec - N figs. | 539 (sci -N) -N < 0: Scientific notation, calc-internal-prec - N figs. |
322 (eng 0) Engineering notation, full precision. | 540 (eng 0) Engineering notation, full precision. |
323 (eng N) N > 0: Engineering notation, N significant figures. | 541 (eng N) N > 0: Engineering notation, N significant figures. |
324 (eng -N) -N < 0: Engineering notation, calc-internal-prec - N figs.") | 542 (eng -N) -N < 0: Engineering notation, calc-internal-prec - N figs.") |
325 | 543 |
326 (defvar calc-full-float-format '(float 0) | 544 (defcalcmodevar calc-full-float-format '(float 0) |
327 "Format to use when full precision must be displayed.") | 545 "Format to use when full precision must be displayed.") |
328 | 546 |
329 (defvar calc-complex-format nil | 547 (defcalcmodevar calc-complex-format nil |
330 "Format to use for display of complex numbers in calc-mode. Must be one of: | 548 "Format to use for display of complex numbers in calc-mode. Must be one of: |
331 nil Use (x, y) form. | 549 nil Use (x, y) form. |
332 i Use x + yi form. | 550 i Use x + yi form. |
333 j Use x + yj form.") | 551 j Use x + yj form.") |
334 | 552 |
335 (defvar calc-complex-mode 'cplx | 553 (defcalcmodevar calc-complex-mode 'cplx |
336 "Preferred form, either `cplx' or `polar', for complex numbers.") | 554 "Preferred form, either `cplx' or `polar', for complex numbers.") |
337 | 555 |
338 (defvar calc-infinite-mode nil | 556 (defcalcmodevar calc-infinite-mode nil |
339 "If nil, 1 / 0 is left unsimplified. | 557 "If nil, 1 / 0 is left unsimplified. |
340 If 0, 1 / 0 is changed to inf (zeros are considered positive). | 558 If 0, 1 / 0 is changed to inf (zeros are considered positive). |
341 Otherwise, 1 / 0 is changed to uinf (undirected infinity).") | 559 Otherwise, 1 / 0 is changed to uinf (undirected infinity).") |
342 | 560 |
343 (defvar calc-display-strings nil | 561 (defcalcmodevar calc-display-strings nil |
344 "If non-nil, display vectors of byte-sized integers as strings.") | 562 "If non-nil, display vectors of byte-sized integers as strings.") |
345 | 563 |
346 (defvar calc-matrix-just 'center | 564 (defcalcmodevar calc-matrix-just 'center |
347 "If nil, vector elements are left-justified. | 565 "If nil, vector elements are left-justified. |
348 If `right', vector elements are right-justified. | 566 If `right', vector elements are right-justified. |
349 If `center', vector elements are centered.") | 567 If `center', vector elements are centered.") |
350 | 568 |
351 (defvar calc-break-vectors nil | 569 (defcalcmodevar calc-break-vectors nil |
352 "If non-nil, display vectors one element per line.") | 570 "If non-nil, display vectors one element per line.") |
353 | 571 |
354 (defvar calc-full-vectors t | 572 (defcalcmodevar calc-full-vectors t |
355 "If non-nil, display long vectors in full. If nil, use abbreviated form.") | 573 "If non-nil, display long vectors in full. If nil, use abbreviated form.") |
356 | 574 |
357 (defvar calc-full-trail-vectors t | 575 (defcalcmodevar calc-full-trail-vectors t |
358 "If non-nil, display long vectors in full in the trail.") | 576 "If non-nil, display long vectors in full in the trail.") |
359 | 577 |
360 (defvar calc-vector-commas "," | 578 (defcalcmodevar calc-vector-commas "," |
361 "If non-nil, separate elements of displayed vectors with this string.") | 579 "If non-nil, separate elements of displayed vectors with this string.") |
362 | 580 |
363 (defvar calc-vector-brackets "[]" | 581 (defcalcmodevar calc-vector-brackets "[]" |
364 "If non-nil, surround displayed vectors with these characters.") | 582 "If non-nil, surround displayed vectors with these characters.") |
365 | 583 |
366 (defvar calc-matrix-brackets '(R O) | 584 (defcalcmodevar calc-matrix-brackets '(R O) |
367 "A list of code-letter symbols that control \"big\" matrix display. | 585 "A list of code-letter symbols that control \"big\" matrix display. |
368 If `R' is present, display inner brackets for matrices. | 586 If `R' is present, display inner brackets for matrices. |
369 If `O' is present, display outer brackets for matrices (above/below). | 587 If `O' is present, display outer brackets for matrices (above/below). |
370 If `C' is present, display outer brackets for matrices (centered).") | 588 If `C' is present, display outer brackets for matrices (centered).") |
371 | 589 |
372 (defvar calc-language nil | 590 (defcalcmodevar calc-language nil |
373 "Language or format for entry and display of stack values. Must be one of: | 591 "Language or format for entry and display of stack values. Must be one of: |
374 nil Use standard Calc notation. | 592 nil Use standard Calc notation. |
375 flat Use standard Calc notation, one-line format. | 593 flat Use standard Calc notation, one-line format. |
376 big Display formulas in 2-d notation (enter w/std notation). | 594 big Display formulas in 2-d notation (enter w/std notation). |
377 unform Use unformatted display: add(a, mul(b,c)). | 595 unform Use unformatted display: add(a, mul(b,c)). |
378 c Use C language notation. | 596 c Use C language notation. |
379 pascal Use Pascal language notation. | 597 pascal Use Pascal language notation. |
380 fortran Use Fortran language notation. | 598 fortran Use Fortran language notation. |
381 tex Use TeX notation. | 599 tex Use TeX notation. |
600 latex Use LaTeX notation. | |
382 eqn Use eqn notation. | 601 eqn Use eqn notation. |
383 math Use Mathematica(tm) notation. | 602 math Use Mathematica(tm) notation. |
384 maple Use Maple notation.") | 603 maple Use Maple notation.") |
385 | 604 |
386 (defvar calc-language-option nil | 605 (defcalcmodevar calc-language-option nil |
387 "Numeric prefix argument for the command that set `calc-language'.") | 606 "Numeric prefix argument for the command that set `calc-language'.") |
388 | 607 |
389 (defvar calc-function-open "(" | 608 (defcalcmodevar calc-left-label "" |
390 "Open-parenthesis string for function call notation.") | |
391 | |
392 (defvar calc-function-close ")" | |
393 "Close-parenthesis string for function call notation.") | |
394 | |
395 (defvar calc-language-output-filter nil | |
396 "Function through which to pass strings after formatting.") | |
397 | |
398 (defvar calc-language-input-filter nil | |
399 "Function through which to pass strings before parsing.") | |
400 | |
401 (defvar calc-radix-formatter nil | |
402 "Formatting function used for non-decimal numbers.") | |
403 | |
404 (defvar calc-left-label "" | |
405 "Label to display at left of formula.") | 609 "Label to display at left of formula.") |
406 | 610 |
407 (defvar calc-right-label "" | 611 (defcalcmodevar calc-right-label "" |
408 "Label to display at right of formula.") | 612 "Label to display at right of formula.") |
409 | 613 |
410 (defvar calc-word-size 32 | 614 (defcalcmodevar calc-word-size 32 |
411 "Minimum number of bits per word, if any, for binary operations in calc-mode.") | 615 "Minimum number of bits per word, if any, for binary operations in calc-mode.") |
412 | 616 |
413 (defvar calc-previous-modulo nil | 617 (defcalcmodevar calc-previous-modulo nil |
414 "Most recently used value of M in a modulo form.") | 618 "Most recently used value of M in a modulo form.") |
415 | 619 |
416 (defvar calc-simplify-mode nil | 620 (defcalcmodevar calc-simplify-mode nil |
417 "Type of simplification applied to results. | 621 "Type of simplification applied to results. |
418 If `none', results are not simplified when pushed on the stack. | 622 If `none', results are not simplified when pushed on the stack. |
419 If `num', functions are simplified only when args are constant. | 623 If `num', functions are simplified only when args are constant. |
420 If nil, only fast simplifications are applied. | 624 If nil, only fast simplifications are applied. |
421 If `binary', `math-clip' is applied if appropriate. | 625 If `binary', `math-clip' is applied if appropriate. |
422 If `alg', `math-simplify' is applied. | 626 If `alg', `math-simplify' is applied. |
423 If `ext', `math-simplify-extended' is applied. | 627 If `ext', `math-simplify-extended' is applied. |
424 If `units', `math-simplify-units' is applied.") | 628 If `units', `math-simplify-units' is applied.") |
425 | 629 |
426 (defvar calc-auto-recompute t | 630 (defcalcmodevar calc-auto-recompute t |
427 "If non-nil, recompute evalto's automatically when necessary.") | 631 "If non-nil, recompute evalto's automatically when necessary.") |
428 | 632 |
429 (defvar calc-display-raw nil | 633 (defcalcmodevar calc-display-raw nil |
430 "If non-nil, display shows unformatted Lisp exprs. (For debugging)") | 634 "If non-nil, display shows unformatted Lisp exprs. (For debugging)") |
431 | 635 |
432 (defvar calc-internal-prec 12 | 636 (defcalcmodevar calc-internal-prec 12 |
433 "Number of digits of internal precision for calc-mode calculations.") | 637 "Number of digits of internal precision for calc-mode calculations.") |
434 | 638 |
435 (defvar calc-inverse-flag nil | 639 (defcalcmodevar calc-angle-mode 'deg |
436 "If non-nil, next operation is Inverse.") | |
437 | |
438 (defvar calc-hyperbolic-flag nil | |
439 "If non-nil, next operation is Hyperbolic.") | |
440 | |
441 (defvar calc-keep-args-flag nil | |
442 "If non-nil, next operation should not remove its arguments from stack.") | |
443 | |
444 (defvar calc-angle-mode 'deg | |
445 "If deg, angles are in degrees; if rad, angles are in radians. | 640 "If deg, angles are in degrees; if rad, angles are in radians. |
446 If hms, angles are in degrees-minutes-seconds.") | 641 If hms, angles are in degrees-minutes-seconds.") |
447 | 642 |
448 (defvar calc-algebraic-mode nil | 643 (defcalcmodevar calc-algebraic-mode nil |
449 "If non-nil, numeric entry accepts whole algebraic expressions. | 644 "If non-nil, numeric entry accepts whole algebraic expressions. |
450 If nil, algebraic expressions must be preceded by \"'\".") | 645 If nil, algebraic expressions must be preceded by \"'\".") |
451 | 646 |
452 (defvar calc-incomplete-algebraic-mode nil | 647 (defcalcmodevar calc-incomplete-algebraic-mode nil |
453 "Like calc-algebraic-mode except only affects ( and [ keys.") | 648 "Like calc-algebraic-mode except only affects ( and [ keys.") |
454 | 649 |
455 (defvar calc-symbolic-mode nil | 650 (defcalcmodevar calc-symbolic-mode nil |
456 "If non-nil, inexact numeric computations like sqrt(2) are postponed. | 651 "If non-nil, inexact numeric computations like sqrt(2) are postponed. |
457 If nil, computations on numbers always yield numbers where possible.") | 652 If nil, computations on numbers always yield numbers where possible.") |
458 | 653 |
459 (defvar calc-matrix-mode nil | 654 (defcalcmodevar calc-matrix-mode nil |
460 "If `matrix', variables are assumed to be matrix-valued. | 655 "If `matrix', variables are assumed to be matrix-valued. |
461 If a number, variables are assumed to be NxN matrices. | 656 If a number, variables are assumed to be NxN matrices. |
657 If `sqmatrix', variables are assumed to be square matrices of an unspecified size. | |
462 If `scalar', variables are assumed to be scalar-valued. | 658 If `scalar', variables are assumed to be scalar-valued. |
463 If nil, symbolic math routines make no assumptions about variables.") | 659 If nil, symbolic math routines make no assumptions about variables.") |
464 | 660 |
465 (defvar calc-shift-prefix nil | 661 (defcalcmodevar calc-shift-prefix nil |
466 "If non-nil, shifted letter keys are prefix keys rather than normal meanings.") | 662 "If non-nil, shifted letter keys are prefix keys rather than normal meanings.") |
467 | 663 |
468 (defvar calc-window-height 7 | 664 (defcalcmodevar calc-window-height 7 |
469 "Initial height of Calculator window.") | 665 "Initial height of Calculator window.") |
470 | 666 |
471 (defvar calc-display-trail t | 667 (defcalcmodevar calc-display-trail t |
472 "If non-nil, M-x calc creates a window to display Calculator trail.") | 668 "If non-nil, M-x calc creates a window to display Calculator trail.") |
473 | 669 |
474 (defvar calc-show-selections t | 670 (defcalcmodevar calc-show-selections t |
475 "If non-nil, selected sub-formulas are shown by obscuring rest of formula. | 671 "If non-nil, selected sub-formulas are shown by obscuring rest of formula. |
476 If nil, selected sub-formulas are highlighted by obscuring the sub-formulas.") | 672 If nil, selected sub-formulas are highlighted by obscuring the sub-formulas.") |
477 | 673 |
478 (defvar calc-use-selections t | 674 (defcalcmodevar calc-use-selections t |
479 "If non-nil, commands operate only on selected portions of formulas. | 675 "If non-nil, commands operate only on selected portions of formulas. |
480 If nil, selections displayed but ignored.") | 676 If nil, selections displayed but ignored.") |
481 | 677 |
482 (defvar calc-assoc-selections t | 678 (defcalcmodevar calc-assoc-selections t |
483 "If non-nil, selection hides deep structure of associative formulas.") | 679 "If non-nil, selection hides deep structure of associative formulas.") |
484 | 680 |
485 (defvar calc-display-working-message 'lots | 681 (defcalcmodevar calc-display-working-message 'lots |
486 "If non-nil, display \"Working...\" for potentially slow Calculator commands.") | 682 "If non-nil, display \"Working...\" for potentially slow Calculator commands.") |
487 | 683 |
488 (defvar calc-auto-why 'maybe | 684 (defcalcmodevar calc-auto-why 'maybe |
489 "If non-nil, automatically execute a \"why\" command to explain odd results.") | 685 "If non-nil, automatically execute a \"why\" command to explain odd results.") |
490 | 686 |
491 (defvar calc-timing nil | 687 (defcalcmodevar calc-timing nil |
492 "If non-nil, display timing information on each slow command.") | 688 "If non-nil, display timing information on each slow command.") |
493 | 689 |
494 (defvar calc-display-sci-high 0 | 690 (defcalcmodevar calc-mode-save-mode 'local) |
495 "Floating-point numbers with this positive exponent or higher above the | 691 |
496 current precision are displayed in scientific notation in calc-mode.") | 692 (defcalcmodevar calc-standard-date-formats |
497 | |
498 (defvar calc-display-sci-low -3 | |
499 "Floating-point numbers with this negative exponent or lower are displayed | |
500 scientific notation in calc-mode.") | |
501 | |
502 | |
503 (defvar calc-other-modes nil | |
504 "List of used-defined strings to append to Calculator mode line.") | |
505 | |
506 (defvar calc-Y-help-msgs nil | |
507 "List of strings for Y prefix help.") | |
508 | |
509 (defvar calc-loaded-settings-file nil | |
510 "t if `calc-settings-file' has been loaded yet.") | |
511 | |
512 | |
513 | |
514 (defvar calc-mode-save-mode 'local) | |
515 (defvar calc-standard-date-formats | |
516 '("N" | 693 '("N" |
517 "<H:mm:SSpp >Www Mmm D, YYYY" | 694 "<H:mm:SSpp >Www Mmm D, YYYY" |
518 "D Mmm YYYY<, h:mm:SS>" | 695 "D Mmm YYYY<, h:mm:SS>" |
519 "Www Mmm BD< hh:mm:ss> YYYY" | 696 "Www Mmm BD< hh:mm:ss> YYYY" |
520 "M/D/Y< H:mm:SSpp>" | 697 "M/D/Y< H:mm:SSpp>" |
521 "D.M.Y< h:mm:SS>" | 698 "D.M.Y< h:mm:SS>" |
522 "M-D-Y< H:mm:SSpp>" | 699 "M-D-Y< H:mm:SSpp>" |
523 "D-M-Y< h:mm:SS>" | 700 "D-M-Y< h:mm:SS>" |
524 "j<, h:mm:SS>" | 701 "j<, h:mm:SS>" |
525 "YYddd< hh:mm:ss>")) | 702 "YYddd< hh:mm:ss>")) |
526 (defvar calc-autorange-units nil) | 703 |
527 (defvar calc-was-keypad-mode nil) | 704 (defcalcmodevar calc-autorange-units nil) |
528 (defvar calc-full-mode nil) | 705 |
529 (defvar calc-user-parse-tables nil) | 706 (defcalcmodevar calc-was-keypad-mode nil) |
530 (defvar calc-gnuplot-default-device "default") | 707 |
531 (defvar calc-gnuplot-default-output "STDOUT") | 708 (defcalcmodevar calc-full-mode nil) |
532 (defvar calc-gnuplot-print-device "postscript") | 709 |
533 (defvar calc-gnuplot-print-output "auto") | 710 (defcalcmodevar calc-user-parse-tables nil) |
534 (defvar calc-gnuplot-geometry nil) | 711 |
535 (defvar calc-graph-default-resolution 15) | 712 (defcalcmodevar calc-gnuplot-default-device "default") |
536 (defvar calc-graph-default-resolution-3d 5) | 713 |
537 (defvar calc-invocation-macro nil) | 714 (defcalcmodevar calc-gnuplot-default-output "STDOUT") |
538 (defvar calc-show-banner t) | 715 |
716 (defcalcmodevar calc-gnuplot-print-device "postscript") | |
717 | |
718 (defcalcmodevar calc-gnuplot-print-output "auto") | |
719 | |
720 (defcalcmodevar calc-gnuplot-geometry nil) | |
721 | |
722 (defcalcmodevar calc-graph-default-resolution 15) | |
723 | |
724 (defcalcmodevar calc-graph-default-resolution-3d 5) | |
725 | |
726 (defcalcmodevar calc-invocation-macro nil) | |
727 | |
728 (defcalcmodevar calc-show-banner t | |
729 "*If non-nil, show a friendly greeting above the stack.") | |
539 | 730 |
540 (defconst calc-local-var-list '(calc-stack | 731 (defconst calc-local-var-list '(calc-stack |
541 calc-stack-top | 732 calc-stack-top |
542 calc-undo-list | 733 calc-undo-list |
543 calc-redo-list | 734 calc-redo-list |
590 calc-use-selections | 781 calc-use-selections |
591 calc-assoc-selections | 782 calc-assoc-selections |
592 calc-word-size | 783 calc-word-size |
593 calc-internal-prec)) | 784 calc-internal-prec)) |
594 | 785 |
786 (defvar calc-mode-hook nil | |
787 "Hook run when entering calc-mode.") | |
788 | |
789 (defvar calc-trail-mode-hook nil | |
790 "Hook run when entering calc-trail-mode.") | |
791 | |
792 (defvar calc-start-hook nil | |
793 "Hook run when calc is started.") | |
794 | |
795 (defvar calc-end-hook nil | |
796 "Hook run when calc is quit.") | |
797 | |
798 (defvar calc-load-hook nil | |
799 "Hook run when calc.el is loaded.") | |
800 | |
801 (defvar calc-window-hook nil | |
802 "Hook called to create the Calc window.") | |
803 | |
804 (defvar calc-trail-window-hook nil | |
805 "Hook called to create the Calc trail window.") | |
806 | |
807 (defvar calc-embedded-new-buffer-hook nil | |
808 "Hook run when starting embedded mode in a new buffer.") | |
809 | |
810 (defvar calc-embedded-new-formula-hook nil | |
811 "Hook run when starting embedded mode in a new formula.") | |
812 | |
813 (defvar calc-embedded-mode-hook nil | |
814 "Hook run when starting embedded mode.") | |
595 | 815 |
596 ;; Verify that Calc is running on the right kind of system. | 816 ;; Verify that Calc is running on the right kind of system. |
597 (defconst calc-emacs-type-epoch (and (fboundp 'epoch::version) epoch::version)) | |
598 (defvar calc-emacs-type-19 (not (or calc-emacs-type-epoch | |
599 (string-lessp emacs-version "19")))) | |
600 (defvar calc-emacs-type-lucid (not (not (string-match "Lucid" emacs-version)))) | 817 (defvar calc-emacs-type-lucid (not (not (string-match "Lucid" emacs-version)))) |
601 (defvar calc-emacs-type-gnu19 (and calc-emacs-type-19 | |
602 (not calc-emacs-type-lucid))) | |
603 | |
604 ;; Set up the standard keystroke (M-#) to run the Calculator, if that key | |
605 ;; has not yet been bound to anything. For best results, the user should | |
606 ;; do this before Calc is even loaded, so that M-# can auto-load Calc. | |
607 (or (global-key-binding "\e#") (global-set-key "\e#" 'calc-dispatch)) | |
608 | 818 |
609 ;; Set up the autoloading linkage. | 819 ;; Set up the autoloading linkage. |
610 (let ((name (and (fboundp 'calc-dispatch) | 820 (let ((name (and (fboundp 'calc-dispatch) |
611 (eq (car-safe (symbol-function 'calc-dispatch)) 'autoload) | 821 (eq (car-safe (symbol-function 'calc-dispatch)) 'autoload) |
612 (nth 1 (symbol-function 'calc-dispatch)))) | 822 (nth 1 (symbol-function 'calc-dispatch)))) |
631 (setq load-path (nconc load-path | 841 (setq load-path (nconc load-path |
632 (list | 842 (list |
633 (directory-file-name | 843 (directory-file-name |
634 (file-name-directory | 844 (file-name-directory |
635 (expand-file-name | 845 (expand-file-name |
636 name (car p2)))))))))) | 846 name (car p2)))))))))))) |
637 | |
638 ;; If calc-autoload-directory is given, use that (and hope it works!). | |
639 (and calc-autoload-directory | |
640 (not (equal calc-autoload-directory "")) | |
641 (setq load-path (nconc load-path | |
642 (list (directory-file-name | |
643 calc-autoload-directory))))))) | |
644 | 847 |
645 ;; The following modes use specially-formatted data. | 848 ;; The following modes use specially-formatted data. |
646 (put 'calc-mode 'mode-class 'special) | 849 (put 'calc-mode 'mode-class 'special) |
647 (put 'calc-trail-mode 'mode-class 'special) | 850 (put 'calc-trail-mode 'mode-class 'special) |
648 | 851 |
654 (put 'math-overflow 'error-conditions '(error math-overflow calc-error)) | 857 (put 'math-overflow 'error-conditions '(error math-overflow calc-error)) |
655 (put 'math-overflow 'error-message "Floating-point overflow occurred") | 858 (put 'math-overflow 'error-message "Floating-point overflow occurred") |
656 (put 'math-underflow 'error-conditions '(error math-underflow calc-error)) | 859 (put 'math-underflow 'error-conditions '(error math-underflow calc-error)) |
657 (put 'math-underflow 'error-message "Floating-point underflow occurred") | 860 (put 'math-underflow 'error-message "Floating-point underflow occurred") |
658 | 861 |
659 (defconst calc-version "2.02g") | 862 (defconst calc-version "2.1") |
660 (defconst calc-version-date "Mon Nov 19 2001") | |
661 (defvar calc-trail-pointer nil) ; "Current" entry in trail buffer. | 863 (defvar calc-trail-pointer nil) ; "Current" entry in trail buffer. |
662 (defvar calc-trail-overlay nil) ; Value of overlay-arrow-string. | 864 (defvar calc-trail-overlay nil) ; Value of overlay-arrow-string. |
663 (defvar calc-undo-list nil) ; List of previous operations for undo. | 865 (defvar calc-undo-list nil) ; List of previous operations for undo. |
664 (defvar calc-redo-list nil) ; List of recent undo operations. | 866 (defvar calc-redo-list nil) ; List of recent undo operations. |
665 (defvar calc-main-buffer nil) ; Pointer to Calculator buffer. | 867 (defvar calc-main-buffer nil) ; Pointer to Calculator buffer. |
666 (defvar calc-trail-buffer nil) ; Pointer to Calc Trail buffer. | 868 (defvar calc-trail-buffer nil) ; Pointer to Calc Trail buffer. |
667 (defvar calc-why nil) ; Explanations of most recent errors. | 869 (defvar calc-why nil) ; Explanations of most recent errors. |
668 (defvar calc-next-why nil) | 870 (defvar calc-next-why nil) |
669 (defvar calc-inverse-flag nil) | 871 (defvar calc-inverse-flag nil |
670 (defvar calc-hyperbolic-flag nil) | 872 "If non-nil, next operation is Inverse.") |
671 (defvar calc-keep-args-flag nil) | 873 (defvar calc-hyperbolic-flag nil |
874 "If non-nil, next operation is Hyperbolic.") | |
875 (defvar calc-keep-args-flag nil | |
876 "If non-nil, next operation should not remove its arguments from stack.") | |
877 (defvar calc-function-open "(" | |
878 "Open-parenthesis string for function call notation.") | |
879 (defvar calc-function-close ")" | |
880 "Close-parenthesis string for function call notation.") | |
881 (defvar calc-language-output-filter nil | |
882 "Function through which to pass strings after formatting.") | |
883 (defvar calc-language-input-filter nil | |
884 "Function through which to pass strings before parsing.") | |
885 (defvar calc-radix-formatter nil | |
886 "Formatting function used for non-decimal numbers.") | |
887 | |
672 (defvar calc-last-kill nil) ; Last number killed in calc-mode. | 888 (defvar calc-last-kill nil) ; Last number killed in calc-mode. |
673 (defvar calc-previous-alg-entry nil) ; Previous algebraic entry. | 889 (defvar calc-previous-alg-entry nil) ; Previous algebraic entry. |
674 (defvar calc-dollar-values nil) ; Values to be used for '$'. | 890 (defvar calc-dollar-values nil) ; Values to be used for '$'. |
675 (defvar calc-dollar-used nil) ; Highest order of '$' that occurred. | 891 (defvar calc-dollar-used nil) ; Highest order of '$' that occurred. |
676 (defvar calc-hashes-used nil) ; Highest order of '#' that occurred. | 892 (defvar calc-hashes-used nil) ; Highest order of '#' that occurred. |
689 (defvar calc-standalone-flag nil) | 905 (defvar calc-standalone-flag nil) |
690 (defvar var-EvalRules nil) | 906 (defvar var-EvalRules nil) |
691 (defvar math-eval-rules-cache-tag t) | 907 (defvar math-eval-rules-cache-tag t) |
692 (defvar math-radix-explicit-format t) | 908 (defvar math-radix-explicit-format t) |
693 (defvar math-expr-function-mapping nil) | 909 (defvar math-expr-function-mapping nil) |
910 (defvar math-expr-special-function-mapping nil) | |
694 (defvar math-expr-variable-mapping nil) | 911 (defvar math-expr-variable-mapping nil) |
695 (defvar math-read-expr-quotes nil) | 912 (defvar math-read-expr-quotes nil) |
696 (defvar math-working-step nil) | 913 (defvar math-working-step nil) |
697 (defvar math-working-step-2 nil) | 914 (defvar math-working-step-2 nil) |
698 (defvar var-i '(special-const (math-imaginary 1))) | 915 (defvar var-i '(special-const (math-imaginary 1))) |
731 (define-key map "\M-\t" 'calc-roll-up) | 948 (define-key map "\M-\t" 'calc-roll-up) |
732 (define-key map "\C-m" 'calc-enter) | 949 (define-key map "\C-m" 'calc-enter) |
733 (define-key map "\M-\C-m" 'calc-last-args-stub) | 950 (define-key map "\M-\C-m" 'calc-last-args-stub) |
734 (define-key map "\C-j" 'calc-over) | 951 (define-key map "\C-j" 'calc-over) |
735 | 952 |
736 (mapcar (lambda (x) (define-key map (char-to-string x) 'undefined)) | 953 (mapc (lambda (x) (define-key map (char-to-string x) 'undefined)) |
737 "lOW") | 954 "lOW") |
738 (mapcar (lambda (x) (define-key map (char-to-string x) 'calc-missing-key)) | 955 (mapc (lambda (x) (define-key map (char-to-string x) 'calc-missing-key)) |
739 (concat "ABCDEFGHIJKLMNPQRSTUVXZabcdfghjkmoprstuvwxyz" | 956 (concat "ABCDEFGHIJKLMNPQRSTUVXZabcdfghjkmoprstuvwxyz" |
740 ":\\|!()[]<>{},;=~`\C-k\M-k\C-w\M-w\C-y\C-_")) | 957 ":\\|!()[]<>{},;=~`\C-k\M-k\C-w\M-w\C-y\C-_")) |
741 (mapcar (lambda (x) (define-key map (char-to-string x) 'calcDigit-start)) | 958 (mapc (lambda (x) (define-key map (char-to-string x) 'calcDigit-start)) |
742 "_0123456789.#@") | 959 "_0123456789.#@") |
743 map)) | 960 map)) |
744 | 961 |
745 (defvar calc-digit-map | 962 (defvar calc-digit-map |
746 (let ((map (make-keymap))) | 963 (let ((map (make-keymap))) |
747 (if calc-emacs-type-lucid | 964 (if calc-emacs-type-lucid |
749 (lambda (keys bind) | 966 (lambda (keys bind) |
750 (define-key map keys | 967 (define-key map keys |
751 (if (eq bind 'undefined) | 968 (if (eq bind 'undefined) |
752 'undefined 'calcDigit-nondigit)))) | 969 'undefined 'calcDigit-nondigit)))) |
753 calc-mode-map) | 970 calc-mode-map) |
754 (let ((cmap (if calc-emacs-type-19 (nth 1 calc-mode-map) calc-mode-map)) | 971 (let ((cmap (nth 1 calc-mode-map)) |
755 (dmap (if calc-emacs-type-19 (nth 1 map) map)) | 972 (dmap (nth 1 map)) |
756 (i 0)) | 973 (i 0)) |
757 (while (< i 128) | 974 (while (< i 128) |
758 (aset dmap i | 975 (aset dmap i |
759 (if (eq (aref cmap i) 'undefined) | 976 (if (eq (aref cmap i) 'undefined) |
760 'undefined 'calcDigit-nondigit)) | 977 'undefined 'calcDigit-nondigit)) |
822 ( ?u . calc-embedded-update-formula ) | 1039 ( ?u . calc-embedded-update-formula ) |
823 ( ?w . calc-embedded-word ) | 1040 ( ?w . calc-embedded-word ) |
824 ( ?x . calc-quit ) | 1041 ( ?x . calc-quit ) |
825 ( ?y . calc-copy-to-buffer ) | 1042 ( ?y . calc-copy-to-buffer ) |
826 ( ?z . calc-user-invocation ) | 1043 ( ?z . calc-user-invocation ) |
827 ( ?= . calc-embedded-update-formula ) | |
828 ( ?\' . calc-embedded-new-formula ) | 1044 ( ?\' . calc-embedded-new-formula ) |
829 ( ?\` . calc-embedded-edit ) | 1045 ( ?\` . calc-embedded-edit ) |
830 ( ?: . calc-grab-sum-down ) | 1046 ( ?: . calc-grab-sum-down ) |
831 ( ?_ . calc-grab-sum-across ) | 1047 ( ?_ . calc-grab-sum-across ) |
832 ( ?0 . calc-reset ) | 1048 ( ?0 . calc-reset ) |
1049 ( ?? . calc-dispatch-help ) | |
833 ( ?# . calc-same-interface ) | 1050 ( ?# . calc-same-interface ) |
834 ( ?? . calc-dispatch-help ) )) | 1051 ( ?& . calc-same-interface ) |
1052 ( ?\\ . calc-same-interface ) | |
1053 ( ?= . calc-same-interface ) | |
1054 ( ?* . calc-same-interface ) | |
1055 ( ?/ . calc-same-interface ) | |
1056 ( ?+ . calc-same-interface ) | |
1057 ( ?- . calc-same-interface ) )) | |
835 map)) | 1058 map)) |
836 | |
837 (autoload 'calc-extensions "calc-ext") | |
838 (autoload 'calc-need-macros "calc-macs") | |
839 | 1059 |
840 ;;;; (Autoloads here) | 1060 ;;;; (Autoloads here) |
841 (mapcar | 1061 (mapcar |
842 (lambda (x) (dolist (func (cdr x)) (autoload func (car x)))) | 1062 (lambda (x) (dolist (func (cdr x)) (autoload func (car x)))) |
843 '( | 1063 '( |
844 | 1064 |
845 ("calc-aent" calc-Need-calc-aent calc-alg-digit-entry calc-alg-entry | 1065 ("calc-aent" calc-alg-digit-entry calc-alg-entry |
846 calc-check-user-syntax calc-do-alg-entry calc-do-calc-eval | 1066 calc-check-user-syntax calc-do-alg-entry calc-do-calc-eval |
847 calc-do-quick-calc calc-match-user-syntax math-build-parse-table | 1067 calc-do-quick-calc calc-match-user-syntax math-build-parse-table |
848 math-find-user-tokens math-read-expr-list math-read-exprs math-read-if | 1068 math-find-user-tokens math-read-expr-list math-read-exprs math-read-if |
849 math-read-token math-remove-dashes) | 1069 math-read-token math-remove-dashes math-read-preprocess-string) |
850 | 1070 |
851 ("calc-misc" calc-Need-calc-misc | 1071 ("calc-embed" calc-do-embedded-activate) |
1072 | |
1073 ("calc-misc" | |
852 calc-do-handle-whys calc-do-refresh calc-num-prefix-name | 1074 calc-do-handle-whys calc-do-refresh calc-num-prefix-name |
853 calc-record-list calc-record-why calc-report-bug calc-roll-down-stack | 1075 calc-record-list calc-record-why calc-report-bug calc-roll-down-stack |
854 calc-roll-up-stack calc-temp-minibuffer-message calcFunc-floor | 1076 calc-roll-up-stack calc-temp-minibuffer-message calcFunc-floor |
855 calcFunc-inv calcFunc-trunc math-concat math-constp math-div2 | 1077 calcFunc-inv calcFunc-trunc math-concat math-constp math-div2 |
856 math-div2-bignum math-do-working math-evenp math-fixnatnump | 1078 math-div2-bignum math-do-working math-evenp math-fixnatnump |
864 | 1086 |
865 ("calc-aent" calc-algebraic-entry calc-auto-algebraic-entry | 1087 ("calc-aent" calc-algebraic-entry calc-auto-algebraic-entry |
866 calcDigit-algebraic calcDigit-edit) | 1088 calcDigit-algebraic calcDigit-edit) |
867 | 1089 |
868 ("calc-misc" another-calc calc-big-or-small calc-dispatch-help | 1090 ("calc-misc" another-calc calc-big-or-small calc-dispatch-help |
869 calc-help calc-info calc-info-summary calc-inv calc-last-args-stub | 1091 calc-help calc-info calc-info-goto-node calc-info-summary calc-inv |
1092 calc-last-args-stub | |
870 calc-missing-key calc-mod calc-other-window calc-over calc-percent | 1093 calc-missing-key calc-mod calc-other-window calc-over calc-percent |
871 calc-pop-above calc-power calc-roll-down calc-roll-up | 1094 calc-pop-above calc-power calc-roll-down calc-roll-up |
872 calc-shift-Y-prefix-help calc-tutorial calcDigit-letter | 1095 calc-shift-Y-prefix-help calc-tutorial calcDigit-letter |
873 report-calc-bug))) | 1096 report-calc-bug))) |
874 | 1097 |
875 | 1098 |
876 ;;;###autoload (global-set-key "\e#" 'calc-dispatch) | 1099 ;;;###autoload (define-key ctl-x-map "*" 'calc-dispatch) |
877 | 1100 |
878 ;;;###autoload | 1101 ;;;###autoload |
879 (defun calc-dispatch (&optional arg) | 1102 (defun calc-dispatch (&optional arg) |
880 "Invoke the GNU Emacs Calculator. See `calc-dispatch-help' for details." | 1103 "Invoke the GNU Emacs Calculator. See `calc-dispatch-help' for details." |
881 (interactive "P") | 1104 (interactive "P") |
903 calc-dispatch-map))) | 1126 calc-dispatch-map))) |
904 (setq key (lookup-key calc-dispatch-map key)) | 1127 (setq key (lookup-key calc-dispatch-map key)) |
905 (message "") | 1128 (message "") |
906 (if key | 1129 (if key |
907 (progn | 1130 (progn |
908 (or (commandp key) (calc-extensions)) | 1131 (or (commandp key) (require 'calc-ext)) |
909 (call-interactively key)) | 1132 (call-interactively key)) |
910 (beep)))) | 1133 (beep)))) |
911 | 1134 |
912 (defun calc-read-key-sequence (prompt map) | 1135 (defun calc-read-key-sequence (prompt map) |
913 (let ((prompt2 (format "%s " (key-description (this-command-keys)))) | 1136 (let ((prompt2 (format "%s " (key-description (this-command-keys)))) |
918 (calc-unread-command (cdr key)) | 1141 (calc-unread-command (cdr key)) |
919 (unwind-protect | 1142 (unwind-protect |
920 (progn | 1143 (progn |
921 (use-global-map map) | 1144 (use-global-map map) |
922 (use-local-map nil) | 1145 (use-local-map nil) |
923 (read-key-sequence | 1146 (read-key-sequence nil)) |
924 (if (commandp (key-binding (if calc-emacs-type-19 | |
925 (vector (cdr key)) | |
926 (char-to-string (cdr key))))) | |
927 "" prompt2))) | |
928 (use-global-map glob) | 1147 (use-global-map glob) |
929 (use-local-map loc))))) | 1148 (use-local-map loc))))) |
930 | 1149 |
931 | 1150 (defvar calc-alg-map) ; Defined in calc-ext.el |
932 | 1151 |
933 (defun calc-mode () | 1152 (defun calc-mode () |
934 "Calculator major mode. | 1153 "Calculator major mode. |
935 | 1154 |
936 This is an RPN calculator featuring arbitrary-precision integer, rational, | 1155 This is an RPN calculator featuring arbitrary-precision integer, rational, |
964 (interactive) | 1183 (interactive) |
965 (mapcar (function | 1184 (mapcar (function |
966 (lambda (v) (set-default v (symbol-value v)))) calc-local-var-list) | 1185 (lambda (v) (set-default v (symbol-value v)))) calc-local-var-list) |
967 (kill-all-local-variables) | 1186 (kill-all-local-variables) |
968 (use-local-map (if (eq calc-algebraic-mode 'total) | 1187 (use-local-map (if (eq calc-algebraic-mode 'total) |
969 (progn (calc-extensions) calc-alg-map) calc-mode-map)) | 1188 (progn (require 'calc-ext) calc-alg-map) calc-mode-map)) |
970 (mapcar (function (lambda (v) (make-local-variable v))) calc-local-var-list) | 1189 (mapcar (function (lambda (v) (make-local-variable v))) calc-local-var-list) |
971 (make-local-variable 'overlay-arrow-position) | 1190 (make-local-variable 'overlay-arrow-position) |
972 (make-local-variable 'overlay-arrow-string) | 1191 (make-local-variable 'overlay-arrow-string) |
973 (add-hook 'change-major-mode-hook 'font-lock-defontify nil t) | 1192 (add-hook 'change-major-mode-hook 'font-lock-defontify nil t) |
974 (setq truncate-lines t) | 1193 (setq truncate-lines t) |
980 (setq calc-stack (list (list 'top-of-stack | 1199 (setq calc-stack (list (list 'top-of-stack |
981 1 nil)))))) | 1200 1 nil)))))) |
982 (setq calc-stack-top (- (length calc-stack) calc-stack-top -1)) | 1201 (setq calc-stack-top (- (length calc-stack) calc-stack-top -1)) |
983 (or calc-loaded-settings-file | 1202 (or calc-loaded-settings-file |
984 (null calc-settings-file) | 1203 (null calc-settings-file) |
985 (string-match "\\.emacs" calc-settings-file) | 1204 (equal calc-settings-file user-init-file) |
986 (progn | 1205 (progn |
987 (setq calc-loaded-settings-file t) | 1206 (setq calc-loaded-settings-file t) |
988 (load calc-settings-file t))) ; t = missing-ok | 1207 (load (file-name-sans-extension calc-settings-file) t))) ; t = missing-ok |
989 (if (and (eq window-system 'x) (boundp 'mouse-map)) | |
990 (substitute-key-definition 'x-paste-text 'calc-x-paste-text | |
991 mouse-map)) | |
992 (let ((p command-line-args)) | 1208 (let ((p command-line-args)) |
993 (while p | 1209 (while p |
994 (and (equal (car p) "-f") | 1210 (and (equal (car p) "-f") |
995 (string-match "calc" (nth 1 p)) | 1211 (string-match "calc" (nth 1 p)) |
996 (string-match "full" (nth 1 p)) | 1212 (string-match "full" (nth 1 p)) |
997 (setq calc-standalone-flag t)) | 1213 (setq calc-standalone-flag t)) |
998 (setq p (cdr p)))) | 1214 (setq p (cdr p)))) |
999 (run-hooks 'calc-mode-hook) | 1215 (run-mode-hooks 'calc-mode-hook) |
1000 (calc-refresh t) | 1216 (calc-refresh t) |
1001 (calc-set-mode-line) | 1217 (calc-set-mode-line) |
1002 ;; The calc-defs variable is a relic. Use calc-define properties instead. | |
1003 (when (and (boundp 'calc-defs) | |
1004 calc-defs) | |
1005 (message "Evaluating calc-defs...") | |
1006 (calc-need-macros) | |
1007 (eval (cons 'progn calc-defs)) | |
1008 (setq calc-defs nil) | |
1009 (calc-set-mode-line)) | |
1010 (calc-check-defines)) | 1218 (calc-check-defines)) |
1011 | 1219 |
1012 (defvar calc-check-defines 'calc-check-defines) ; suitable for run-hooks | 1220 (defvar calc-check-defines 'calc-check-defines) ; suitable for run-hooks |
1013 (defun calc-check-defines () | 1221 (defun calc-check-defines () |
1014 (if (symbol-plist 'calc-define) | 1222 (if (symbol-plist 'calc-define) |
1015 (let ((plist (copy-sequence (symbol-plist 'calc-define)))) | 1223 (let ((plist (copy-sequence (symbol-plist 'calc-define)))) |
1016 (while (and plist (null (nth 1 plist))) | 1224 (while (and plist (null (nth 1 plist))) |
1017 (setq plist (cdr (cdr plist)))) | 1225 (setq plist (cdr (cdr plist)))) |
1018 (if plist | 1226 (if plist |
1019 (save-excursion | 1227 (save-excursion |
1020 (calc-extensions) | 1228 (require 'calc-ext) |
1021 (calc-need-macros) | 1229 (require 'calc-macs) |
1022 (set-buffer "*Calculator*") | 1230 (set-buffer "*Calculator*") |
1023 (while plist | 1231 (while plist |
1024 (put 'calc-define (car plist) nil) | 1232 (put 'calc-define (car plist) nil) |
1025 (eval (nth 1 plist)) | 1233 (eval (nth 1 plist)) |
1026 (setq plist (cdr (cdr plist)))) | 1234 (setq plist (cdr (cdr plist)))) |
1045 (setq mode-name "Calc Trail") | 1253 (setq mode-name "Calc Trail") |
1046 (setq truncate-lines t) | 1254 (setq truncate-lines t) |
1047 (setq buffer-read-only t) | 1255 (setq buffer-read-only t) |
1048 (make-local-variable 'overlay-arrow-position) | 1256 (make-local-variable 'overlay-arrow-position) |
1049 (make-local-variable 'overlay-arrow-string) | 1257 (make-local-variable 'overlay-arrow-string) |
1050 (set (make-local-variable 'font-lock-defaults) | |
1051 '(nil t nil nil nil (font-lock-core-only . t))) | |
1052 (when buf | 1258 (when buf |
1053 (set (make-local-variable 'calc-main-buffer) buf)) | 1259 (set (make-local-variable 'calc-main-buffer) buf)) |
1054 (when (= (buffer-size) 0) | 1260 (when (= (buffer-size) 0) |
1055 (let ((buffer-read-only nil)) | 1261 (let ((buffer-read-only nil)) |
1056 (insert (propertize (concat "Emacs Calculator v" calc-version | 1262 (insert (propertize (concat "Emacs Calculator v" calc-version |
1057 " by Dave Gillespie\n") | 1263 " by Dave Gillespie\n") |
1058 'font-lock-face 'italic)))) | 1264 'font-lock-face 'italic)))) |
1059 (run-hooks 'calc-trail-mode-hook)) | 1265 (run-mode-hooks 'calc-trail-mode-hook)) |
1060 | 1266 |
1061 (defun calc-create-buffer () | 1267 (defun calc-create-buffer () |
1062 (set-buffer (get-buffer-create "*Calculator*")) | 1268 (set-buffer (get-buffer-create "*Calculator*")) |
1063 (or (eq major-mode 'calc-mode) | 1269 (or (eq major-mode 'calc-mode) |
1064 (calc-mode)) | 1270 (calc-mode)) |
1065 (setq max-lisp-eval-depth (max max-lisp-eval-depth 1000)) | 1271 (setq max-lisp-eval-depth (max max-lisp-eval-depth 1000)) |
1066 (when calc-always-load-extensions | 1272 (when calc-always-load-extensions |
1067 (calc-extensions)) | 1273 (require 'calc-ext)) |
1068 (when calc-language | 1274 (when calc-language |
1069 (calc-extensions) | 1275 (require 'calc-ext) |
1070 (calc-set-language calc-language calc-language-option t))) | 1276 (calc-set-language calc-language calc-language-option t))) |
1071 | 1277 |
1072 ;;;###autoload | 1278 ;;;###autoload |
1073 (defun calc (&optional arg full-display interactive) | 1279 (defun calc (&optional arg full-display interactive) |
1074 "The Emacs Calculator. Full documentation is listed under \"calc-mode\"." | 1280 "The Emacs Calculator. Full documentation is listed under \"calc-mode\"." |
1075 (interactive "P") | 1281 (interactive "P\ni\np") |
1076 (if arg | 1282 (if arg |
1077 (unless (eq arg 0) | 1283 (unless (eq arg 0) |
1078 (calc-extensions) | 1284 (require 'calc-ext) |
1079 (if (= (prefix-numeric-value arg) -1) | 1285 (if (= (prefix-numeric-value arg) -1) |
1080 (calc-grab-region (region-beginning) (region-end) nil) | 1286 (calc-grab-region (region-beginning) (region-end) nil) |
1081 (when (= (prefix-numeric-value arg) -2) | 1287 (when (= (prefix-numeric-value arg) -2) |
1082 (calc-keypad)))) | 1288 (calc-keypad)))) |
1083 (when (get-buffer-window "*Calc Keypad*") | 1289 (when (get-buffer-window "*Calc Keypad*") |
1091 (if (or (eq full-display t) | 1297 (if (or (eq full-display t) |
1092 (and (null full-display) calc-full-mode)) | 1298 (and (null full-display) calc-full-mode)) |
1093 (switch-to-buffer (current-buffer) t) | 1299 (switch-to-buffer (current-buffer) t) |
1094 (if (get-buffer-window (current-buffer)) | 1300 (if (get-buffer-window (current-buffer)) |
1095 (select-window (get-buffer-window (current-buffer))) | 1301 (select-window (get-buffer-window (current-buffer))) |
1096 (if (and (boundp 'calc-window-hook) calc-window-hook) | 1302 (if calc-window-hook |
1097 (run-hooks 'calc-window-hook) | 1303 (run-hooks 'calc-window-hook) |
1098 (let ((w (get-largest-window))) | 1304 (let ((w (get-largest-window))) |
1099 (if (and pop-up-windows | 1305 (if (and pop-up-windows |
1100 (> (window-height w) | 1306 (> (window-height w) |
1101 (+ window-min-height calc-window-height 2))) | 1307 (+ window-min-height calc-window-height 2))) |
1102 (progn | 1308 (progn |
1103 (setq w (split-window w | 1309 (setq w (split-window w |
1104 (- (window-height w) | 1310 (- (window-height w) |
1105 calc-window-height 2) | 1311 calc-window-height 2) |
1106 nil)) | 1312 nil)) |
1107 (set-window-buffer w (current-buffer)) | 1313 (set-window-buffer w (current-buffer)) |
1108 (select-window w)) | 1314 (select-window w)) |
1109 (pop-to-buffer (current-buffer))))))) | 1315 (pop-to-buffer (current-buffer))))))) |
1110 (save-excursion | 1316 (save-excursion |
1111 (set-buffer (calc-trail-buffer)) | 1317 (set-buffer (calc-trail-buffer)) |
1112 (and calc-display-trail | 1318 (and calc-display-trail |
1113 (= (window-width) (frame-width)) | 1319 (= (window-width) (frame-width)) |
1114 (calc-trail-display 1 t))) | 1320 (calc-trail-display 1 t))) |
1116 (run-hooks 'calc-start-hook) | 1322 (run-hooks 'calc-start-hook) |
1117 (and (windowp full-display) | 1323 (and (windowp full-display) |
1118 (window-point full-display) | 1324 (window-point full-display) |
1119 (select-window full-display)) | 1325 (select-window full-display)) |
1120 (calc-check-defines) | 1326 (calc-check-defines) |
1121 (when (and calc-said-hello | 1327 (when (and calc-said-hello interactive) |
1122 (or (interactive-p) interactive)) | |
1123 (sit-for 2) | 1328 (sit-for 2) |
1124 (message "")) | 1329 (message "")) |
1125 (setq calc-said-hello t))))) | 1330 (setq calc-said-hello t))))) |
1126 | 1331 |
1127 ;;;###autoload | 1332 ;;;###autoload |
1128 (defun full-calc () | 1333 (defun full-calc (&optional interactive) |
1129 "Invoke the Calculator and give it a full-sized window." | 1334 "Invoke the Calculator and give it a full-sized window." |
1130 (interactive) | 1335 (interactive "p") |
1131 (calc nil t (interactive-p))) | 1336 (calc nil t interactive)) |
1132 | 1337 |
1133 (defun calc-same-interface (arg) | 1338 (defun calc-same-interface (arg) |
1134 "Invoke the Calculator using the most recent interface (calc or calc-keypad)." | 1339 "Invoke the Calculator using the most recent interface (calc or calc-keypad)." |
1135 (interactive "P") | 1340 (interactive "P") |
1136 (if (and (equal (buffer-name) "*Gnuplot Trail*") | 1341 (if (and (equal (buffer-name) "*Gnuplot Trail*") |
1137 (> (recursion-depth) 0)) | 1342 (> (recursion-depth) 0)) |
1138 (exit-recursive-edit) | 1343 (exit-recursive-edit) |
1139 (if (eq major-mode 'calc-edit-mode) | 1344 (if (eq major-mode 'calc-edit-mode) |
1140 (calc-edit-finish arg) | 1345 (calc-edit-finish arg) |
1141 (if (eq major-mode 'MacEdit-mode) | 1346 (if calc-was-keypad-mode |
1142 (MacEdit-finish-edit) | 1347 (calc-keypad) |
1143 (if calc-was-keypad-mode | 1348 (calc arg calc-full-mode t))))) |
1144 (calc-keypad) | 1349 |
1145 (calc arg calc-full-mode t)))))) | 1350 (defun calc-quit (&optional non-fatal interactive) |
1146 | 1351 (interactive "i\np") |
1147 | |
1148 (defun calc-quit (&optional non-fatal) | |
1149 (interactive) | |
1150 (and calc-standalone-flag (not non-fatal) | 1352 (and calc-standalone-flag (not non-fatal) |
1151 (save-buffers-kill-emacs nil)) | 1353 (save-buffers-kill-emacs nil)) |
1152 (if (and (equal (buffer-name) "*Gnuplot Trail*") | 1354 (if (and (equal (buffer-name) "*Gnuplot Trail*") |
1153 (> (recursion-depth) 0)) | 1355 (> (recursion-depth) 0)) |
1154 (exit-recursive-edit)) | 1356 (exit-recursive-edit)) |
1155 (if (eq major-mode 'calc-edit-mode) | 1357 (if (eq major-mode 'calc-edit-mode) |
1156 (calc-edit-cancel) | 1358 (calc-edit-cancel) |
1157 (if (eq major-mode 'MacEdit-mode) | 1359 (if (and interactive |
1158 (MacEdit-cancel-edit) | 1360 calc-embedded-info |
1159 (if (and (interactive-p) | 1361 (eq (current-buffer) (aref calc-embedded-info 0))) |
1160 calc-embedded-info | 1362 (calc-embedded nil) |
1161 (eq (current-buffer) (aref calc-embedded-info 0))) | 1363 (unless (eq major-mode 'calc-mode) |
1162 (calc-embedded nil) | 1364 (calc-create-buffer)) |
1163 (unless (eq major-mode 'calc-mode) | 1365 (run-hooks 'calc-end-hook) |
1164 (calc-create-buffer)) | 1366 (setq calc-undo-list nil calc-redo-list nil) |
1165 (run-hooks 'calc-end-hook) | 1367 (mapcar (function (lambda (v) (set-default v (symbol-value v)))) |
1166 (setq calc-undo-list nil calc-redo-list nil) | 1368 calc-local-var-list) |
1167 (mapcar (function (lambda (v) (set-default v (symbol-value v)))) | 1369 (let ((buf (current-buffer)) |
1168 calc-local-var-list) | 1370 (win (get-buffer-window (current-buffer))) |
1169 (let ((buf (current-buffer)) | 1371 (kbuf (get-buffer "*Calc Keypad*"))) |
1170 (win (get-buffer-window (current-buffer))) | 1372 (delete-windows-on (calc-trail-buffer)) |
1171 (kbuf (get-buffer "*Calc Keypad*"))) | 1373 (if (and win |
1172 (delete-windows-on (calc-trail-buffer)) | 1374 (< (window-height win) (1- (frame-height))) |
1173 (if (and win | 1375 (= (window-width win) (frame-width)) ; avoid calc-keypad |
1174 (< (window-height win) (1- (frame-height))) | 1376 (not (get-buffer-window "*Calc Keypad*"))) |
1175 (= (window-width win) (frame-width)) ; avoid calc-keypad | 1377 (setq calc-window-height (- (window-height win) 2))) |
1176 (not (get-buffer-window "*Calc Keypad*"))) | 1378 (progn |
1177 (setq calc-window-height (- (window-height win) 2))) | 1379 (delete-windows-on buf) |
1178 (progn | 1380 (delete-windows-on kbuf)) |
1179 (delete-windows-on buf) | 1381 (bury-buffer buf) |
1180 (delete-windows-on kbuf)) | 1382 (bury-buffer calc-trail-buffer) |
1181 (bury-buffer buf) | 1383 (and kbuf (bury-buffer kbuf)))))) |
1182 (bury-buffer calc-trail-buffer) | |
1183 (and kbuf (bury-buffer kbuf))))))) | |
1184 | 1384 |
1185 ;;;###autoload | 1385 ;;;###autoload |
1186 (defun quick-calc () | 1386 (defun quick-calc () |
1187 "Do a quick calculation in the minibuffer without invoking full Calculator." | 1387 "Do a quick calculation in the minibuffer without invoking full Calculator." |
1188 (interactive) | 1388 (interactive) |
1194 Return value will either be the formatted result in string form, | 1394 Return value will either be the formatted result in string form, |
1195 or a list containing a character position and an error message in string form." | 1395 or a list containing a character position and an error message in string form." |
1196 (calc-do-calc-eval str separator args)) | 1396 (calc-do-calc-eval str separator args)) |
1197 | 1397 |
1198 ;;;###autoload | 1398 ;;;###autoload |
1199 (defun calc-keypad () | 1399 (defun calc-keypad (&optional interactive) |
1200 "Invoke the Calculator in \"visual keypad\" mode. | 1400 "Invoke the Calculator in \"visual keypad\" mode. |
1201 This is most useful in the X window system. | 1401 This is most useful in the X window system. |
1202 In this mode, click on the Calc \"buttons\" using the left mouse button. | 1402 In this mode, click on the Calc \"buttons\" using the left mouse button. |
1203 Or, position the cursor manually and do M-x calc-keypad-press." | 1403 Or, position the cursor manually and do M-x calc-keypad-press." |
1204 (interactive) | 1404 (interactive "p") |
1205 (calc-extensions) | 1405 (require 'calc-ext) |
1206 (calc-do-keypad calc-full-mode (interactive-p))) | 1406 (calc-do-keypad calc-full-mode interactive)) |
1207 | 1407 |
1208 ;;;###autoload | 1408 ;;;###autoload |
1209 (defun full-calc-keypad () | 1409 (defun full-calc-keypad (&optional interactive) |
1210 "Invoke the Calculator in full-screen \"visual keypad\" mode. | 1410 "Invoke the Calculator in full-screen \"visual keypad\" mode. |
1211 See calc-keypad for details." | 1411 See calc-keypad for details." |
1212 (interactive) | 1412 (interactive "p") |
1213 (calc-extensions) | 1413 (require 'calc-ext) |
1214 (calc-do-keypad t (interactive-p))) | 1414 (calc-do-keypad t interactive)) |
1215 | 1415 |
1216 | 1416 |
1217 (defvar calc-aborted-prefix nil) | 1417 (defvar calc-aborted-prefix nil) |
1218 (defvar calc-start-time nil) | 1418 (defvar calc-start-time nil) |
1219 (defvar calc-command-flags) | 1419 (defvar calc-command-flags) |
1222 ;;; Note that modifications to this function may break calc-pass-errors. | 1422 ;;; Note that modifications to this function may break calc-pass-errors. |
1223 (defun calc-do (do-body &optional do-slow) | 1423 (defun calc-do (do-body &optional do-slow) |
1224 (calc-check-defines) | 1424 (calc-check-defines) |
1225 (let* ((calc-command-flags nil) | 1425 (let* ((calc-command-flags nil) |
1226 (calc-start-time (and calc-timing (not calc-start-time) | 1426 (calc-start-time (and calc-timing (not calc-start-time) |
1227 (calc-extensions) | 1427 (require 'calc-ext) |
1228 (current-time-string))) | 1428 (current-time-string))) |
1229 (gc-cons-threshold (max gc-cons-threshold | 1429 (gc-cons-threshold (max gc-cons-threshold |
1230 (if calc-timing 2000000 100000))) | 1430 (if calc-timing 2000000 100000))) |
1231 calc-final-point-line calc-final-point-column) | 1431 calc-final-point-line calc-final-point-column) |
1232 (setq calc-aborted-prefix "") | 1432 (setq calc-aborted-prefix "") |
1235 (save-excursion | 1435 (save-excursion |
1236 (if calc-embedded-info | 1436 (if calc-embedded-info |
1237 (calc-embedded-select-buffer) | 1437 (calc-embedded-select-buffer) |
1238 (calc-select-buffer)) | 1438 (calc-select-buffer)) |
1239 (and (eq calc-algebraic-mode 'total) | 1439 (and (eq calc-algebraic-mode 'total) |
1240 (calc-extensions) | 1440 (require 'calc-ext) |
1241 (use-local-map calc-alg-map)) | 1441 (use-local-map calc-alg-map)) |
1242 (when (and do-slow calc-display-working-message) | 1442 (when (and do-slow calc-display-working-message) |
1243 (message "Working...") | 1443 (message "Working...") |
1244 (calc-set-command-flag 'clear-message)) | 1444 (calc-set-command-flag 'clear-message)) |
1245 (funcall do-body) | 1445 (funcall do-body) |
1351 ;; Computational modes | 1551 ;; Computational modes |
1352 (if calc-symbolic-mode "Symb " "") | 1552 (if calc-symbolic-mode "Symb " "") |
1353 (cond ((eq calc-matrix-mode 'matrix) "Matrix ") | 1553 (cond ((eq calc-matrix-mode 'matrix) "Matrix ") |
1354 ((integerp calc-matrix-mode) | 1554 ((integerp calc-matrix-mode) |
1355 (format "Matrix%d " calc-matrix-mode)) | 1555 (format "Matrix%d " calc-matrix-mode)) |
1556 ((eq calc-matrix-mode 'sqmatrix) "SqMatrix ") | |
1356 ((eq calc-matrix-mode 'scalar) "Scalar ") | 1557 ((eq calc-matrix-mode 'scalar) "Scalar ") |
1357 (t "")) | 1558 (t "")) |
1358 (if (eq calc-complex-mode 'polar) "Polar " "") | 1559 (if (eq calc-complex-mode 'polar) "Polar " "") |
1359 (if calc-prefer-frac "Frac " "") | 1560 (if calc-prefer-frac "Frac " "") |
1360 (cond ((null calc-infinite-mode) "") | 1561 (cond ((null calc-infinite-mode) "") |
1376 ((= calc-number-radix 16) "Hex ") | 1577 ((= calc-number-radix 16) "Hex ") |
1377 (t (format "Radix%d " calc-number-radix))) | 1578 (t (format "Radix%d " calc-number-radix))) |
1378 (if calc-leading-zeros "Zero " "") | 1579 (if calc-leading-zeros "Zero " "") |
1379 (cond ((null calc-language) "") | 1580 (cond ((null calc-language) "") |
1380 ((eq calc-language 'tex) "TeX ") | 1581 ((eq calc-language 'tex) "TeX ") |
1582 ((eq calc-language 'latex) "LaTeX ") | |
1381 (t (concat | 1583 (t (concat |
1382 (capitalize (symbol-name calc-language)) | 1584 (capitalize (symbol-name calc-language)) |
1383 " "))) | 1585 " "))) |
1384 (cond ((eq fmt 'float) | 1586 (cond ((eq fmt 'float) |
1385 (if (zerop figs) "" (format "Norm%d " figs))) | 1587 (if (zerop figs) "" (format "Norm%d " figs))) |
1510 (calc-handle-whys)) | 1712 (calc-handle-whys)) |
1511 | 1713 |
1512 (defun calc-normalize (val) | 1714 (defun calc-normalize (val) |
1513 (if (memq calc-simplify-mode '(nil none num)) | 1715 (if (memq calc-simplify-mode '(nil none num)) |
1514 (math-normalize val) | 1716 (math-normalize val) |
1515 (calc-extensions) | 1717 (require 'calc-ext) |
1516 (calc-normalize-fancy val))) | 1718 (calc-normalize-fancy val))) |
1517 | 1719 |
1518 (defun calc-handle-whys () | 1720 (defun calc-handle-whys () |
1519 (if calc-next-why | 1721 (if calc-next-why |
1520 (calc-do-handle-whys))) | 1722 (calc-do-handle-whys))) |
1651 (save-excursion | 1853 (save-excursion |
1652 (set-buffer (aref calc-embedded-info 1)) | 1854 (set-buffer (aref calc-embedded-info 1)) |
1653 (calc-refresh align))) | 1855 (calc-refresh align))) |
1654 (setq calc-refresh-count (1+ calc-refresh-count))) | 1856 (setq calc-refresh-count (1+ calc-refresh-count))) |
1655 | 1857 |
1656 | |
1657 (defun calc-x-paste-text (arg) | |
1658 "Move point to mouse position and insert window system cut buffer contents. | |
1659 If mouse is pressed in Calc window, push cut buffer contents onto the stack." | |
1660 (x-mouse-select arg) | |
1661 (if (memq major-mode '(calc-mode calc-trail-mode)) | |
1662 (progn | |
1663 (calc-wrapper | |
1664 (calc-extensions) | |
1665 (let* ((buf (x-get-cut-buffer)) | |
1666 (val (math-read-exprs (calc-clean-newlines buf)))) | |
1667 (if (eq (car-safe val) 'error) | |
1668 (progn | |
1669 (setq val (math-read-exprs buf)) | |
1670 (if (eq (car-safe val) 'error) | |
1671 (error "%s in yanked data" (nth 2 val))))) | |
1672 (calc-enter-result 0 "Xynk" val)))) | |
1673 (x-paste-text arg))) | |
1674 | |
1675 | |
1676 | |
1677 ;;;; The Calc Trail buffer. | 1858 ;;;; The Calc Trail buffer. |
1678 | 1859 |
1679 (defun calc-check-trail-aligned () | 1860 (defun calc-check-trail-aligned () |
1680 (save-excursion | 1861 (save-excursion |
1681 (let ((win (get-buffer-window (current-buffer)))) | 1862 (let ((win (get-buffer-window (current-buffer)))) |
1730 (calc-trail-here)) | 1911 (calc-trail-here)) |
1731 (goto-char (1- (point-max)))))))) | 1912 (goto-char (1- (point-max)))))))) |
1732 val) | 1913 val) |
1733 | 1914 |
1734 | 1915 |
1735 (defun calc-trail-display (flag &optional no-refresh) | 1916 (defun calc-trail-display (flag &optional no-refresh interactive) |
1736 (interactive "P") | 1917 (interactive "P\ni\np") |
1737 (let ((win (get-buffer-window (calc-trail-buffer)))) | 1918 (let ((win (get-buffer-window (calc-trail-buffer)))) |
1738 (if (setq calc-display-trail | 1919 (if (setq calc-display-trail |
1739 (not (if flag (memq flag '(nil 0)) win))) | 1920 (not (if flag (memq flag '(nil 0)) win))) |
1740 (if (null win) | 1921 (if (null win) |
1741 (progn | 1922 (progn |
1742 (if (and (boundp 'calc-trail-window-hook) calc-trail-window-hook) | 1923 (if calc-trail-window-hook |
1743 (run-hooks 'calc-trail-window-hook) | 1924 (run-hooks 'calc-trail-window-hook) |
1744 (let ((w (split-window nil (/ (* (window-width) 2) 3) t))) | 1925 (let ((w (split-window nil (/ (* (window-width) 2) 3) t))) |
1745 (set-window-buffer w calc-trail-buffer))) | 1926 (set-window-buffer w calc-trail-buffer))) |
1746 (calc-wrapper | 1927 (calc-wrapper |
1747 (setq overlay-arrow-string calc-trail-overlay | 1928 (setq overlay-arrow-string calc-trail-overlay |
1748 overlay-arrow-position calc-trail-pointer) | 1929 overlay-arrow-position calc-trail-pointer) |
1749 (or no-refresh | 1930 (or no-refresh |
1750 (if (interactive-p) | 1931 (if interactive |
1751 (calc-do-refresh) | 1932 (calc-do-refresh) |
1752 (calc-refresh)))))) | 1933 (calc-refresh)))))) |
1753 (if win | 1934 (if win |
1754 (progn | 1935 (progn |
1755 (delete-window win) | 1936 (delete-window win) |
1756 (calc-wrapper | 1937 (calc-wrapper |
1757 (or no-refresh | 1938 (or no-refresh |
1758 (if (interactive-p) | 1939 (if interactive |
1759 (calc-do-refresh) | 1940 (calc-do-refresh) |
1760 (calc-refresh)))))))) | 1941 (calc-refresh)))))))) |
1761 calc-trail-buffer) | 1942 calc-trail-buffer) |
1762 | 1943 |
1763 (defun calc-trail-here () | 1944 (defun calc-trail-here () |
1813 (setq calc-aborted-prefix name) | 1994 (setq calc-aborted-prefix name) |
1814 (if (null arg) | 1995 (if (null arg) |
1815 (calc-enter-result 2 name (cons (or func2 func) | 1996 (calc-enter-result 2 name (cons (or func2 func) |
1816 (mapcar 'math-check-complete | 1997 (mapcar 'math-check-complete |
1817 (calc-top-list 2)))) | 1998 (calc-top-list 2)))) |
1818 (calc-extensions) | 1999 (require 'calc-ext) |
1819 (calc-binary-op-fancy name func arg ident unary))) | 2000 (calc-binary-op-fancy name func arg ident unary))) |
1820 | 2001 |
1821 (defun calc-unary-op (name func arg &optional func2) | 2002 (defun calc-unary-op (name func arg &optional func2) |
1822 (setq calc-aborted-prefix name) | 2003 (setq calc-aborted-prefix name) |
1823 (if (null arg) | 2004 (if (null arg) |
1824 (calc-enter-result 1 name (list (or func2 func) | 2005 (calc-enter-result 1 name (list (or func2 func) |
1825 (math-check-complete (calc-top 1)))) | 2006 (math-check-complete (calc-top 1)))) |
1826 (calc-extensions) | 2007 (require 'calc-ext) |
1827 (calc-unary-op-fancy name func arg))) | 2008 (calc-unary-op-fancy name func arg))) |
1828 | 2009 |
1829 | 2010 |
1830 (defun calc-plus (arg) | 2011 (defun calc-plus (arg) |
1831 (interactive "P") | 2012 (interactive "P") |
1845 (defun calc-divide (arg) | 2026 (defun calc-divide (arg) |
1846 (interactive "P") | 2027 (interactive "P") |
1847 (calc-slow-wrapper | 2028 (calc-slow-wrapper |
1848 (calc-binary-op "/" 'calcFunc-div arg 0 'calcFunc-inv '/))) | 2029 (calc-binary-op "/" 'calcFunc-div arg 0 'calcFunc-inv '/))) |
1849 | 2030 |
2031 (defun calc-left-divide (arg) | |
2032 (interactive "P") | |
2033 (calc-slow-wrapper | |
2034 (calc-binary-op "ldiv" 'calcFunc-ldiv arg 0 nil nil))) | |
1850 | 2035 |
1851 (defun calc-change-sign (arg) | 2036 (defun calc-change-sign (arg) |
1852 (interactive "P") | 2037 (interactive "P") |
1853 (calc-wrapper | 2038 (calc-wrapper |
1854 (calc-unary-op "chs" 'neg arg))) | 2039 (calc-unary-op "chs" 'neg arg))) |
1933 (if calc-digit-value | 2118 (if calc-digit-value |
1934 (calc-push-list (list (calc-record (calc-normalize | 2119 (calc-push-list (list (calc-record (calc-normalize |
1935 calc-digit-value)))))) | 2120 calc-digit-value)))))) |
1936 (if (eq calc-prev-char 'dots) | 2121 (if (eq calc-prev-char 'dots) |
1937 (progn | 2122 (progn |
1938 (calc-extensions) | 2123 (require 'calc-ext) |
1939 (calc-dots))))))) | 2124 (calc-dots))))))) |
1940 | 2125 |
1941 (defsubst calc-minibuffer-size () | 2126 (defsubst calc-minibuffer-size () |
1942 (- (point-max) (minibuffer-prompt-end))) | 2127 (- (point-max) (minibuffer-prompt-end))) |
1943 | 2128 |
2039 (insert " ")) | 2224 (insert " ")) |
2040 (insert "mod ")))) | 2225 (insert "mod ")))) |
2041 (t | 2226 (t |
2042 (insert (char-to-string last-command-char)) | 2227 (insert (char-to-string last-command-char)) |
2043 (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]*\\)?\\)?\\'") | 2228 (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]*\\)?\\)?\\'") |
2044 (let ((radix (string-to-int | 2229 (let ((radix (string-to-number |
2045 (buffer-substring | 2230 (buffer-substring |
2046 (match-beginning 2) (match-end 2))))) | 2231 (match-beginning 2) (match-end 2))))) |
2047 (and (>= radix 2) | 2232 (and (>= radix 2) |
2048 (<= radix 36) | 2233 (<= radix 36) |
2049 (or (memq last-command-char '(?# ?: ?. ?e ?+ ?-)) | 2234 (or (memq last-command-char '(?# ?: ?. ?e ?+ ?-)) |
2057 (string-match " " calc-hms-format)) | 2242 (string-match " " calc-hms-format)) |
2058 (insert " ")) | 2243 (insert " ")) |
2059 (if (and (eq this-command last-command) | 2244 (if (and (eq this-command last-command) |
2060 (eq last-command-char ?.)) | 2245 (eq last-command-char ?.)) |
2061 (progn | 2246 (progn |
2062 (calc-extensions) | 2247 (require 'calc-ext) |
2063 (calc-digit-dots)) | 2248 (calc-digit-dots)) |
2064 (delete-backward-char 1) | 2249 (delete-backward-char 1) |
2065 (beep) | 2250 (beep) |
2066 (calc-temp-minibuffer-message " [Bad format]")))))) | 2251 (calc-temp-minibuffer-message " [Bad format]")))))) |
2067 (setq calc-prev-prev-char calc-prev-char | 2252 (setq calc-prev-prev-char calc-prev-char |
2183 ;;; [This notation has been neglected in many recent routines.] | 2368 ;;; [This notation has been neglected in many recent routines.] |
2184 | 2369 |
2185 (defvar math-eval-rules-cache) | 2370 (defvar math-eval-rules-cache) |
2186 (defvar math-eval-rules-cache-other) | 2371 (defvar math-eval-rules-cache-other) |
2187 ;;; Reduce an object to canonical (normalized) form. [O o; Z Z] [Public] | 2372 ;;; Reduce an object to canonical (normalized) form. [O o; Z Z] [Public] |
2188 (defun math-normalize (a) | 2373 |
2374 (defvar math-normalize-a) | |
2375 (defun math-normalize (math-normalize-a) | |
2189 (cond | 2376 (cond |
2190 ((not (consp a)) | 2377 ((not (consp math-normalize-a)) |
2191 (if (integerp a) | 2378 (if (integerp math-normalize-a) |
2192 (if (or (>= a 1000000) (<= a -1000000)) | 2379 (if (or (>= math-normalize-a 1000000) (<= math-normalize-a -1000000)) |
2193 (math-bignum a) | 2380 (math-bignum math-normalize-a) |
2194 a) | 2381 math-normalize-a) |
2195 a)) | 2382 math-normalize-a)) |
2196 ((eq (car a) 'bigpos) | 2383 ((eq (car math-normalize-a) 'bigpos) |
2197 (if (eq (nth (1- (length a)) a) 0) | 2384 (if (eq (nth (1- (length math-normalize-a)) math-normalize-a) 0) |
2198 (let* ((last (setq a (copy-sequence a))) (digs a)) | 2385 (let* ((last (setq math-normalize-a |
2386 (copy-sequence math-normalize-a))) (digs math-normalize-a)) | |
2199 (while (setq digs (cdr digs)) | 2387 (while (setq digs (cdr digs)) |
2200 (or (eq (car digs) 0) (setq last digs))) | 2388 (or (eq (car digs) 0) (setq last digs))) |
2201 (setcdr last nil))) | 2389 (setcdr last nil))) |
2202 (if (cdr (cdr (cdr a))) | 2390 (if (cdr (cdr (cdr math-normalize-a))) |
2203 a | 2391 math-normalize-a |
2204 (cond | 2392 (cond |
2205 ((cdr (cdr a)) (+ (nth 1 a) (* (nth 2 a) 1000))) | 2393 ((cdr (cdr math-normalize-a)) (+ (nth 1 math-normalize-a) |
2206 ((cdr a) (nth 1 a)) | 2394 (* (nth 2 math-normalize-a) 1000))) |
2395 ((cdr math-normalize-a) (nth 1 math-normalize-a)) | |
2207 (t 0)))) | 2396 (t 0)))) |
2208 ((eq (car a) 'bigneg) | 2397 ((eq (car math-normalize-a) 'bigneg) |
2209 (if (eq (nth (1- (length a)) a) 0) | 2398 (if (eq (nth (1- (length math-normalize-a)) math-normalize-a) 0) |
2210 (let* ((last (setq a (copy-sequence a))) (digs a)) | 2399 (let* ((last (setq math-normalize-a (copy-sequence math-normalize-a))) |
2400 (digs math-normalize-a)) | |
2211 (while (setq digs (cdr digs)) | 2401 (while (setq digs (cdr digs)) |
2212 (or (eq (car digs) 0) (setq last digs))) | 2402 (or (eq (car digs) 0) (setq last digs))) |
2213 (setcdr last nil))) | 2403 (setcdr last nil))) |
2214 (if (cdr (cdr (cdr a))) | 2404 (if (cdr (cdr (cdr math-normalize-a))) |
2215 a | 2405 math-normalize-a |
2216 (cond | 2406 (cond |
2217 ((cdr (cdr a)) (- (+ (nth 1 a) (* (nth 2 a) 1000)))) | 2407 ((cdr (cdr math-normalize-a)) (- (+ (nth 1 math-normalize-a) |
2218 ((cdr a) (- (nth 1 a))) | 2408 (* (nth 2 math-normalize-a) 1000)))) |
2409 ((cdr math-normalize-a) (- (nth 1 math-normalize-a))) | |
2219 (t 0)))) | 2410 (t 0)))) |
2220 ((eq (car a) 'float) | 2411 ((eq (car math-normalize-a) 'float) |
2221 (math-make-float (math-normalize (nth 1 a)) (nth 2 a))) | 2412 (math-make-float (math-normalize (nth 1 math-normalize-a)) |
2222 ((or (memq (car a) '(frac cplx polar hms date mod sdev intv vec var quote | 2413 (nth 2 math-normalize-a))) |
2223 special-const calcFunc-if calcFunc-lambda | 2414 ((or (memq (car math-normalize-a) |
2224 calcFunc-quote calcFunc-condition | 2415 '(frac cplx polar hms date mod sdev intv vec var quote |
2225 calcFunc-evalto)) | 2416 special-const calcFunc-if calcFunc-lambda |
2226 (integerp (car a)) | 2417 calcFunc-quote calcFunc-condition |
2227 (and (consp (car a)) (not (eq (car (car a)) 'lambda)))) | 2418 calcFunc-evalto)) |
2228 (calc-extensions) | 2419 (integerp (car math-normalize-a)) |
2229 (math-normalize-fancy a)) | 2420 (and (consp (car math-normalize-a)) |
2421 (not (eq (car (car math-normalize-a)) 'lambda)))) | |
2422 (require 'calc-ext) | |
2423 (math-normalize-fancy math-normalize-a)) | |
2230 (t | 2424 (t |
2231 (or (and calc-simplify-mode | 2425 (or (and calc-simplify-mode |
2232 (calc-extensions) | 2426 (require 'calc-ext) |
2233 (math-normalize-nonstandard)) | 2427 (math-normalize-nonstandard)) |
2234 (let ((args (mapcar 'math-normalize (cdr a)))) | 2428 (let ((args (mapcar 'math-normalize (cdr math-normalize-a)))) |
2235 (or (condition-case err | 2429 (or (condition-case err |
2236 (let ((func (assq (car a) '( ( + . math-add ) | 2430 (let ((func |
2237 ( - . math-sub ) | 2431 (assq (car math-normalize-a) '( ( + . math-add ) |
2238 ( * . math-mul ) | 2432 ( - . math-sub ) |
2239 ( / . math-div ) | 2433 ( * . math-mul ) |
2240 ( % . math-mod ) | 2434 ( / . math-div ) |
2241 ( ^ . math-pow ) | 2435 ( % . math-mod ) |
2242 ( neg . math-neg ) | 2436 ( ^ . math-pow ) |
2243 ( | . math-concat ) )))) | 2437 ( neg . math-neg ) |
2438 ( | . math-concat ) )))) | |
2244 (or (and var-EvalRules | 2439 (or (and var-EvalRules |
2245 (progn | 2440 (progn |
2246 (or (eq var-EvalRules math-eval-rules-cache-tag) | 2441 (or (eq var-EvalRules math-eval-rules-cache-tag) |
2247 (progn | 2442 (progn |
2248 (calc-extensions) | 2443 (require 'calc-ext) |
2249 (math-recompile-eval-rules))) | 2444 (math-recompile-eval-rules))) |
2250 (and (or math-eval-rules-cache-other | 2445 (and (or math-eval-rules-cache-other |
2251 (assq (car a) math-eval-rules-cache)) | 2446 (assq (car math-normalize-a) |
2447 math-eval-rules-cache)) | |
2252 (math-apply-rewrites | 2448 (math-apply-rewrites |
2253 (cons (car a) args) | 2449 (cons (car math-normalize-a) args) |
2254 (cdr math-eval-rules-cache) | 2450 (cdr math-eval-rules-cache) |
2255 nil math-eval-rules-cache)))) | 2451 nil math-eval-rules-cache)))) |
2256 (if func | 2452 (if func |
2257 (apply (cdr func) args) | 2453 (apply (cdr func) args) |
2258 (and (or (consp (car a)) | 2454 (and (or (consp (car math-normalize-a)) |
2259 (fboundp (car a)) | 2455 (fboundp (car math-normalize-a)) |
2260 (and (not calc-extensions-loaded) | 2456 (and (not (featurep 'calc-ext)) |
2261 (calc-extensions) | 2457 (require 'calc-ext) |
2262 (fboundp (car a)))) | 2458 (fboundp (car math-normalize-a)))) |
2263 (apply (car a) args))))) | 2459 (apply (car math-normalize-a) args))))) |
2264 (wrong-number-of-arguments | 2460 (wrong-number-of-arguments |
2265 (calc-record-why "*Wrong number of arguments" | 2461 (calc-record-why "*Wrong number of arguments" |
2266 (cons (car a) args)) | 2462 (cons (car math-normalize-a) args)) |
2267 nil) | 2463 nil) |
2268 (wrong-type-argument | 2464 (wrong-type-argument |
2269 (or calc-next-why (calc-record-why "Wrong type of argument" | 2465 (or calc-next-why |
2270 (cons (car a) args))) | 2466 (calc-record-why "Wrong type of argument" |
2467 (cons (car math-normalize-a) args))) | |
2271 nil) | 2468 nil) |
2272 (args-out-of-range | 2469 (args-out-of-range |
2273 (calc-record-why "*Argument out of range" (cons (car a) args)) | 2470 (calc-record-why "*Argument out of range" |
2471 (cons (car math-normalize-a) args)) | |
2274 nil) | 2472 nil) |
2275 (inexact-result | 2473 (inexact-result |
2276 (calc-record-why "No exact representation for result" | 2474 (calc-record-why "No exact representation for result" |
2277 (cons (car a) args)) | 2475 (cons (car math-normalize-a) args)) |
2278 nil) | 2476 nil) |
2279 (math-overflow | 2477 (math-overflow |
2280 (calc-record-why "*Floating-point overflow occurred" | 2478 (calc-record-why "*Floating-point overflow occurred" |
2281 (cons (car a) args)) | 2479 (cons (car math-normalize-a) args)) |
2282 nil) | 2480 nil) |
2283 (math-underflow | 2481 (math-underflow |
2284 (calc-record-why "*Floating-point underflow occurred" | 2482 (calc-record-why "*Floating-point underflow occurred" |
2285 (cons (car a) args)) | 2483 (cons (car math-normalize-a) args)) |
2286 nil) | 2484 nil) |
2287 (void-variable | 2485 (void-variable |
2288 (if (eq (nth 1 err) 'var-EvalRules) | 2486 (if (eq (nth 1 err) 'var-EvalRules) |
2289 (progn | 2487 (progn |
2290 (setq var-EvalRules nil) | 2488 (setq var-EvalRules nil) |
2291 (math-normalize (cons (car a) args))) | 2489 (math-normalize (cons (car math-normalize-a) args))) |
2292 (calc-record-why "*Variable is void" (nth 1 err))))) | 2490 (calc-record-why "*Variable is void" (nth 1 err))))) |
2293 (if (consp (car a)) | 2491 (if (consp (car math-normalize-a)) |
2294 (math-dimension-error) | 2492 (math-dimension-error) |
2295 (cons (car a) args)))))))) | 2493 (cons (car math-normalize-a) args)))))))) |
2296 | 2494 |
2297 | 2495 |
2298 | 2496 |
2299 ;;; True if A is a floating-point real or complex number. [P x] [Public] | 2497 ;;; True if A is a floating-point real or complex number. [P x] [Public] |
2300 (defun math-floatp (a) | 2498 (defun math-floatp (a) |
2522 (if (eq diff 'neg) | 2720 (if (eq diff 'neg) |
2523 (cons 'bigneg (math-sub-bignum (cdr b) (cdr a))) | 2721 (cons 'bigneg (math-sub-bignum (cdr b) (cdr a))) |
2524 (cons 'bigpos diff)))) | 2722 (cons 'bigpos diff)))) |
2525 (cons 'bigpos (math-add-bignum (cdr a) (cdr b))))))) | 2723 (cons 'bigpos (math-add-bignum (cdr a) (cdr b))))))) |
2526 (and (Math-ratp a) (Math-ratp b) | 2724 (and (Math-ratp a) (Math-ratp b) |
2527 (calc-extensions) | 2725 (require 'calc-ext) |
2528 (calc-add-fractions a b)) | 2726 (calc-add-fractions a b)) |
2529 (and (Math-realp a) (Math-realp b) | 2727 (and (Math-realp a) (Math-realp b) |
2530 (progn | 2728 (progn |
2531 (or (and (consp a) (eq (car a) 'float)) | 2729 (or (and (consp a) (eq (car a) 'float)) |
2532 (setq a (math-float a))) | 2730 (setq a (math-float a))) |
2533 (or (and (consp b) (eq (car b) 'float)) | 2731 (or (and (consp b) (eq (car b) 'float)) |
2534 (setq b (math-float b))) | 2732 (setq b (math-float b))) |
2535 (math-add-float a b))) | 2733 (math-add-float a b))) |
2536 (and (calc-extensions) | 2734 (and (require 'calc-ext) |
2537 (math-add-objects-fancy a b)))) | 2735 (math-add-objects-fancy a b)))) |
2538 (and (calc-extensions) | 2736 (and (require 'calc-ext) |
2539 (math-add-symb-fancy a b)))) | 2737 (math-add-symb-fancy a b)))) |
2540 | 2738 |
2541 (defun math-add-bignum (a b) ; [L L L; l l l] | 2739 (defun math-add-bignum (a b) ; [L L L; l l l] |
2542 (if a | 2740 (if a |
2543 (if b | 2741 (if b |
2662 (< a 1000) (> a -1000) (< b 1000) (> b -1000) | 2860 (< a 1000) (> a -1000) (< b 1000) (> b -1000) |
2663 (* a b)) | 2861 (* a b)) |
2664 (and (Math-zerop a) (not (eq (car-safe b) 'mod)) | 2862 (and (Math-zerop a) (not (eq (car-safe b) 'mod)) |
2665 (if (Math-scalarp b) | 2863 (if (Math-scalarp b) |
2666 (if (and (math-floatp b) (Math-ratp a)) (math-float a) a) | 2864 (if (and (math-floatp b) (Math-ratp a)) (math-float a) a) |
2667 (calc-extensions) | 2865 (require 'calc-ext) |
2668 (math-mul-zero a b))) | 2866 (math-mul-zero a b))) |
2669 (and (Math-zerop b) (not (eq (car-safe a) 'mod)) | 2867 (and (Math-zerop b) (not (eq (car-safe a) 'mod)) |
2670 (if (Math-scalarp a) | 2868 (if (Math-scalarp a) |
2671 (if (and (math-floatp a) (Math-ratp b)) (math-float b) b) | 2869 (if (and (math-floatp a) (Math-ratp b)) (math-float b) b) |
2672 (calc-extensions) | 2870 (require 'calc-ext) |
2673 (math-mul-zero b a))) | 2871 (math-mul-zero b a))) |
2674 (and (Math-objvecp a) (Math-objvecp b) | 2872 (and (Math-objvecp a) (Math-objvecp b) |
2675 (or | 2873 (or |
2676 (and (Math-integerp a) (Math-integerp b) | 2874 (and (Math-integerp a) (Math-integerp b) |
2677 (progn | 2875 (progn |
2683 (if (cdr (cdr b)) | 2881 (if (cdr (cdr b)) |
2684 (math-mul-bignum (cdr a) (cdr b)) | 2882 (math-mul-bignum (cdr a) (cdr b)) |
2685 (math-mul-bignum-digit (cdr a) (nth 1 b) 0)) | 2883 (math-mul-bignum-digit (cdr a) (nth 1 b) 0)) |
2686 (math-mul-bignum-digit (cdr b) (nth 1 a) 0)))))) | 2884 (math-mul-bignum-digit (cdr b) (nth 1 a) 0)))))) |
2687 (and (Math-ratp a) (Math-ratp b) | 2885 (and (Math-ratp a) (Math-ratp b) |
2688 (calc-extensions) | 2886 (require 'calc-ext) |
2689 (calc-mul-fractions a b)) | 2887 (calc-mul-fractions a b)) |
2690 (and (Math-realp a) (Math-realp b) | 2888 (and (Math-realp a) (Math-realp b) |
2691 (progn | 2889 (progn |
2692 (or (and (consp a) (eq (car a) 'float)) | 2890 (or (and (consp a) (eq (car a) 'float)) |
2693 (setq a (math-float a))) | 2891 (setq a (math-float a))) |
2694 (or (and (consp b) (eq (car b) 'float)) | 2892 (or (and (consp b) (eq (car b) 'float)) |
2695 (setq b (math-float b))) | 2893 (setq b (math-float b))) |
2696 (math-make-float (math-mul (nth 1 a) (nth 1 b)) | 2894 (math-make-float (math-mul (nth 1 a) (nth 1 b)) |
2697 (+ (nth 2 a) (nth 2 b))))) | 2895 (+ (nth 2 a) (nth 2 b))))) |
2698 (and (calc-extensions) | 2896 (and (require 'calc-ext) |
2699 (math-mul-objects-fancy a b)))) | 2897 (math-mul-objects-fancy a b)))) |
2700 (and (calc-extensions) | 2898 (and (require 'calc-ext) |
2701 (math-mul-symb-fancy a b)))) | 2899 (math-mul-symb-fancy a b)))) |
2702 | 2900 |
2703 (defun math-infinitep (a &optional undir) | 2901 (defun math-infinitep (a &optional undir) |
2704 (while (and (consp a) (memq (car a) '(* / neg))) | 2902 (while (and (consp a) (memq (car a) '(* / neg))) |
2705 (if (or (not (eq (car a) '*)) (math-infinitep (nth 1 a))) | 2903 (if (or (not (eq (car a) '*)) (math-infinitep (nth 1 a))) |
2851 | 3049 |
2852 ;;; Compute the quotient of A and B. [O O N] [Public] | 3050 ;;; Compute the quotient of A and B. [O O N] [Public] |
2853 (defun math-div (a b) | 3051 (defun math-div (a b) |
2854 (or | 3052 (or |
2855 (and (Math-zerop b) | 3053 (and (Math-zerop b) |
2856 (calc-extensions) | 3054 (require 'calc-ext) |
2857 (math-div-by-zero a b)) | 3055 (math-div-by-zero a b)) |
2858 (and (Math-zerop a) (not (eq (car-safe b) 'mod)) | 3056 (and (Math-zerop a) (not (eq (car-safe b) 'mod)) |
2859 (if (Math-scalarp b) | 3057 (if (Math-scalarp b) |
2860 (if (and (math-floatp b) (Math-ratp a)) (math-float a) a) | 3058 (if (and (math-floatp b) (Math-ratp a)) (math-float a) a) |
2861 (calc-extensions) | 3059 (require 'calc-ext) |
2862 (math-div-zero a b))) | 3060 (math-div-zero a b))) |
2863 (and (Math-objvecp a) (Math-objvecp b) | 3061 (and (Math-objvecp a) (Math-objvecp b) |
2864 (or | 3062 (or |
2865 (and (Math-integerp a) (Math-integerp b) | 3063 (and (Math-integerp a) (Math-integerp b) |
2866 (let ((q (math-idivmod a b))) | 3064 (let ((q (math-idivmod a b))) |
2867 (if (eq (cdr q) 0) | 3065 (if (eq (cdr q) 0) |
2868 (car q) | 3066 (car q) |
2869 (if calc-prefer-frac | 3067 (if calc-prefer-frac |
2870 (progn | 3068 (progn |
2871 (calc-extensions) | 3069 (require 'calc-ext) |
2872 (math-make-frac a b)) | 3070 (math-make-frac a b)) |
2873 (math-div-float (math-make-float a 0) | 3071 (math-div-float (math-make-float a 0) |
2874 (math-make-float b 0)))))) | 3072 (math-make-float b 0)))))) |
2875 (and (Math-ratp a) (Math-ratp b) | 3073 (and (Math-ratp a) (Math-ratp b) |
2876 (calc-extensions) | 3074 (require 'calc-ext) |
2877 (calc-div-fractions a b)) | 3075 (calc-div-fractions a b)) |
2878 (and (Math-realp a) (Math-realp b) | 3076 (and (Math-realp a) (Math-realp b) |
2879 (progn | 3077 (progn |
2880 (or (and (consp a) (eq (car a) 'float)) | 3078 (or (and (consp a) (eq (car a) 'float)) |
2881 (setq a (math-float a))) | 3079 (setq a (math-float a))) |
2882 (or (and (consp b) (eq (car b) 'float)) | 3080 (or (and (consp b) (eq (car b) 'float)) |
2883 (setq b (math-float b))) | 3081 (setq b (math-float b))) |
2884 (math-div-float a b))) | 3082 (math-div-float a b))) |
2885 (and (calc-extensions) | 3083 (and (require 'calc-ext) |
2886 (math-div-objects-fancy a b)))) | 3084 (math-div-objects-fancy a b)))) |
2887 (and (calc-extensions) | 3085 (and (require 'calc-ext) |
2888 (math-div-symb-fancy a b)))) | 3086 (math-div-symb-fancy a b)))) |
2889 | 3087 |
2890 (defun math-div-float (a b) ; [F F F] | 3088 (defun math-div-float (a b) ; [F F F] |
2891 (let ((ldiff (max (- (1+ calc-internal-prec) | 3089 (let ((ldiff (max (- (1+ calc-internal-prec) |
2892 (- (math-numdigs (nth 1 a)) (math-numdigs (nth 1 b)))) | 3090 (- (math-numdigs (nth 1 a)) (math-numdigs (nth 1 b)))) |
2911 calc-prepared-composition) | 3109 calc-prepared-composition) |
2912 ((and (Math-scalarp a) | 3110 ((and (Math-scalarp a) |
2913 (memq calc-language '(nil flat unform)) | 3111 (memq calc-language '(nil flat unform)) |
2914 (null math-comp-selected)) | 3112 (null math-comp-selected)) |
2915 (math-format-number a)) | 3113 (math-format-number a)) |
2916 (t (calc-extensions) | 3114 (t (require 'calc-ext) |
2917 (math-compose-expr a 0)))) | 3115 (math-compose-expr a 0)))) |
2918 (off (math-stack-value-offset c)) | 3116 (off (math-stack-value-offset c)) |
2919 s w) | 3117 s w) |
2920 (and math-comp-selected (setq calc-any-selections t)) | 3118 (and math-comp-selected (setq calc-any-selections t)) |
2921 (setq w (cdr off) | 3119 (setq w (cdr off) |
2922 off (car off)) | 3120 off (car off)) |
2923 (when (> off 0) | 3121 (when (> off 0) |
2924 (setq c (math-comp-concat (make-string off ? ) c))) | 3122 (setq c (math-comp-concat (make-string off ?\s) c))) |
2925 (or (equal calc-left-label "") | 3123 (or (equal calc-left-label "") |
2926 (setq c (math-comp-concat (if (eq a 'top-of-stack) | 3124 (setq c (math-comp-concat (if (eq a 'top-of-stack) |
2927 (make-string (length calc-left-label) ? ) | 3125 (make-string (length calc-left-label) ?\s) |
2928 calc-left-label) | 3126 calc-left-label) |
2929 c))) | 3127 c))) |
2930 (when calc-line-numbering | 3128 (when calc-line-numbering |
2931 (setq c (math-comp-concat (if (eq calc-language 'big) | 3129 (setq c (math-comp-concat (if (eq calc-language 'big) |
2932 (if math-comp-selected | 3130 (if math-comp-selected |
2934 "1: ") | 3132 "1: ") |
2935 " ") | 3133 " ") |
2936 c))) | 3134 c))) |
2937 (unless (or (equal calc-right-label "") | 3135 (unless (or (equal calc-right-label "") |
2938 (eq a 'top-of-stack)) | 3136 (eq a 'top-of-stack)) |
2939 (calc-extensions) | 3137 (require 'calc-ext) |
2940 (setq c (list 'horiz c | 3138 (setq c (list 'horiz c |
2941 (make-string (max (- w (math-comp-width c) | 3139 (make-string (max (- w (math-comp-width c) |
2942 (length calc-right-label)) 0) ? ) | 3140 (length calc-right-label)) 0) ?\s) |
2943 '(break -1) | 3141 '(break -1) |
2944 calc-right-label))) | 3142 calc-right-label))) |
2945 (setq s (if (stringp c) | 3143 (setq s (if (stringp c) |
2946 (if calc-display-raw | 3144 (if calc-display-raw |
2947 (prin1-to-string c) | 3145 (prin1-to-string c) |
2950 (when calc-language-output-filter | 3148 (when calc-language-output-filter |
2951 (setq s (funcall calc-language-output-filter s))) | 3149 (setq s (funcall calc-language-output-filter s))) |
2952 (if (eq calc-language 'big) | 3150 (if (eq calc-language 'big) |
2953 (setq s (concat s "\n")) | 3151 (setq s (concat s "\n")) |
2954 (when calc-line-numbering | 3152 (when calc-line-numbering |
2955 (aset s 0 ?1) | 3153 (setq s (concat "1:" (substring s 2))))) |
2956 (aset s 1 ?:))) | |
2957 (setcar (cdr entry) (calc-count-lines s)) | 3154 (setcar (cdr entry) (calc-count-lines s)) |
2958 s)) | 3155 s)) |
2959 | 3156 |
2960 (defun math-stack-value-offset (c) | 3157 ;; The variables math-svo-c, math-svo-wid and math-svo-off are local |
3158 ;; to math-stack-value-offset, but are used by math-stack-value-offset-fancy | |
3159 ;; in calccomp.el. | |
3160 | |
3161 (defun math-stack-value-offset (math-svo-c) | |
2961 (let* ((num (if calc-line-numbering 4 0)) | 3162 (let* ((num (if calc-line-numbering 4 0)) |
2962 (wid (calc-window-width)) | 3163 (math-svo-wid (calc-window-width)) |
2963 off) | 3164 math-svo-off) |
2964 (if calc-display-just | 3165 (if calc-display-just |
2965 (progn | 3166 (progn |
2966 (calc-extensions) | 3167 (require 'calc-ext) |
2967 (math-stack-value-offset-fancy)) | 3168 (math-stack-value-offset-fancy)) |
2968 (setq off (or calc-display-origin 0)) | 3169 (setq math-svo-off (or calc-display-origin 0)) |
2969 (when (integerp calc-line-breaking) | 3170 (when (integerp calc-line-breaking) |
2970 (setq wid calc-line-breaking))) | 3171 (setq math-svo-wid calc-line-breaking))) |
2971 (cons (max (- off (length calc-left-label)) 0) | 3172 (cons (max (- math-svo-off (length calc-left-label)) 0) |
2972 (+ wid num)))) | 3173 (+ math-svo-wid num)))) |
2973 | 3174 |
2974 (defun calc-count-lines (s) | 3175 (defun calc-count-lines (s) |
2975 (let ((pos 0) | 3176 (let ((pos 0) |
2976 (num 1)) | 3177 (num 1)) |
2977 (while (setq pos (string-match "\n" s pos)) | 3178 (while (setq pos (string-match "\n" s pos)) |
2981 | 3182 |
2982 (defun math-format-value (a &optional w) | 3183 (defun math-format-value (a &optional w) |
2983 (if (and (Math-scalarp a) | 3184 (if (and (Math-scalarp a) |
2984 (memq calc-language '(nil flat unform))) | 3185 (memq calc-language '(nil flat unform))) |
2985 (math-format-number a) | 3186 (math-format-number a) |
2986 (calc-extensions) | 3187 (require 'calc-ext) |
2987 (let ((calc-line-breaking nil)) | 3188 (let ((calc-line-breaking nil)) |
2988 (math-composition-to-string (math-compose-expr a 0) w)))) | 3189 (math-composition-to-string (math-compose-expr a 0) w)))) |
2989 | 3190 |
2990 (defun calc-window-width () | 3191 (defun calc-window-width () |
2991 (if calc-embedded-info | 3192 (if calc-embedded-info |
3017 (calc-complex-format nil) | 3218 (calc-complex-format nil) |
3018 (calc-hms-format "%s@ %s' %s\"") | 3219 (calc-hms-format "%s@ %s' %s\"") |
3019 (calc-language nil)) | 3220 (calc-language nil)) |
3020 (math-format-number a))) | 3221 (math-format-number a))) |
3021 (t | 3222 (t |
3022 (calc-extensions) | 3223 (require 'calc-ext) |
3023 (math-format-flat-expr-fancy a prec)))) | 3224 (math-format-flat-expr-fancy a prec)))) |
3024 | 3225 |
3025 | 3226 |
3026 | 3227 |
3027 ;;; Format a number as a string. | 3228 ;;; Format a number as a string. |
3028 (defun math-format-number (a &optional prec) ; [X N] [Public] | 3229 (defun math-format-number (a &optional prec) ; [X N] [Public] |
3029 (cond | 3230 (cond |
3030 ((eq calc-display-raw t) (format "%s" a)) | 3231 ((eq calc-display-raw t) (format "%s" a)) |
3031 ((and (nth 1 calc-frac-format) (Math-integerp a)) | 3232 ((and (nth 1 calc-frac-format) (Math-integerp a)) |
3032 (calc-extensions) | 3233 (require 'calc-ext) |
3033 (math-format-number (math-adjust-fraction a))) | 3234 (math-format-number (math-adjust-fraction a))) |
3034 ((integerp a) | 3235 ((integerp a) |
3035 (if (not (or calc-group-digits calc-leading-zeros)) | 3236 (if (not (or calc-group-digits calc-leading-zeros)) |
3036 (if (= calc-number-radix 10) | 3237 (if (= calc-number-radix 10) |
3037 (int-to-string a) | 3238 (int-to-string a) |
3038 (if (< a 0) | 3239 (if (< a 0) |
3039 (concat "-" (math-format-number (- a))) | 3240 (concat "-" (math-format-number (- a))) |
3040 (calc-extensions) | 3241 (require 'calc-ext) |
3041 (if math-radix-explicit-format | 3242 (if math-radix-explicit-format |
3042 (if calc-radix-formatter | 3243 (if calc-radix-formatter |
3043 (funcall calc-radix-formatter | 3244 (funcall calc-radix-formatter |
3044 calc-number-radix | 3245 calc-number-radix |
3045 (if (= calc-number-radix 2) | 3246 (if (= calc-number-radix 2) |
3130 "(%s*10.^%d)" "%s*10.^%d") | 3331 "(%s*10.^%d)" "%s*10.^%d") |
3131 "%se%d") | 3332 "%se%d") |
3132 str (- eadj scale))))))) | 3333 str (- eadj scale))))))) |
3133 str))) | 3334 str))) |
3134 (t | 3335 (t |
3135 (calc-extensions) | 3336 (require 'calc-ext) |
3136 (math-format-number-fancy a prec)))) | 3337 (math-format-number-fancy a prec)))) |
3137 | 3338 |
3138 (defun math-format-bignum (a) ; [X L] | 3339 (defun math-format-bignum (a) ; [X L] |
3139 (if (and (= calc-number-radix 10) | 3340 (if (and (= calc-number-radix 10) |
3140 (not calc-leading-zeros) | 3341 (not calc-leading-zeros) |
3141 (not calc-group-digits)) | 3342 (not calc-group-digits)) |
3142 (math-format-bignum-decimal a) | 3343 (math-format-bignum-decimal a) |
3143 (calc-extensions) | 3344 (require 'calc-ext) |
3144 (math-format-bignum-fancy a))) | 3345 (math-format-bignum-fancy a))) |
3145 | 3346 |
3146 (defun math-format-bignum-decimal (a) ; [X L] | 3347 (defun math-format-bignum-decimal (a) ; [X L] |
3147 (if a | 3348 (if a |
3148 (let ((s "")) | 3349 (let ((s "")) |
3165 (if (and (eq calc-language 'c) | 3366 (if (and (eq calc-language 'c) |
3166 (> (length digs) 1) | 3367 (> (length digs) 1) |
3167 (eq (aref digs 0) ?0)) | 3368 (eq (aref digs 0) ?0)) |
3168 (math-read-number (concat "8#" digs)) | 3369 (math-read-number (concat "8#" digs)) |
3169 (if (<= (length digs) 6) | 3370 (if (<= (length digs) 6) |
3170 (string-to-int digs) | 3371 (string-to-number digs) |
3171 (cons 'bigpos (math-read-bignum digs)))))) | 3372 (cons 'bigpos (math-read-bignum digs)))))) |
3172 | 3373 |
3173 ;; Clean up the string if necessary | 3374 ;; Clean up the string if necessary |
3174 ((string-match "\\`\\(.*\\)[ \t\n]+\\([^\001]*\\)\\'" s) | 3375 ((string-match "\\`\\(.*\\)[ \t\n]+\\([^\001]*\\)\\'" s) |
3175 (math-read-number (concat (math-match-substring s 1) | 3376 (math-read-number (concat (math-match-substring s 1) |
3180 (let ((val (math-read-number (math-match-substring s 1)))) | 3381 (let ((val (math-read-number (math-match-substring s 1)))) |
3181 (and val (if (eq (aref s 0) ?+) val (math-neg val))))) | 3382 (and val (if (eq (aref s 0) ?+) val (math-neg val))))) |
3182 | 3383 |
3183 ;; Forms that require extensions module | 3384 ;; Forms that require extensions module |
3184 ((string-match "[^-+0-9eE.]" s) | 3385 ((string-match "[^-+0-9eE.]" s) |
3185 (calc-extensions) | 3386 (require 'calc-ext) |
3186 (math-read-number-fancy s)) | 3387 (math-read-number-fancy s)) |
3187 | 3388 |
3188 ;; Decimal point | 3389 ;; Decimal point |
3189 ((string-match "^\\([0-9]*\\)\\.\\([0-9]*\\)$" s) | 3390 ((string-match "^\\([0-9]*\\)\\.\\([0-9]*\\)$" s) |
3190 (let ((int (math-match-substring s 1)) | 3391 (let ((int (math-match-substring s 1)) |
3202 ((string-match "^\\(.*\\)[eE]\\([-+]?[0-9]+\\)$" s) | 3403 ((string-match "^\\(.*\\)[eE]\\([-+]?[0-9]+\\)$" s) |
3203 (let ((mant (math-match-substring s 1)) | 3404 (let ((mant (math-match-substring s 1)) |
3204 (exp (math-match-substring s 2))) | 3405 (exp (math-match-substring s 2))) |
3205 (let ((mant (if (> (length mant) 0) (math-read-number mant) 1)) | 3406 (let ((mant (if (> (length mant) 0) (math-read-number mant) 1)) |
3206 (exp (if (<= (length exp) (if (memq (aref exp 0) '(?+ ?-)) 8 7)) | 3407 (exp (if (<= (length exp) (if (memq (aref exp 0) '(?+ ?-)) 8 7)) |
3207 (string-to-int exp)))) | 3408 (string-to-number exp)))) |
3208 (and mant exp (Math-realp mant) (> exp -4000000) (< exp 4000000) | 3409 (and mant exp (Math-realp mant) (> exp -4000000) (< exp 4000000) |
3209 (let ((mant (math-float mant))) | 3410 (let ((mant (math-float mant))) |
3210 (list 'float (nth 1 mant) (+ (nth 2 mant) exp))))))) | 3411 (list 'float (nth 1 mant) (+ (nth 2 mant) exp))))))) |
3211 | 3412 |
3212 ;; Syntax error! | 3413 ;; Syntax error! |
3217 (substring s (match-beginning n) (match-end n)) | 3418 (substring s (match-beginning n) (match-end n)) |
3218 "")) | 3419 "")) |
3219 | 3420 |
3220 (defun math-read-bignum (s) ; [l X] | 3421 (defun math-read-bignum (s) ; [l X] |
3221 (if (> (length s) 3) | 3422 (if (> (length s) 3) |
3222 (cons (string-to-int (substring s -3)) | 3423 (cons (string-to-number (substring s -3)) |
3223 (math-read-bignum (substring s 0 -3))) | 3424 (math-read-bignum (substring s 0 -3))) |
3224 (list (string-to-int s)))) | 3425 (list (string-to-number s)))) |
3225 | 3426 |
3226 | 3427 |
3227 (defconst math-tex-ignore-words | 3428 (defconst math-tex-ignore-words |
3228 '( ("\\hbox") ("\\mbox") ("\\text") ("\\left") ("\\right") | 3429 '( ("\\hbox") ("\\mbox") ("\\text") ("\\left") ("\\right") |
3229 ("\\,") ("\\>") ("\\:") ("\\;") ("\\!") ("\\ ") | 3430 ("\\,") ("\\>") ("\\:") ("\\;") ("\\!") ("\\ ") |
3233 ("\\rm") ("\\bf") ("\\it") ("\\sl") | 3434 ("\\rm") ("\\bf") ("\\it") ("\\sl") |
3234 ("\\roman") ("\\bold") ("\\italic") ("\\slanted") | 3435 ("\\roman") ("\\bold") ("\\italic") ("\\slanted") |
3235 ("\\cal") ("\\mit") ("\\Cal") ("\\Bbb") ("\\frak") ("\\goth") | 3436 ("\\cal") ("\\mit") ("\\Cal") ("\\Bbb") ("\\frak") ("\\goth") |
3236 ("\\evalto") | 3437 ("\\evalto") |
3237 ("\\matrix" mat) ("\\bmatrix" mat) ("\\pmatrix" mat) | 3438 ("\\matrix" mat) ("\\bmatrix" mat) ("\\pmatrix" mat) |
3439 ("\\begin" begenv) | |
3238 ("\\cr" punc ";") ("\\\\" punc ";") ("\\*" punc "*") | 3440 ("\\cr" punc ";") ("\\\\" punc ";") ("\\*" punc "*") |
3239 ("\\{" punc "[") ("\\}" punc "]") | 3441 ("\\{" punc "[") ("\\}" punc "]"))) |
3240 )) | 3442 |
3443 (defconst math-latex-ignore-words | |
3444 (append math-tex-ignore-words | |
3445 '(("\\begin" begenv)))) | |
3241 | 3446 |
3242 (defconst math-eqn-ignore-words | 3447 (defconst math-eqn-ignore-words |
3243 '( ("roman") ("bold") ("italic") ("mark") ("lineup") ("evalto") | 3448 '( ("roman") ("bold") ("italic") ("mark") ("lineup") ("evalto") |
3244 ("left" ("floor") ("ceil")) | 3449 ("left" ("floor") ("ceil")) |
3245 ("right" ("floor") ("ceil")) | 3450 ("right" ("floor") ("ceil")) |
3246 ("arc" ("sin") ("cos") ("tan") ("sinh") ("cosh") ("tanh")) | 3451 ("arc" ("sin") ("cos") ("tan") ("sinh") ("cosh") ("tanh")) |
3247 ("size" n) ("font" n) ("fwd" n) ("back" n) ("up" n) ("down" n) | 3452 ("size" n) ("font" n) ("fwd" n) ("back" n) ("up" n) ("down" n) |
3248 ("above" punc ",") | 3453 ("above" punc ","))) |
3249 )) | |
3250 | 3454 |
3251 (defconst math-standard-opers | 3455 (defconst math-standard-opers |
3252 '( ( "_" calcFunc-subscr 1200 1201 ) | 3456 '( ( "_" calcFunc-subscr 1200 1201 ) |
3253 ( "%" calcFunc-percent 1100 -1 ) | 3457 ( "%" calcFunc-percent 1100 -1 ) |
3254 ( "u+" ident -1 1000 ) | 3458 ( "u+" ident -1 1000 ) |
3289 | 3493 |
3290 ;;;###autoload | 3494 ;;;###autoload |
3291 (defun calc-grab-region (top bot arg) | 3495 (defun calc-grab-region (top bot arg) |
3292 "Parse the region as a vector of numbers and push it on the Calculator stack." | 3496 "Parse the region as a vector of numbers and push it on the Calculator stack." |
3293 (interactive "r\nP") | 3497 (interactive "r\nP") |
3294 (calc-extensions) | 3498 (require 'calc-ext) |
3295 (calc-do-grab-region top bot arg)) | 3499 (calc-do-grab-region top bot arg)) |
3296 | 3500 |
3297 ;;;###autoload | 3501 ;;;###autoload |
3298 (defun calc-grab-rectangle (top bot arg) | 3502 (defun calc-grab-rectangle (top bot arg) |
3299 "Parse a rectangle as a matrix of numbers and push it on the Calculator stack." | 3503 "Parse a rectangle as a matrix of numbers and push it on the Calculator stack." |
3300 (interactive "r\nP") | 3504 (interactive "r\nP") |
3301 (calc-extensions) | 3505 (require 'calc-ext) |
3302 (calc-do-grab-rectangle top bot arg)) | 3506 (calc-do-grab-rectangle top bot arg)) |
3303 | 3507 |
3304 (defun calc-grab-sum-down (top bot arg) | 3508 (defun calc-grab-sum-down (top bot arg) |
3305 "Parse a rectangle as a matrix of numbers and sum its columns." | 3509 "Parse a rectangle as a matrix of numbers and sum its columns." |
3306 (interactive "r\nP") | 3510 (interactive "r\nP") |
3307 (calc-extensions) | 3511 (require 'calc-ext) |
3308 (calc-do-grab-rectangle top bot arg 'calcFunc-reduced)) | 3512 (calc-do-grab-rectangle top bot arg 'calcFunc-reduced)) |
3309 | 3513 |
3310 (defun calc-grab-sum-across (top bot arg) | 3514 (defun calc-grab-sum-across (top bot arg) |
3311 "Parse a rectangle as a matrix of numbers and sum its rows." | 3515 "Parse a rectangle as a matrix of numbers and sum its rows." |
3312 (interactive "r\nP") | 3516 (interactive "r\nP") |
3313 (calc-extensions) | 3517 (require 'calc-ext) |
3314 (calc-do-grab-rectangle top bot arg 'calcFunc-reducea)) | 3518 (calc-do-grab-rectangle top bot arg 'calcFunc-reducea)) |
3315 | 3519 |
3316 | 3520 |
3317 ;;;###autoload | 3521 ;;;###autoload |
3318 (defun calc-embedded (arg &optional end obeg oend) | 3522 (defun calc-embedded (arg &optional end obeg oend) |
3319 "Start Calc Embedded mode on the formula surrounding point." | 3523 "Start Calc Embedded mode on the formula surrounding point." |
3320 (interactive "P") | 3524 (interactive "P") |
3321 (calc-extensions) | 3525 (require 'calc-ext) |
3322 (calc-do-embedded arg end obeg oend)) | 3526 (calc-do-embedded arg end obeg oend)) |
3323 | 3527 |
3324 ;;;###autoload | 3528 ;;;###autoload |
3325 (defun calc-embedded-activate (&optional arg cbuf) | 3529 (defun calc-embedded-activate (&optional arg cbuf) |
3326 "Scan the current editing buffer for all embedded := and => formulas. | 3530 "Scan the current editing buffer for all embedded := and => formulas. |
3328 (interactive "P") | 3532 (interactive "P") |
3329 (calc-do-embedded-activate arg cbuf)) | 3533 (calc-do-embedded-activate arg cbuf)) |
3330 | 3534 |
3331 (defun calc-user-invocation () | 3535 (defun calc-user-invocation () |
3332 (interactive) | 3536 (interactive) |
3333 (unless (stringp calc-invocation-macro) | 3537 (unless calc-invocation-macro |
3334 (error "Use `Z I' inside Calc to define a `M-# Z' keyboard macro")) | 3538 (error "Use `Z I' inside Calc to define a `C-x * Z' keyboard macro")) |
3335 (execute-kbd-macro calc-invocation-macro nil)) | 3539 (execute-kbd-macro calc-invocation-macro nil)) |
3336 | 3540 |
3337 ;;; User-programmability. | 3541 ;;; User-programmability. |
3338 | 3542 |
3339 ;;;###autoload | 3543 ;;;###autoload |
3340 (defmacro defmath (func args &rest body) ; [Public] | 3544 (defmacro defmath (func args &rest body) ; [Public] |
3341 (calc-extensions) | 3545 (require 'calc-ext) |
3342 (math-do-defmath func args body)) | 3546 (math-do-defmath func args body)) |
3343 | 3547 |
3344 ;;; Functions needed for Lucid Emacs support. | 3548 ;;; Functions needed for Lucid Emacs support. |
3345 | 3549 |
3346 (defun calc-read-key (&optional optkey) | 3550 (defun calc-read-key (&optional optkey) |
3347 (cond (calc-emacs-type-lucid | 3551 (cond (calc-emacs-type-lucid |
3348 (let ((event (next-command-event))) | 3552 (let ((event (next-command-event))) |
3349 (let ((key (event-to-character event t t))) | 3553 (let ((key (event-to-character event t t))) |
3350 (or key optkey (error "Expected a plain keystroke")) | 3554 (or key optkey (error "Expected a plain keystroke")) |
3351 (cons key event)))) | 3555 (cons key event)))) |
3352 (calc-emacs-type-gnu19 | 3556 (t |
3353 (let ((key (read-event))) | 3557 (let ((key (read-event))) |
3354 (cons key key))) | |
3355 (t | |
3356 (let ((key (read-char))) | |
3357 (cons key key))))) | 3558 (cons key key))))) |
3358 | 3559 |
3359 (defun calc-unread-command (&optional input) | 3560 (defun calc-unread-command (&optional input) |
3360 (if (featurep 'xemacs) | 3561 (if (featurep 'xemacs) |
3361 (setq unread-command-event | 3562 (setq unread-command-event |
3367 (if (featurep 'xemacs) | 3568 (if (featurep 'xemacs) |
3368 (calc-emacs-type-lucid (setq unread-command-event nil)) | 3569 (calc-emacs-type-lucid (setq unread-command-event nil)) |
3369 (setq unread-command-events nil))) | 3570 (setq unread-command-events nil))) |
3370 | 3571 |
3371 (when calc-always-load-extensions | 3572 (when calc-always-load-extensions |
3372 (calc-extensions) | 3573 (require 'calc-ext) |
3373 (calc-load-everything)) | 3574 (calc-load-everything)) |
3374 | 3575 |
3375 | 3576 |
3376 (run-hooks 'calc-load-hook) | 3577 (run-hooks 'calc-load-hook) |
3377 | 3578 |
3579 (provide 'calc) | |
3580 | |
3581 ;;; arch-tag: 0c3b170c-4ce6-4eaf-8d9b-5834d1fe938f | |
3378 ;;; calc.el ends here | 3582 ;;; calc.el ends here |