mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-12-22 10:26:20 +00:00
Code Issues Releases Activity

Change all toplevel setq' forms to defvar' forms, and move them

Browse Source 
before their first use.  Use `when', `unless'.  Remove trailing
periods from error forms.  Add description and headers suggested by
Emacs Lisp coding conventions.
This commit is contained in:
Colin Walters 2001-11-19 07:44:56 +00:00
parent f269b73e3e
commit 3132f345bc
35 changed files with 1004 additions and 842 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

51
lisp/ChangeLog
View File

@ -1,3 +1,54 @@
2001-11-19 Colin Walters <walters@verbum.org>
* calc/calc-macs.el (calc-wrapper, calc-slow-wrapper)
(math-showing-full-precision, math-with-extra-prec, math-working)
(calc-with-default-simplification)
(calc-with-trail-buffer): Use backtick.
(Math-zerop, Math-integer-negp, Math-integer-posp, Math-negp)
(Math-looks-negp, Math-posp, Math-integerp, Math-natnump)
(Math-ratp, Math-realp, Math-anglep, Math-numberp, Math-scalarp)
(Math-vectorp, Math-messy-integerp, Math-objectp, Math-objvecp)
(Math-integer-neg, Math-equal, Math-lessp, Math-primp)
(Math-num-integerp, Math-bignum-test, Math-equal-int)
(Math-natnum-lessp, math-format-radix-digit): Change to `defsubst'.
(calc-record-compilation-date-macro): Deleted. Callers updated.
(math-format-radix-digit): Move to calc-bin.el.
* calc/calc.el (calc-record-compilation-date): Remove.
(calc-bug-address): Update.
(calc-settings-file): Use `user-init-file'.
* calc/calc-mode.el (calc-settings-file-name, calc-save-modes):
Handle null `calc-settings-file'.
* calc/calc-frac.el (calc-over-notation): Use `completing-read'.
* calc/calc-keypd.el (calc-keypad-mode): New.
(calc-do-keypad): Use it.
(calc-keypad-map): Move into `calc-keypad-mode'.
* calc-math.el (calcFunc-sqrt, calcFunc-hypot): Add missing quote
to defalias argument.
* calc-misc.el (math-fixnump, math-fixnatnump, calcFunc-trunc)
(calcFunc-floor): Ditto.
* calc-units.el (calcFunc-usimplify): Ditto.
* calc-aent.el, calc-ext.el, calc-incom.el, calc-misc.el
* calc-sel.el, calc-vec.el, calc-alg.el, calc-fin.el
* calc-keypd.el, calc-mode.el, calc-stat.el, calc-yank.el
* calc-arith.el, calc-forms.el, calc-lang.el, calc-mtx.el
* calc-store.el, calc.el, calc-bin.el, calc-frac.el, calc-macs.el
* calc-poly.el, calc-stuff.el, calcalg2.el, calc-comb.el
* calc-funcs.el, calc-maint.el, calc-prog.el, calc-trail.el
* calcalg3.el, calc-cplx.el, calc-graph.el, calc-map.el
* calc-rewr.el, calc-undo.el, calccomp.el, calc-embed.el
* calc-help.el, calc-math.el, calc-rules.el, calc-units.el
* calcsel2.el: Change all toplevel `setq' forms to `defvar' forms,
and move them before their first use. Use `when', `unless'.
Remove trailing periods from error forms. Add description and
headers suggested by Emacs Lisp coding conventions.
2001-11-19 Stefan Monnier <monnier@cs.yale.edu>
* newcomment.el (comment-indent):

55
lisp/calc/calc-aent.el
View File

@ -1,6 +1,9 @@
;; Calculator for GNU Emacs, part I [calc-aent.el]
;;; calc-aent.el --- algebraic entry functions for Calc
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Written by Dave Gillespie, daveg@synaptics.com.
;; Author: Dave Gillespie <daveg@synaptics.com>
;; Maintainer: Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.
@ -19,7 +22,9 @@
;; file named COPYING. Among other things, the copyright notice
;; and this notice must be preserved on all copies.
;;; Commentary:
;;; Code:
;; This file is autoloaded from calc.el.
(require 'calc)
@ -55,15 +60,14 @@
(calc-extensions)
(math-evaluate-expr x))))
entry)))
(if (and (= (length alg-exp) 1)
(eq (car-safe (car alg-exp)) 'calcFunc-assign)
(= (length (car alg-exp)) 3)
(eq (car-safe (nth 1 (car alg-exp))) 'var))
(progn
(calc-extensions)
(set (nth 2 (nth 1 (car alg-exp))) (nth 2 (car alg-exp)))
(calc-refresh-evaltos (nth 2 (nth 1 (car alg-exp))))
(setq alg-exp (list (nth 2 (car alg-exp))))))
(when (and (= (length alg-exp) 1)
(eq (car-safe (car alg-exp)) 'calcFunc-assign)
(= (length (car alg-exp)) 3)
(eq (car-safe (nth 1 (car alg-exp))) 'var))
(calc-extensions)
(set (nth 2 (nth 1 (car alg-exp))) (nth 2 (car alg-exp)))
(calc-refresh-evaltos (nth 2 (nth 1 (car alg-exp))))
(setq alg-exp (list (nth 2 (car alg-exp)))))
(setq calc-quick-prev-results alg-exp
buf (mapconcat (function (lambda (x)
(math-format-value x 1000)))
@ -97,8 +101,8 @@
(if (eq last-command-char 10)
(insert shortbuf)
(setq kill-ring (cons shortbuf kill-ring))
(if (> (length kill-ring) kill-ring-max)
(setcdr (nthcdr (1- kill-ring-max) kill-ring) nil))
(when (> (length kill-ring) kill-ring-max)
(setcdr (nthcdr (1- kill-ring-max) kill-ring) nil))
(setq kill-ring-yank-pointer kill-ring)))))
(defun calc-do-calc-eval (str separator args)
@ -294,8 +298,7 @@
(let* ((calc-buffer (current-buffer))
(blink-paren-function 'calcAlg-blink-matching-open)
(alg-exp 'error))
(if (boundp 'calc-alg-ent-map)
()
(unless (boundp 'calc-alg-ent-map)
(setq calc-alg-ent-map (copy-keymap minibuffer-local-map))
(define-key calc-alg-ent-map "'" 'calcAlg-previous)
(define-key calc-alg-ent-map "`" 'calcAlg-edit)
@ -307,8 +310,8 @@
(while (< i 127)
(aset calc-alg-ent-esc-map i 'calcAlg-escape)
(setq i (1+ i))))))
(or calc-emacs-type-19
(define-key calc-alg-ent-map "\e" nil))
(unless calc-emacs-type-19
(define-key calc-alg-ent-map "\e" nil))
(if (eq calc-algebraic-mode 'total)
(define-key calc-alg-ent-map "\e" calc-alg-ent-esc-map)
(define-key calc-alg-ent-map "\ep" 'calcAlg-plus-minus)
@ -320,9 +323,9 @@
(let ((buf (read-from-minibuffer (or prompt "Algebraic: ")
(or initial "")
calc-alg-ent-map nil)))
(if (eq alg-exp 'error)
(if (eq (car-safe (setq alg-exp (math-read-exprs buf))) 'error)
(setq alg-exp nil)))
(when (eq alg-exp 'error)
(when (eq (car-safe (setq alg-exp (math-read-exprs buf))) 'error)
(setq alg-exp nil)))
(setq calc-aborted-prefix "alg'")
(or no-normalize
(and alg-exp (setq alg-exp (mapcar 'calc-normalize alg-exp))))
@ -368,6 +371,7 @@
(use-local-map calc-mode-map))
(calcAlg-enter))
(defvar calc-plain-entry nil)
(defun calcAlg-edit ()
(interactive)
(if (or (not calc-plain-entry)
@ -377,7 +381,6 @@
(setq alg-exp (minibuffer-contents))
(and (> (length alg-exp) 0) (setq calc-previous-alg-entry alg-exp))
(exit-minibuffer)))
(setq calc-plain-entry nil)
(defun calcAlg-enter ()
(interactive)
@ -482,11 +485,11 @@
(setq last rest)))
val))
(setq calc-user-parse-table nil)
(setq calc-last-main-parse-table nil)
(setq calc-last-lang-parse-table nil)
(setq calc-user-tokens nil)
(setq calc-user-token-chars nil)
(defvar calc-user-parse-table nil)
(defvar calc-last-main-parse-table nil)
(defvar calc-last-lang-parse-table nil)
(defvar calc-user-tokens nil)
(defvar calc-user-token-chars nil)
(defun math-build-parse-table ()
(let ((mtab (cdr (assq nil calc-user-parse-tables)))

12
lisp/calc/calc-alg.el
View File

@ -1,6 +1,9 @@
;; Calculator for GNU Emacs, part II [calc-alg.el]
;;; calc-alg.el --- algebraic functions for Calc
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Written by Dave Gillespie, daveg@synaptics.com.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.
@ -19,7 +22,9 @@
;; file named COPYING. Among other things, the copyright notice
;; and this notice must be preserved on all copies.
;;; Commentary:
;;; Code:
;; This file is autoloaded from calc-ext.el.
(require 'calc-ext)
@ -28,7 +33,6 @@
(defun calc-Need-calc-alg () nil)
;;; Algebra commands.
(defun calc-alg-evaluate (arg)
@ -169,7 +173,7 @@
(if (eq (car-safe old) 'error)
(error "Bad format in expression: %s" (nth 1 old)))
(or (math-expr-contains expr old)
(error "No occurrences found.")))
(error "No occurrences found")))
(calc-enter-result num "sbst" (math-expr-subst expr old new)))))

22
lisp/calc/calc-arith.el
View File

@ -1,6 +1,9 @@
;; Calculator for GNU Emacs, part II [calc-arith.el]
;;; calc-arith.el --- arithmetic functions for Calc
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Written by Dave Gillespie, daveg@synaptics.com.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.
@ -19,7 +22,9 @@
;; file named COPYING. Among other things, the copyright notice
;; and this notice must be preserved on all copies.
;;; Commentary:
;;; Code:
;; This file is autoloaded from calc-ext.el.
(require 'calc-ext)
@ -148,9 +153,9 @@
;;;; Declarations.
(setq math-decls-cache-tag nil)
(setq math-decls-cache nil)
(setq math-decls-all nil)
(defvar math-decls-cache-tag nil)
(defvar math-decls-cache nil)
(defvar math-decls-all nil)
;;; Math-decls-cache is an a-list where each entry is a list of the form:
;;; (VAR TYPES RANGE)
@ -880,7 +885,7 @@
;;;; Arithmetic.
(defun calcFunc-neg (a)
(defsubst calcFunc-neg (a)
(math-normalize (list 'neg a)))
(defun math-neg-fancy (a)
@ -2351,7 +2356,7 @@
a
(math-float (math-ceiling a prec))))
(setq math-rounding-mode nil)
(defvar math-rounding-mode nil)
;;; Coerce A to be an integer (by rounding to nearest integer). [I N] [Public]
(defun math-round (a &optional prec)
@ -2620,6 +2625,8 @@
(math-normalize (list '+ a b))
(math-add a b)))
(defvar math-combine-prod-e '(var e var-e))
;;; The following is expanded out four ways for speed.
(defun math-combine-prod (a b inva invb scalar-okay)
(cond
@ -2734,7 +2741,6 @@
(condition-case err
(math-pow a apow)
(inexact-result (list '^ a apow)))))))))))
(setq math-combine-prod-e '(var e var-e))
(defun math-mul-or-div (a b ainv binv)
(if (or (Math-vectorp a) (Math-vectorp b))

27
lisp/calc/calc-bin.el
View File

@ -1,6 +1,9 @@
;; Calculator for GNU Emacs, part II [calc-bin.el]
;;; calc-bin.el --- binary functions for Calc
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Written by Dave Gillespie, daveg@synaptics.com.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.
@ -19,7 +22,9 @@
;; file named COPYING. Among other things, the copyright notice
;; and this notice must be preserved on all copies.
;;; Commentary:
;;; Code:
;; This file is autoloaded from calc-ext.el.
(require 'calc-ext)
@ -143,8 +148,8 @@
(list n (math-power-of-2 (math-abs n)))
calc-leading-zeros)))
(if (< n 0)
(message "Binary word size is %d bits (2's complement)." (- n))
(message "Binary word size is %d bits." n))))
(message "Binary word size is %d bits (2's complement)" (- n))
(message "Binary word size is %d bits" n))))
@ -161,7 +166,7 @@
;; also change global value so minibuffer sees it
(setq-default calc-number-radix calc-number-radix))
(setq n calc-number-radix))
(message "Number radix is %d." n)))
(message "Number radix is %d" n)))
(defun calc-decimal-radix ()
(interactive)
@ -183,12 +188,12 @@
(interactive "P")
(calc-wrapper
(if (calc-change-mode 'calc-leading-zeros n t t)
(message "Zero-padding integers to %d digits (assuming radix %d)."
(message "Zero-padding integers to %d digits (assuming radix %d)"
(let* ((calc-internal-prec 6))
(math-compute-max-digits (math-abs calc-word-size)
calc-number-radix))
calc-number-radix)
(message "Omitting leading zeros on integers."))))
(message "Omitting leading zeros on integers"))))
(defvar math-power-of-2-cache (list 1 2 4 8 16 32 64 128 256 512 1024))
@ -562,6 +567,9 @@
"K" "L" "M" "N" "O" "P" "Q" "R" "S" "T"
"U" "V" "W" "X" "Y" "Z"])
(defsubst math-format-radix-digit (a) ; [X D]
(aref math-radix-digits a))
(defun math-format-radix (a) ; [X S]
(if (< a calc-number-radix)
(if (< a 0)
@ -750,6 +758,8 @@
(format "%se%s" str estr)))))))
str))
(defvar math-radix-digits-cache nil)
(defun math-convert-radix-digits (n &optional to-dec)
(let ((key (cons n (cons to-dec calc-number-radix))))
(or (cdr (assoc key math-radix-digits-cache))
@ -762,7 +772,7 @@
(math-div n log))))
math-radix-digits-cache))))))))
(setq math-radix-digits-cache nil)
(defvar math-radix-float-cache-tag nil)
(defun math-radix-float-power (n)
(if (eq n 0)
@ -792,6 +802,5 @@
calc-number-radix))))))
math-radix-float-cache))))))))
(setq math-radix-float-cache-tag nil)
;;; calc-bin.el ends here

116
lisp/calc/calc-comb.el
View File

@ -1,6 +1,9 @@
;; Calculator for GNU Emacs, part II [calc-comb.el]
;;; calc-comb.el --- combinatoric functions for Calc
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Written by Dave Gillespie, daveg@synaptics.com.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.
@ -19,7 +22,9 @@
;; file named COPYING. Among other things, the copyright notice
;; and this notice must be preserved on all copies.
;;; Commentary:
;;; Code:
;; This file is autoloaded from calc-ext.el.
(require 'calc-ext)
@ -28,6 +33,53 @@
(defun calc-Need-calc-comb () nil)
(defconst math-primes-table
[2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89
97 101 103 107 109 113 127 131 137 139 149 151 157 163 167 173 179 181
191 193 197 199 211 223 227 229 233 239 241 251 257 263 269 271 277
281 283 293 307 311 313 317 331 337 347 349 353 359 367 373 379 383
389 397 401 409 419 421 431 433 439 443 449 457 461 463 467 479 487
491 499 503 509 521 523 541 547 557 563 569 571 577 587 593 599 601
607 613 617 619 631 641 643 647 653 659 661 673 677 683 691 701 709
719 727 733 739 743 751 757 761 769 773 787 797 809 811 821 823 827
829 839 853 857 859 863 877 881 883 887 907 911 919 929 937 941 947
953 967 971 977 983 991 997 1009 1013 1019 1021 1031 1033 1039 1049
1051 1061 1063 1069 1087 1091 1093 1097 1103 1109 1117 1123 1129 1151
1153 1163 1171 1181 1187 1193 1201 1213 1217 1223 1229 1231 1237 1249
1259 1277 1279 1283 1289 1291 1297 1301 1303 1307 1319 1321 1327 1361
1367 1373 1381 1399 1409 1423 1427 1429 1433 1439 1447 1451 1453 1459
1471 1481 1483 1487 1489 1493 1499 1511 1523 1531 1543 1549 1553 1559
1567 1571 1579 1583 1597 1601 1607 1609 1613 1619 1621 1627 1637 1657
1663 1667 1669 1693 1697 1699 1709 1721 1723 1733 1741 1747 1753 1759
1777 1783 1787 1789 1801 1811 1823 1831 1847 1861 1867 1871 1873 1877
1879 1889 1901 1907 1913 1931 1933 1949 1951 1973 1979 1987 1993 1997
1999 2003 2011 2017 2027 2029 2039 2053 2063 2069 2081 2083 2087 2089
2099 2111 2113 2129 2131 2137 2141 2143 2153 2161 2179 2203 2207 2213
2221 2237 2239 2243 2251 2267 2269 2273 2281 2287 2293 2297 2309 2311
2333 2339 2341 2347 2351 2357 2371 2377 2381 2383 2389 2393 2399 2411
2417 2423 2437 2441 2447 2459 2467 2473 2477 2503 2521 2531 2539 2543
2549 2551 2557 2579 2591 2593 2609 2617 2621 2633 2647 2657 2659 2663
2671 2677 2683 2687 2689 2693 2699 2707 2711 2713 2719 2729 2731 2741
2749 2753 2767 2777 2789 2791 2797 2801 2803 2819 2833 2837 2843 2851
2857 2861 2879 2887 2897 2903 2909 2917 2927 2939 2953 2957 2963 2969
2971 2999 3001 3011 3019 3023 3037 3041 3049 3061 3067 3079 3083 3089
3109 3119 3121 3137 3163 3167 3169 3181 3187 3191 3203 3209 3217 3221
3229 3251 3253 3257 3259 3271 3299 3301 3307 3313 3319 3323 3329 3331
3343 3347 3359 3361 3371 3373 3389 3391 3407 3413 3433 3449 3457 3461
3463 3467 3469 3491 3499 3511 3517 3527 3529 3533 3539 3541 3547 3557
3559 3571 3581 3583 3593 3607 3613 3617 3623 3631 3637 3643 3659 3671
3673 3677 3691 3697 3701 3709 3719 3727 3733 3739 3761 3767 3769 3779
3793 3797 3803 3821 3823 3833 3847 3851 3853 3863 3877 3881 3889 3907
3911 3917 3919 3923 3929 3931 3943 3947 3967 3989 4001 4003 4007 4013
4019 4021 4027 4049 4051 4057 4073 4079 4091 4093 4099 4111 4127 4129
4133 4139 4153 4157 4159 4177 4201 4211 4217 4219 4229 4231 4241 4243
4253 4259 4261 4271 4273 4283 4289 4297 4327 4337 4339 4349 4357 4363
4373 4391 4397 4409 4421 4423 4441 4447 4451 4457 4463 4481 4483 4493
4507 4513 4517 4519 4523 4547 4549 4561 4567 4583 4591 4597 4603 4621
4637 4639 4643 4649 4651 4657 4663 4673 4679 4691 4703 4721 4723 4729
4733 4751 4759 4783 4787 4789 4793 4799 4801 4813 4817 4831 4861 4871
4877 4889 4903 4909 4919 4931 4933 4937 4943 4951 4957 4967 4969 4973
4987 4993 4999 5003])
;;; Combinatorics
@ -430,6 +482,7 @@
(defun calcFunc-stir2 (n m)
(math-stirling-number n m 0))
(defvar math-stirling-cache (vector [[1]] [[1]]))
(defun math-stirling-number (n m k)
(or (math-num-natnump n) (math-reject-arg n 'natnump))
(or (math-num-natnump m) (math-reject-arg m 'natnump))
@ -452,7 +505,6 @@
(if (= k 1)
(math-stirling-1 n m)
(math-stirling-2 n m)))))
(setq math-stirling-cache (vector [[1]] [[1]]))
(defun math-stirling-1 (n m)
(or (aref (aref cache n) m)
@ -466,6 +518,11 @@
(math-add (math-stirling-2 (1- n) (1- m))
(math-mul m (math-stirling-2 (1- n) m))))))
(defvar math-random-table nil)
(defvar math-last-RandSeed nil)
(defvar math-random-ptr1 nil)
(defvar math-random-ptr2 nil)
(defvar math-random-shift nil)
;;; Produce a random 10-bit integer, with (random) if no seed provided,
;;; or else with Numerical Recipes algorithm ran3 / Knuth 3.2.2-A.
@ -519,11 +576,6 @@
(car math-random-ptr2)) 524287))
-6) 1023))
(logand (lsh (random) math-random-shift) 1023)))
(setq math-random-table nil)
(setq math-last-RandSeed nil)
(setq math-random-ptr1 nil)
(setq math-random-ptr2 nil)
(setq math-random-shift nil)
;;; Produce a random digit in the range 0..999.
@ -945,53 +997,7 @@
(aref math-primes-table hi))
2))
(defconst math-primes-table
[2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89
97 101 103 107 109 113 127 131 137 139 149 151 157 163 167 173 179 181
191 193 197 199 211 223 227 229 233 239 241 251 257 263 269 271 277
281 283 293 307 311 313 317 331 337 347 349 353 359 367 373 379 383
389 397 401 409 419 421 431 433 439 443 449 457 461 463 467 479 487
491 499 503 509 521 523 541 547 557 563 569 571 577 587 593 599 601
607 613 617 619 631 641 643 647 653 659 661 673 677 683 691 701 709
719 727 733 739 743 751 757 761 769 773 787 797 809 811 821 823 827
829 839 853 857 859 863 877 881 883 887 907 911 919 929 937 941 947
953 967 971 977 983 991 997 1009 1013 1019 1021 1031 1033 1039 1049
1051 1061 1063 1069 1087 1091 1093 1097 1103 1109 1117 1123 1129 1151
1153 1163 1171 1181 1187 1193 1201 1213 1217 1223 1229 1231 1237 1249
1259 1277 1279 1283 1289 1291 1297 1301 1303 1307 1319 1321 1327 1361
1367 1373 1381 1399 1409 1423 1427 1429 1433 1439 1447 1451 1453 1459
1471 1481 1483 1487 1489 1493 1499 1511 1523 1531 1543 1549 1553 1559
1567 1571 1579 1583 1597 1601 1607 1609 1613 1619 1621 1627 1637 1657
1663 1667 1669 1693 1697 1699 1709 1721 1723 1733 1741 1747 1753 1759
1777 1783 1787 1789 1801 1811 1823 1831 1847 1861 1867 1871 1873 1877
1879 1889 1901 1907 1913 1931 1933 1949 1951 1973 1979 1987 1993 1997
1999 2003 2011 2017 2027 2029 2039 2053 2063 2069 2081 2083 2087 2089
2099 2111 2113 2129 2131 2137 2141 2143 2153 2161 2179 2203 2207 2213
2221 2237 2239 2243 2251 2267 2269 2273 2281 2287 2293 2297 2309 2311
2333 2339 2341 2347 2351 2357 2371 2377 2381 2383 2389 2393 2399 2411
2417 2423 2437 2441 2447 2459 2467 2473 2477 2503 2521 2531 2539 2543
2549 2551 2557 2579 2591 2593 2609 2617 2621 2633 2647 2657 2659 2663
2671 2677 2683 2687 2689 2693 2699 2707 2711 2713 2719 2729 2731 2741
2749 2753 2767 2777 2789 2791 2797 2801 2803 2819 2833 2837 2843 2851
2857 2861 2879 2887 2897 2903 2909 2917 2927 2939 2953 2957 2963 2969
2971 2999 3001 3011 3019 3023 3037 3041 3049 3061 3067 3079 3083 3089
3109 3119 3121 3137 3163 3167 3169 3181 3187 3191 3203 3209 3217 3221
3229 3251 3253 3257 3259 3271 3299 3301 3307 3313 3319 3323 3329 3331
3343 3347 3359 3361 3371 3373 3389 3391 3407 3413 3433 3449 3457 3461
3463 3467 3469 3491 3499 3511 3517 3527 3529 3533 3539 3541 3547 3557
3559 3571 3581 3583 3593 3607 3613 3617 3623 3631 3637 3643 3659 3671
3673 3677 3691 3697 3701 3709 3719 3727 3733 3739 3761 3767 3769 3779
3793 3797 3803 3821 3823 3833 3847 3851 3853 3863 3877 3881 3889 3907
3911 3917 3919 3923 3929 3931 3943 3947 3967 3989 4001 4003 4007 4013
4019 4021 4027 4049 4051 4057 4073 4079 4091 4093 4099 4111 4127 4129
4133 4139 4153 4157 4159 4177 4201 4211 4217 4219 4229 4231 4241 4243
4253 4259 4261 4271 4273 4283 4289 4297 4327 4337 4339 4349 4357 4363
4373 4391 4397 4409 4421 4423 4441 4447 4451 4457 4463 4481 4483 4493
4507 4513 4517 4519 4523 4547 4549 4561 4567 4583 4591 4597 4603 4621
4637 4639 4643 4649 4651 4657 4663 4673 4679 4691 4703 4721 4723 4729
4733 4751 4759 4783 4787 4789 4793 4799 4801 4813 4817 4831 4861 4871
4877 4889 4903 4909 4919 4931 4933 4937 4943 4951 4957 4967 4969 4973
4987 4993 4999 5003])
;;; calc-comb.el ends here

19
lisp/calc/calc-cplx.el
View File

@ -1,6 +1,9 @@
;; Calculator for GNU Emacs, part II [calc-cplx.el]
;;; calc-cplx.el --- Complex number functions for Calc
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Written by Dave Gillespie, daveg@synaptics.com.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.
@ -19,7 +22,9 @@
;; file named COPYING. Among other things, the copyright notice
;; and this notice must be preserved on all copies.
;;; Commentary:
;;; Code:
;; This file is autoloaded from calc-ext.el.
(require 'calc-ext)
@ -61,19 +66,19 @@
(interactive)
(calc-wrapper
(calc-change-mode 'calc-complex-format nil t)
(message "Displaying complex numbers in (X,Y) format.")))
(message "Displaying complex numbers in (X,Y) format")))
(defun calc-i-notation ()
(interactive)
(calc-wrapper
(calc-change-mode 'calc-complex-format 'i t)
(message "Displaying complex numbers in X+Yi format.")))
(message "Displaying complex numbers in X+Yi format")))
(defun calc-j-notation ()
(interactive)
(calc-wrapper
(calc-change-mode 'calc-complex-format 'j t)
(message "Displaying complex numbers in X+Yj format.")))
(message "Displaying complex numbers in X+Yj format")))
(defun calc-polar-mode (n)
@ -84,9 +89,9 @@
(eq calc-complex-mode 'cplx))
(progn
(calc-change-mode 'calc-complex-mode 'polar)
(message "Preferred complex form is polar."))
(message "Preferred complex form is polar"))
(calc-change-mode 'calc-complex-mode 'cplx)
(message "Preferred complex form is rectangular."))))
(message "Preferred complex form is rectangular"))))
;;;; Complex numbers.

47
lisp/calc/calc-embed.el
View File

@ -1,6 +1,9 @@
;; Calculator for GNU Emacs, part II [calc-embed.el]
;;; calc-embed.el --- embed Calc in a buffer
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Written by Dave Gillespie, daveg@synaptics.com.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.
@ -19,7 +22,9 @@
;; file named COPYING. Among other things, the copyright notice
;; and this notice must be preserved on all copies.
;;; Commentary:
;;; Code:
;; This file is autoloaded from calc-ext.el.
(require 'calc-ext)
@ -28,38 +33,23 @@
(defun calc-Need-calc-embed () nil)
(defun calc-show-plain (n)
(interactive "P")
(calc-wrapper
(calc-set-command-flag 'renum-stack)
(message (if (calc-change-mode 'calc-show-plain n nil t)
"Including \"plain\" formulas in Calc Embedded mode."
"Omitting \"plain\" formulas in Calc Embedded mode."))))
;;; Things to do for Embedded Mode:
;;;
;;; Detect and strip off unexpected labels during reading.
;;;
;;; Get calc-grab-region to use math-read-big-expr.
;;; If calc-show-plain, main body should have only righthand side of => expr.
;;; Handle tabs that have crept into embedded formulas.
;;; After "switching to new formula", home cursor to that formula.
;;; Do something like \evalto ... \to for \gets operators.
;;;
"Including \"plain\" formulas in Calc Embedded mode"
"Omitting \"plain\" formulas in Calc Embedded mode"))))
(defvar calc-embedded-modes nil)
(defvar calc-embedded-globals nil)
(defvar calc-embedded-active nil)
(defvar calc-embedded-all-active nil)
(make-variable-buffer-local 'calc-embedded-all-active)
(defvar calc-embedded-some-active nil)
(make-variable-buffer-local 'calc-embedded-some-active)
(defvar calc-embedded-open-formula "\\`\\|^\n\\|\\$\\$?\\|\\\\\\[\\|^\\\\begin.*\n\\|^@.*\n\\|^\\.EQ.*\n\\|\\\\(\\|^%\n\\|^\\.\\\\\"\n"
"*A regular expression for the opening delimiter of a formula used by
calc-embedded.")
@ -162,6 +152,7 @@ This is not required to be present for user-written mode annotations.")
;;; thrown away when a buffer changes major modes.
(defvar calc-embedded-quiet nil)
(defun calc-do-embedded (arg end obeg oend)
(if calc-embedded-info
@ -195,7 +186,7 @@ This is not required to be present for user-written mode annotations.")
(use-local-map (nth 1 mode))
(set-buffer-modified-p (buffer-modified-p))
(or calc-embedded-quiet
(message "Back to %s mode." mode-name))))
(message "Back to %s mode" mode-name))))
(t
(if (buffer-name (aref calc-embedded-info 0))
@ -246,12 +237,11 @@ This is not required to be present for user-written mode annotations.")
(setq calc-no-refresh-evaltos nil)
(and chg calc-any-evaltos (calc-wrapper (calc-refresh-evaltos)))
(or (eq calc-embedded-quiet t)
(message "Embedded Calc mode enabled. %s to return to normal."
(message "Embedded Calc mode enabled; %s to return to normal"
(if calc-embedded-quiet
"Type `M-# x'"
"Give this command again")))))
(scroll-down 0)) ; fix a bug which occurs when truncate-lines is changed.
(setq calc-embedded-quiet nil)
(defun calc-embedded-select (arg)
@ -335,7 +325,7 @@ This is not required to be present for user-written mode annotations.")
(calc-embedded-forget))
(calc-find-globals)
(if (< (prefix-numeric-value arg) 0)
(message "Deactivating %s for Calc Embedded mode." (buffer-name))
(message "Deactivating %s for Calc Embedded mode" (buffer-name))
(message "Activating %s for Calc Embedded mode..." (buffer-name))
(save-excursion
(let* ((active (assq (current-buffer) calc-embedded-active))
@ -1002,6 +992,7 @@ The command \\[yank] can retrieve it from there."
;;; These are hooks called by the main part of Calc.
(defvar calc-embedded-no-reselect nil)
(defun calc-embedded-select-buffer ()
(if (eq (current-buffer) (aref calc-embedded-info 0))
(let ((info calc-embedded-info)
@ -1031,7 +1022,6 @@ The command \\[yank] can retrieve it from there."
(forward-char (min horiz
(- (point-max) (point)))))
(calc-select-buffer)))
(setq calc-embedded-no-reselect nil)
(defun calc-embedded-finish-command ()
(let ((buf (current-buffer))
@ -1206,12 +1196,9 @@ The command \\[yank] can retrieve it from there."
(calc-embedded-update (car p) 14 t nil)))
(setcdr (car bp) (delq (car p) (cdr (car bp))))
(message
"(Tried to recompute but formula was changed or missing.)"))))
"(Tried to recompute but formula was changed or missing)"))))
(setq p (cdr p))))
(setq bp (if buf nil (cdr bp))))
(or first calc-embedded-quiet (message "")))))
;;; calc-embed.el ends here

119
lisp/calc/calc-ext.el
View File

@ -1,6 +1,9 @@
;; Calculator for GNU Emacs, part II
;;; calc-ext.el --- various extension functions for Calc
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Written by Dave Gillespie, daveg@synaptics.com.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.
@ -19,7 +22,9 @@
;; file named COPYING. Among other things, the copyright notice
;; and this notice must be preserved on all copies.
;;; Commentary:
;;; Code:
(provide 'calc-ext)
(require 'calc)
@ -39,15 +44,27 @@
(if (fboundp 'calc)
(and (eq (car-safe (symbol-function 'calc)) 'autoload)
(load (nth 1 (symbol-function 'calc))))
(error "Main part of Calc must be present in order to load this file.")))
(error "Main part of Calc must be present in order to load this file")))
(require 'calc-macs)
(defvar math-simplifying nil)
(defvar math-living-dangerously nil) ; true if unsafe simplifications are okay.
(defvar math-integrating nil)
(defvar math-rewrite-selections nil)
(defvar math-compose-level 0)
(defvar math-comp-selected nil)
(defvar math-comp-tagged nil)
(defvar math-comp-sel-hpos nil)
(defvar math-comp-sel-vpos nil)
(defvar math-comp-sel-cpos nil)
(defvar math-compose-hash-args nil)
;;; The following was made a function so that it could be byte-compiled.
(defun calc-init-extensions ()
(setq gc-cons-threshold (max gc-cons-threshold 250000))
(define-key calc-mode-map ":" 'calc-fdiv)
(define-key calc-mode-map "\\" 'calc-idiv)
(define-key calc-mode-map "|" 'calc-concat)
@ -1129,10 +1146,7 @@ calc-unpack calc-unpack-bits calc-vector-find calc-vlength)
("calc-yank" calc-copy-as-kill calc-copy-region-as-kill
calc-copy-to-buffer calc-edit calc-edit-cancel calc-edit-mode
calc-kill calc-kill-region calc-yank)
))
)
calc-kill calc-kill-region calc-yank))))
(defun calc-init-prefixes ()
(if calc-shift-prefix
@ -1220,7 +1234,7 @@ calc-kill calc-kill-region calc-yank)
(define-key calc-help-map "?" 'calc-help-for-help)
(define-key calc-help-map "\C-h" 'calc-help-for-help))
(defvar calc-prefix-help-phase 0)
(defun calc-do-prefix-help (msgs group key)
(if calc-full-help-flag
(list msgs group key)
@ -1249,10 +1263,6 @@ calc-kill calc-kill-region calc-yank)
(message "%s: (none) %c-" group (car msgs) key))
(message "%s: %s" group (car msgs))))
(and key (calc-unread-command key))))
(defvar calc-prefix-help-phase 0)
;;;; Commands.
@ -1327,13 +1337,13 @@ calc-kill calc-kill-region calc-yank)
(interactive "NPrecision: ")
(calc-wrapper
(if (< (prefix-numeric-value n) 3)
(error "Precision must be at least 3 digits.")
(error "Precision must be at least 3 digits")
(calc-change-mode 'calc-internal-prec (prefix-numeric-value n)
(and (memq (car calc-float-format) '(float sci eng))
(< (nth 1 calc-float-format)
(if (= calc-number-radix 10) 0 1))))
(calc-record calc-internal-prec "prec"))
(message "Floating-point precision is %d digits." calc-internal-prec)))
(message "Floating-point precision is %d digits" calc-internal-prec)))
(defun calc-inverse (&optional n)
@ -1359,6 +1369,7 @@ calc-kill calc-kill-region calc-yank)
map)
"Keymap used while processing calc-fancy-prefix.")
(defvar calc-is-keypad-press nil)
(defun calc-fancy-prefix (flag msg n)
(let (prefix)
(calc-wrapper
@ -1384,7 +1395,6 @@ calc-kill calc-kill-region calc-yank)
(eq last-command-char ?-))
(calc-unread-command)
(digit-argument n))))))))
(setq calc-is-keypad-press nil)
(defun calc-fancy-prefix-other-key (arg)
(interactive "P")
@ -1497,6 +1507,8 @@ calc-kill calc-kill-region calc-yank)
(mapcar (function (lambda (x) (nth 2 x)))
entries)))))))
(defvar calc-refreshing-evaltos nil)
(defvar calc-no-refresh-evaltos nil)
(defun calc-refresh-evaltos (&optional which-var)
(and calc-any-evaltos calc-auto-recompute (not calc-no-refresh-evaltos)
(let ((calc-refreshing-evaltos t)
@ -1519,8 +1531,6 @@ calc-kill calc-kill-region calc-yank)
(setq num (1- num)))))
(and calc-embedded-active which-var
(calc-embedded-var-change which-var)))
(setq calc-refreshing-evaltos nil)
(setq calc-no-refresh-evaltos nil)
(defun calc-push (&rest vals)
@ -1589,12 +1599,7 @@ calc-kill calc-kill-region calc-yank)
(if (get-buffer-window (current-buffer))
(set-window-hscroll (get-buffer-window (current-buffer)) 0))))))
(setq math-cache-list nil)
(defvar math-cache-list nil)
(defun calc-var-value (v)
(and (symbolp v)
@ -1609,10 +1614,6 @@ calc-kill calc-kill-region calc-yank)
(set v val)))
(symbol-value v)))))
;;; In the following table, ( OP LOPS ROPS ) means that if an OP
;;; term appears as the first argument to any LOPS term, or as the
;;; second argument to any ROPS term, then they should be treated
@ -1713,7 +1714,7 @@ calc-kill calc-kill-region calc-yank)
(calc-Need-calc-vec)
(calc-Need-calc-yank)
(message "All parts of Calc are now loaded."))
(message "All parts of Calc are now loaded"))
;;; Vector commands.
@ -1940,8 +1941,7 @@ calc-kill calc-kill-region calc-yank)
(defun math-quarter-circle (symb)
(math-div (math-half-circle symb) 2))
(defvar math-expand-formulas nil)
;;;; Miscellaneous math routines.
@ -2144,6 +2144,7 @@ calc-kill calc-kill-region calc-yank)
(+ (car a) (* (math-fixnum-big (cdr a)) 1000))
(car a)))
(defvar math-simplify-only nil)
(defun math-normalize-fancy (a)
(cond ((eq (car a) 'frac)
@ -2233,7 +2234,6 @@ calc-kill calc-kill-region calc-yank)
(setq math-expand-formulas nil)
;;; Normalize a bignum digit list by trimming high-end zeros. [L l]
@ -2487,18 +2487,10 @@ calc-kill calc-kill-region calc-yank)
(list func (calc-top-n (- n)))
(- n))))))
(defvar var-Holidays '(vec (var sat var-sat) (var sun var-sun)))
(defvar var-Decls (list 'vec))
(setq math-simplify-only nil)
(defun math-inexact-result ()
(and calc-symbolic-mode
(signal 'inexact-result nil)))
@ -2511,8 +2503,6 @@ calc-kill calc-kill-region calc-yank)
(defun math-underflow ()
(signal 'math-underflow nil))
;;; Compute the greatest common divisor of A and B. [I I I] [Public]
(defun math-gcd (a b)
(cond ((not (or (consp a) (consp b)))
@ -2599,10 +2589,6 @@ calc-kill calc-kill-region calc-yank)
(cons (car x) (mapcar 'math-evaluate-expr-rec (cdr x))))))
x))
(setq math-simplifying nil)
(setq math-living-dangerously nil) ; true if unsafe simplifications are okay.
(setq math-integrating nil)
(defmacro math-defsimplify (funcs &rest code)
(append '(progn (math-need-std-simps))
(mapcar (function
@ -2650,8 +2636,6 @@ calc-kill calc-kill-region calc-yank)
(setq mmt-expr mmt-nextval))))))
mmt-expr)
(setq math-rewrite-selections nil)
(defun math-is-true (expr)
(if (Math-numberp expr)
(not (Math-zerop expr))
@ -2700,11 +2684,11 @@ calc-kill calc-kill-region calc-yank)
(defvar var-FitRules 'calc-FitRules)
(setq math-poly-base-variable nil)
(setq math-poly-neg-powers nil)
(setq math-poly-mult-powers 1)
(setq math-poly-frac-powers nil)
(setq math-poly-exp-base nil)
(defvar math-poly-base-variable nil)
(defvar math-poly-neg-powers nil)
(defvar math-poly-mult-powers 1)
(defvar math-poly-frac-powers nil)
(defvar math-poly-exp-base nil)
(defun math-build-var-name (name)
(if (stringp name)
@ -2713,14 +2697,8 @@ calc-kill calc-kill-region calc-yank)
(list 'var (intern (substring (symbol-name name) 4)) name)
(list 'var name (intern (concat "var-" (symbol-name name))))))
(setq math-simplifying-units nil)
(setq math-combining-units t)
(put 'math-while 'lisp-indent-hook 1)
(put 'math-for 'lisp-indent-hook 1)
(put 'math-foreach 'lisp-indent-hook 1)
(defvar math-simplifying-units nil)
(defvar math-combining-units t)
;;; Nontrivial number parsing.
@ -3013,10 +2991,11 @@ calc-kill calc-kill-region calc-yank)
(not (cdr lines)))
matrix))))
;;; Nontrivial "flat" formatting.
(defvar math-format-hash-args nil)
(defvar calc-can-abbrev-vectors nil)
(defun math-format-flat-expr-fancy (a prec)
(cond
((eq (car a) 'incomplete)
@ -3094,7 +3073,6 @@ calc-kill calc-kill-region calc-yank)
"("
(math-format-flat-vector (cdr a) ", " 0)
")")))))))
(setq math-format-hash-args nil)
(defun math-format-flat-vector (vec sep prec)
(if vec
@ -3103,7 +3081,6 @@ calc-kill calc-kill-region calc-yank)
(setq buf (concat buf sep (math-format-flat-expr (car vec) prec))))
buf)
""))
(setq calc-can-abbrev-vectors nil)
(defun math-format-nice-expr (x w)
(cond ((and (eq (car-safe x) 'vec)
@ -3136,7 +3113,6 @@ calc-kill calc-kill-region calc-yank)
(setq a (cdr a)))
(car a))
(defun math-format-number-fancy (a prec)
(cond
((eq (car a) 'float) ; non-decimal radix
@ -3291,15 +3267,6 @@ calc-kill calc-kill-region calc-yank)
(substring str i))))
str))
(setq math-compose-level 0)
(setq math-comp-selected nil)
(setq math-comp-tagged nil)
(setq math-comp-sel-hpos nil)
(setq math-comp-sel-vpos nil)
(setq math-comp-sel-cpos nil)
(setq math-compose-hash-args nil)
;;; Users can redefine this in their .emacs files.
(defvar calc-keypad-user-menu nil
"If not NIL, this describes an additional menu for calc-keypad.

9
lisp/calc/calc-fin.el
View File

@ -1,6 +1,9 @@
;; Calculator for GNU Emacs, part II [calc-fin.el]
;;; calc-fin.el --- financial functions for Calc
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Written by Dave Gillespie, daveg@synaptics.com.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.
@ -19,7 +22,9 @@
;; file named COPYING. Among other things, the copyright notice
;; and this notice must be preserved on all copies.
;;; Commentary:
;;; Code:
;; This file is autoloaded from calc-ext.el.
(require 'calc-ext)

22
lisp/calc/calc-forms.el
View File

@ -1,6 +1,9 @@
;; Calculator for GNU Emacs, part II [calc-forms.el]
;;; calc-forms.el --- data format conversion functions for Calc
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Written by Dave Gillespie, daveg@synaptics.com.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.
@ -19,7 +22,9 @@
;; file named COPYING. Among other things, the copyright notice
;; and this notice must be preserved on all copies.
;;; Commentary:
;;; Code:
;; This file is autoloaded from calc-ext.el.
(require 'calc-ext)
@ -69,7 +74,7 @@
"%s" (math-match-substring fmt 5))
t)
(setq-default calc-hms-format calc-hms-format)) ; for minibuffer
(error "Bad hours-minutes-seconds format."))))
(error "Bad hours-minutes-seconds format"))))
(defun calc-date-notation (fmt arg)
(interactive "sDate format (e.g., M/D/YY h:mm:ss): \nP")
@ -154,7 +159,7 @@
(interactive)
(calc-wrapper
(calc-change-mode 'calc-angle-mode 'hms)
(message "Angles measured in degrees-minutes-seconds.")))
(message "Angles measured in degrees-minutes-seconds")))
(defun calc-now (arg)
@ -503,6 +508,7 @@
"Jul" "Aug" "Sep" "Oct" "Nov" "Dec" ))
(defvar math-format-date-cache nil)
(defun math-format-date (date)
(if (eq (car-safe date) 'date)
(setq date (nth 1 date)))
@ -521,7 +527,6 @@
(and (setq dt (nthcdr 10 math-format-date-cache))
(setcdr dt nil))
fmt))))
(setq math-format-date-cache nil)
(defun math-format-date-part (x)
(cond ((stringp x)
@ -1399,6 +1404,8 @@ and ends on the last Sunday of October at 2 a.m."
(if (and (cdr db) (not (cdr da))) 1 0))))
(calcFunc-badd a (math-neg b))))
(defvar math-holidays-cache nil)
(defvar math-holidays-cache-tag t)
(defun calcFunc-badd (a b)
(if (eq (car-safe b) 'date)
(if (eq (car-safe a) 'date)
@ -1426,11 +1433,6 @@ and ends on the last Sunday of October at 2 a.m."
(defun calcFunc-holiday (a)
(if (cdr (math-to-business-day a)) 1 0))
(setq math-holidays-cache nil)
(setq math-holidays-cache-tag t)
;;; Compute the number of business days since Jan 1, 1 AD.
(defun math-to-business-day (date &optional need-year)

37
lisp/calc/calc-graph.el
View File

@ -1,6 +1,9 @@
;; Calculator for GNU Emacs, part II [calc-graph.el]
;;; calc-graph.el --- graph output functions for Calc
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Written by Dave Gillespie, daveg@synaptics.com.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.
@ -19,7 +22,9 @@
;; file named COPYING. Among other things, the copyright notice
;; and this notice must be preserved on all copies.
;;; Commentary:
;;; Code:
;; This file is autoloaded from calc-ext.el.
(require 'calc-ext)
@ -32,7 +37,7 @@
;;; Graphics
;;; Note that some of the following initial values also occur in calc.el.
(defvar calc-gnuplot-tempfile "/tmp/calc")
(defvar calc-gnuplot-tempfile (expand-file-name "calc" temporary-file-directory))
(defvar calc-gnuplot-default-device "default")
(defvar calc-gnuplot-default-output "STDOUT")
@ -58,6 +63,8 @@
(defvar calc-graph-var-cache nil)
(defvar calc-graph-data-cache nil)
(defvar calc-graph-data-cache-limit 10)
(defvar calc-graph-no-auto-view nil)
(defvar calc-graph-no-wait nil)
(defun calc-graph-fast (many)
(interactive "P")
@ -908,7 +915,7 @@ This \"dumb\" driver will be present in Gnuplot 3.0."
(define-key calc-dumb-map "\C-c\C-c" 'exit-recursive-edit)))
(use-local-map calc-dumb-map)
(setq truncate-lines t)
(message "Type `q'%s to return to Calc."
(message "Type `q'%s to return to Calc"
(if (eq (lookup-key (current-global-map) "\e#") 'calc-dispatch)
" or `M-# M-#'" ""))
(recursive-edit)
@ -1151,11 +1158,11 @@ This \"dumb\" driver will be present in Gnuplot 3.0."
(if flag
(if (> (prefix-numeric-value flag) 0)
(if (equal res "")
(message "Default resolution is %d."
(message "Default resolution is %d"
calc-graph-default-resolution)
(setq calc-graph-default-resolution (string-to-int res)))
(if (equal res "")
(message "Default 3D resolution is %d."
(message "Default 3D resolution is %d"
calc-graph-default-resolution-3d)
(setq calc-graph-default-resolution-3d (string-to-int res))))
(calc-graph-set-command "samples" (if (not (equal res "")) res))))
@ -1169,11 +1176,11 @@ This \"dumb\" driver will be present in Gnuplot 3.0."
(if flag
(if (> (prefix-numeric-value flag) 0)
(if (equal name "")
(message "Default GNUPLOT device is \"%s\"."
(message "Default GNUPLOT device is \"%s\""
calc-gnuplot-default-device)
(setq calc-gnuplot-default-device name))
(if (equal name "")
(message "GNUPLOT device for Print command is \"%s\"."
(message "GNUPLOT device for Print command is \"%s\""
calc-gnuplot-print-device)
(setq calc-gnuplot-print-device name)))
(calc-graph-set-command "terminal" (if (not (equal name ""))
@ -1193,11 +1200,11 @@ This \"dumb\" driver will be present in Gnuplot 3.0."
(if flag
(if (> (prefix-numeric-value flag) 0)
(if (equal name "")
(message "Default GNUPLOT output file is \"%s\"."
(message "Default GNUPLOT output file is \"%s\""
calc-gnuplot-default-output)
(setq calc-gnuplot-default-output name))
(if (equal name "")
(message "GNUPLOT output file for Print command is \"%s\"."
(message "GNUPLOT output file for Print command is \"%s\""
calc-gnuplot-print-output)
(setq calc-gnuplot-print-output name)))
(calc-graph-set-command "output" (if (not (equal name ""))
@ -1206,7 +1213,7 @@ This \"dumb\" driver will be present in Gnuplot 3.0."
(defun calc-graph-display (name)
(interactive "sX display name: ")
(if (equal name "")
(message "Current X display is \"%s\"."
(message "Current X display is \"%s\""
(or calc-gnuplot-display "<none>"))
(setq calc-gnuplot-display name)
(if (calc-gnuplot-alive)
@ -1215,7 +1222,7 @@ This \"dumb\" driver will be present in Gnuplot 3.0."
(defun calc-graph-geometry (name)
(interactive "sX geometry spec (or \"default\"): ")
(if (equal name "")
(message "Current X geometry is \"%s\"."
(message "Current X geometry is \"%s\""
(or calc-gnuplot-geometry "default"))
(setq calc-gnuplot-geometry (and (not (equal name "default")) name))
(if (calc-gnuplot-alive)
@ -1326,7 +1333,6 @@ This \"dumb\" driver will be present in Gnuplot 3.0."
(set-window-start win (point))
(goto-char (point-max)))))
(or calc-graph-no-auto-view (sit-for 0))))
(setq calc-graph-no-auto-view nil)
(defun calc-gnuplot-check-for-errors ()
(if (save-excursion
@ -1359,7 +1365,6 @@ This \"dumb\" driver will be present in Gnuplot 3.0."
(calc-gnuplot-check-for-errors)
(if (get-buffer-window calc-gnuplot-buffer)
(calc-graph-view-trail)))))
(setq calc-graph-no-wait nil)
(defun calc-graph-init-buffers ()
(or (and calc-gnuplot-buffer
@ -1401,7 +1406,7 @@ This \"dumb\" driver will be present in Gnuplot 3.0."
args))
(process-kill-without-query calc-gnuplot-process))
(file-error
(error "Sorry, can't find \"%s\" on your system."
(error "Sorry, can't find \"%s\" on your system"
calc-gnuplot-name)))
(save-excursion
(set-buffer calc-gnuplot-buffer)
@ -1411,7 +1416,7 @@ This \"dumb\" driver will be present in Gnuplot 3.0."
(memq (process-status calc-gnuplot-process) '(run stop)))
(accept-process-output calc-gnuplot-process))
(or (memq (process-status calc-gnuplot-process) '(run stop))
(error "Unable to start GNUPLOT process."))
(error "Unable to start GNUPLOT process"))
(if (save-excursion
(goto-char origin)
(re-search-forward

10
lisp/calc/calc-help.el
View File

@ -1,6 +1,9 @@
;; Calculator for GNU Emacs, part II [calc-help.el]
;;; calc-help.el --- help display functions for Calc,
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Written by Dave Gillespie, daveg@synaptics.com.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.
@ -19,7 +22,9 @@
;; file named COPYING. Among other things, the copyright notice
;; and this notice must be preserved on all copies.
;;; Commentary:
;;; Code:
;; This file is autoloaded from calc-ext.el.
(require 'calc-ext)
@ -381,7 +386,6 @@ C-w Describe how there is no warranty for Calc."
(princ (format "GNU Emacs Calculator version %s of %s.\n"
calc-version calc-version-date))
(princ " By Dave Gillespie, daveg@synaptics.com.\n")
(princ (format " Installed %s.\n" calc-installed-date))
(princ " Copyright (C) 1990, 1993 Free Software Foundation, Inc.\n\n")
(princ "Type `h s' for a more detailed summary.\n")
(princ "Or type `h i' to read the full Calc manual on-line.\n\n")

9
lisp/calc/calc-incom.el
View File

@ -1,6 +1,9 @@
;; Calculator for GNU Emacs, part II [calc-incom.el]
;;; calc-incom.el --- complex data type input functions for Calc
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Written by Dave Gillespie, daveg@synaptics.com.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.
@ -19,7 +22,9 @@
;; file named COPYING. Among other things, the copyright notice
;; and this notice must be preserved on all copies.
;;; Commentary:
;;; Code:
;; This file is autoloaded from calc-ext.el.
(require 'calc-ext)

46
lisp/calc/calc-lang.el
View File

@ -1,6 +1,9 @@
;; Calculator for GNU Emacs, part II [calc-lang.el]
;;; calc-lang.el --- calc language functions
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Written by Dave Gillespie, daveg@synaptics.com.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.
@ -19,6 +22,9 @@
;; file named COPYING. Among other things, the copyright notice
;; and this notice must be preserved on all copies.
;;; Commentary:
;;; Code:
;; This file is autoloaded from calc-ext.el.
@ -52,32 +58,32 @@
(interactive)
(calc-wrapper
(calc-set-language nil)
(message "Normal language mode.")))
(message "Normal language mode")))
(defun calc-flat-language ()
(interactive)
(calc-wrapper
(calc-set-language 'flat)
(message "Flat language mode (all stack entries shown on one line).")))
(message "Flat language mode (all stack entries shown on one line)")))
(defun calc-big-language ()
(interactive)
(calc-wrapper
(calc-set-language 'big)
(message "\"Big\" language mode.")))
(message "\"Big\" language mode")))
(defun calc-unformatted-language ()
(interactive)
(calc-wrapper
(calc-set-language 'unform)
(message "Unformatted language mode.")))
(message "Unformatted language mode")))
(defun calc-c-language ()
(interactive)
(calc-wrapper
(calc-set-language 'c)
(message "`C' language mode.")))
(message "`C' language mode")))
(put 'c 'math-oper-table
'( ( "u+" ident -1 1000 )
@ -139,9 +145,9 @@
(calc-set-language 'pascal n)
(message (if (and n (/= n 0))
(if (> n 0)
"Pascal language mode (all uppercase)."
"Pascal language mode (all lowercase).")
"Pascal language mode."))))
"Pascal language mode (all uppercase)"
"Pascal language mode (all lowercase)")
"Pascal language mode"))))
(put 'pascal 'math-oper-table
'( ( "not" calcFunc-lnot -1 1000 )
@ -201,9 +207,9 @@
(calc-set-language 'fortran n)
(message (if (and n (/= n 0))
(if (> n 0)
"FORTRAN language mode (all uppercase)."
"FORTRAN language mode (all lowercase).")
"FORTRAN language mode."))))
"FORTRAN language mode (all uppercase)"
"FORTRAN language mode (all lowercase)")
"FORTRAN language mode"))))
(put 'fortran 'math-oper-table
'( ( "u/" (math-parse-fortran-vector) -1 1 )
@ -251,6 +257,7 @@
(put 'fortran 'math-input-filter 'calc-input-case-filter)
(put 'fortran 'math-output-filter 'calc-output-case-filter)
(defvar math-parsing-fortran-vector nil)
(defun math-parse-fortran-vector (op)
(let ((math-parsing-fortran-vector '(end . "\000")))
(prog1
@ -266,7 +273,6 @@
exp-data "\000")
x)
(throw 'syntax "Unmatched closing `/'")))
(setq math-parsing-fortran-vector nil)
(defun math-parse-fortran-subscr (sym args)
(setq sym (math-build-var-name sym))
@ -283,9 +289,9 @@
(calc-set-language 'tex n)
(message (if (and n (/= n 0))
(if (> n 0)
"TeX language mode with \\hbox{func}(\\hbox{var})."
"TeX language mode with \\func{\\hbox{var}}.")
"TeX language mode."))))
"TeX language mode with \\hbox{func}(\\hbox{var})"
"TeX language mode with \\func{\\hbox{var}}")
"TeX language mode"))))
(put 'tex 'math-oper-table
'( ( "u+" ident -1 1000 )
@ -402,7 +408,7 @@
(interactive "P")
(calc-wrapper
(calc-set-language 'eqn)
(message "Eqn language mode.")))
(message "Eqn language mode")))
(put 'eqn 'math-oper-table
'( ( "u+" ident -1 1000 )
@ -515,7 +521,7 @@
(interactive)
(calc-wrapper
(calc-set-language 'math)
(message "Mathematica language mode.")))
(message "Mathematica language mode")))
(put 'math 'math-oper-table
'( ( "[[" (math-read-math-subscr) 250 -1 )
@ -628,7 +634,7 @@
(interactive)
(calc-wrapper
(calc-set-language 'maple)
(message "Maple language mode.")))
(message "Maple language mode")))
(put 'maple 'math-oper-table
'( ( "matrix" ident -1 300 )

27
lisp/calc/calc-maint.el
View File

@ -1,6 +1,9 @@
;; Calculator for GNU Emacs, maintenance routines
;;; calc-maint.el --- maintenance routines for Calc
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Written by Dave Gillespie, daveg@synaptics.com.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.
@ -19,8 +22,9 @@
;; file named COPYING. Among other things, the copyright notice
;; and this notice must be preserved on all copies.
;;; Commentary:
;;; Code:
(defun calc-compile ()
"Compile all parts of Calc.
@ -58,7 +62,7 @@ Unix usage:
;; Make sure we're in the right directory.
(find-file "calc.el")
(if (= (buffer-size) 0)
(error "This command must be used in the Calc source directory."))
(error "This command must be used in the Calc source directory"))
;; Make sure current directory is in load-path.
(setq load-path (cons default-directory load-path))
@ -82,7 +86,7 @@ Unix usage:
(setq changed-units t))
(or message-bug (message ""))
(byte-compile-file (car files)))
(message "File %s is up to date." (car files)))
(message "File %s is up to date" (car files)))
(if (string-match "calc\\(-ext\\)?.el" (car files))
(load (concat (car files) "c") nil t t))
(setq files (cdr files))))
@ -132,7 +136,7 @@ Unix usage:
(sort rules 'string<))
(save-buffer))))
(error (message "Unable to pre-build tables %s" err))))
(message "Done. Don't forget to install with \"make public\" or \"make private\".")))
(message "Done. Don't forget to install with \"make public\" or \"make private\"")))
(defun calc-compile-message (fmt &rest args)
(cond ((and (= (length args) 2)
@ -158,8 +162,8 @@ Unix usage:
(= (length args) 1)
(stringp (car args))
(string-match ".elc?\\'" (car args)))
(or (string-match "Saving file %s..." fmt)
(funcall old-message fmt (file-name-nondirectory (car args)))))
(unless (string-match "Saving file %s..." fmt)
(funcall old-message fmt (file-name-nondirectory (car args)))))
((string-match "\\(Preparing\\|Building\\).*\\.\\.\\.$" fmt)
(send-string-to-terminal (apply 'format fmt args)))
((string-match "\\(Preparing\\|Building\\).*\\.\\.\\. *done$" fmt)
@ -203,7 +207,7 @@ Usage: C-x C-f calc.texinfo RET
(or (let ((case-fold-search t))
(string-match "calc\\.texinfo" (buffer-name)))
force
(error "This command should be used in the calc.texinfo buffer."))
(error "This command should be used in the calc.texinfo buffer"))
(let ((srcbuf (current-buffer))
tutpos refpos endpos (maxpos (point-max)))
(goto-char 1)
@ -278,7 +282,7 @@ Usage: C-x C-f calc.texinfo RET
(or (let ((case-fold-search t))
(string-match "calc\\.texinfo" (buffer-name)))
force
(error "This command should be used in the calc.texinfo buffer."))
(error "This command should be used in the calc.texinfo buffer"))
(let ((srcbuf (current-buffer))
begpos sumpos endpos midpos)
(goto-char 1)
@ -402,7 +406,8 @@ global-set-key commands for Calc."
(not (file-exists-p
(setq name (expand-file-name "default.el" (car p))))))
(setq p (cdr p)))
(or p (error "Unable to find \"default\" file. Create one and try again."))
(unless p
(error "Unable to find \"default\" file. Create one and try again"))
(find-file name)
(if buffer-read-only (error "No write permission for \"%s\"" buffer-file-name))
(goto-char (point-max))

615
lisp/calc/calc-map.el
View File

@ -1,6 +1,9 @@
;; Calculator for GNU Emacs, part II [calc-map.el]
;;; calc-map.el --- higher-order functions for Calc
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Written by Dave Gillespie, daveg@synaptics.com.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.
@ -19,7 +22,9 @@
;; file named COPYING. Among other things, the copyright notice
;; and this notice must be preserved on all copies.
;;; Commentary:
;;; Code:
;; This file is autoloaded from calc-ext.el.
(require 'calc-ext)
@ -140,6 +145,8 @@
nargs
(1+ calc-dollar-used))))))))
(defvar calc-verify-arglist t)
(defvar calc-mapping-dir nil)
(defun calc-map-stack ()
"This is meant to be called by calc-keypad mode."
(interactive)
@ -191,6 +198,307 @@
(calc-top-list-n
2 (+ 1 mul-used calc-dollar-used)))))))
(defconst calc-oper-keys '( ( ( ?+ 2 calcFunc-add )
( ?- 2 calcFunc-sub )
( ?* 2 calcFunc-mul )
( ?/ 2 calcFunc-div )
( ?^ 2 calcFunc-pow )
( ?| 2 calcFunc-vconcat )
( ?% 2 calcFunc-mod )
( ?\\ 2 calcFunc-idiv )
( ?! 1 calcFunc-fact )
( ?& 1 calcFunc-inv )
( ?n 1 calcFunc-neg )
( ?x user )
( ?z user )
( ?A 1 calcFunc-abs )
( ?J 1 calcFunc-conj )
( ?G 1 calcFunc-arg )
( ?Q 1 calcFunc-sqrt )
( ?N 2 calcFunc-min )
( ?X 2 calcFunc-max )
( ?F 1 calcFunc-floor )
( ?R 1 calcFunc-round )
( ?S 1 calcFunc-sin )
( ?C 1 calcFunc-cos )
( ?T 1 calcFunc-tan )
( ?L 1 calcFunc-ln )
( ?E 1 calcFunc-exp )
( ?B 2 calcFunc-log ) )
( ( ?F 1 calcFunc-ceil ) ; inverse
( ?R 1 calcFunc-trunc )
( ?Q 1 calcFunc-sqr )
( ?S 1 calcFunc-arcsin )
( ?C 1 calcFunc-arccos )
( ?T 1 calcFunc-arctan )
( ?L 1 calcFunc-exp )
( ?E 1 calcFunc-ln )
( ?B 2 calcFunc-alog )
( ?^ 2 calcFunc-nroot )
( ?| 2 calcFunc-vconcatrev ) )
( ( ?F 1 calcFunc-ffloor ) ; hyperbolic
( ?R 1 calcFunc-fround )
( ?S 1 calcFunc-sinh )
( ?C 1 calcFunc-cosh )
( ?T 1 calcFunc-tanh )
( ?L 1 calcFunc-log10 )
( ?E 1 calcFunc-exp10 )
( ?| 2 calcFunc-append ) )
( ( ?F 1 calcFunc-fceil ) ; inverse-hyperbolic
( ?R 1 calcFunc-ftrunc )
( ?S 1 calcFunc-arcsinh )
( ?C 1 calcFunc-arccosh )
( ?T 1 calcFunc-arctanh )
( ?L 1 calcFunc-exp10 )
( ?E 1 calcFunc-log10 )
( ?| 2 calcFunc-appendrev ) )))
(defconst calc-a-oper-keys '( ( ( ?a 3 calcFunc-apart )
( ?b 3 calcFunc-subst )
( ?c 2 calcFunc-collect )
( ?d 2 calcFunc-deriv )
( ?e 1 calcFunc-esimplify )
( ?f 2 calcFunc-factor )
( ?g 2 calcFunc-pgcd )
( ?i 2 calcFunc-integ )
( ?m 2 calcFunc-match )
( ?n 1 calcFunc-nrat )
( ?r 2 calcFunc-rewrite )
( ?s 1 calcFunc-simplify )
( ?t 3 calcFunc-taylor )
( ?x 1 calcFunc-expand )
( ?M 2 calcFunc-mapeq )
( ?N 3 calcFunc-minimize )
( ?P 2 calcFunc-roots )
( ?R 3 calcFunc-root )
( ?S 2 calcFunc-solve )
( ?T 4 calcFunc-table )
( ?X 3 calcFunc-maximize )
( ?= 2 calcFunc-eq )
( ?\# 2 calcFunc-neq )
( ?< 2 calcFunc-lt )
( ?> 2 calcFunc-gt )
( ?\[ 2 calcFunc-leq )
( ?\] 2 calcFunc-geq )
( ?{ 2 calcFunc-in )
( ?! 1 calcFunc-lnot )
( ?& 2 calcFunc-land )
( ?\| 2 calcFunc-lor )
( ?: 3 calcFunc-if )
( ?. 2 calcFunc-rmeq )
( ?+ 4 calcFunc-sum )
( ?- 4 calcFunc-asum )
( ?* 4 calcFunc-prod )
( ?_ 2 calcFunc-subscr )
( ?\\ 2 calcFunc-pdiv )
( ?% 2 calcFunc-prem )
( ?/ 2 calcFunc-pdivrem ) )
( ( ?m 2 calcFunc-matchnot )
( ?M 2 calcFunc-mapeqr )
( ?S 2 calcFunc-finv ) )
( ( ?d 2 calcFunc-tderiv )
( ?f 2 calcFunc-factors )
( ?M 2 calcFunc-mapeqp )
( ?N 3 calcFunc-wminimize )
( ?R 3 calcFunc-wroot )
( ?S 2 calcFunc-fsolve )
( ?X 3 calcFunc-wmaximize )
( ?/ 2 calcFunc-pdivide ) )
( ( ?S 2 calcFunc-ffinv ) )))
(defconst calc-b-oper-keys '( ( ( ?a 2 calcFunc-and )
( ?o 2 calcFunc-or )
( ?x 2 calcFunc-xor )
( ?d 2 calcFunc-diff )
( ?n 1 calcFunc-not )
( ?c 1 calcFunc-clip )
( ?l 2 calcFunc-lsh )
( ?r 2 calcFunc-rsh )
( ?L 2 calcFunc-ash )
( ?R 2 calcFunc-rash )
( ?t 2 calcFunc-rot )
( ?p 1 calcFunc-vpack )
( ?u 1 calcFunc-vunpack )
( ?D 4 calcFunc-ddb )
( ?F 3 calcFunc-fv )
( ?I 1 calcFunc-irr )
( ?M 3 calcFunc-pmt )
( ?N 2 calcFunc-npv )
( ?P 3 calcFunc-pv )
( ?S 3 calcFunc-sln )
( ?T 3 calcFunc-rate )
( ?Y 4 calcFunc-syd )
( ?\# 3 calcFunc-nper )
( ?\% 2 calcFunc-relch ) )
( ( ?F 3 calcFunc-fvb )
( ?I 1 calcFunc-irrb )
( ?M 3 calcFunc-pmtb )
( ?N 2 calcFunc-npvb )
( ?P 3 calcFunc-pvb )
( ?T 3 calcFunc-rateb )
( ?\# 3 calcFunc-nperb ) )
( ( ?F 3 calcFunc-fvl )
( ?M 3 calcFunc-pmtl )
( ?P 3 calcFunc-pvl )
( ?T 3 calcFunc-ratel )
( ?\# 3 calcFunc-nperl ) )))
(defconst calc-c-oper-keys '( ( ( ?d 1 calcFunc-deg )
( ?r 1 calcFunc-rad )
( ?h 1 calcFunc-hms )
( ?f 1 calcFunc-float )
( ?F 1 calcFunc-frac ) )))
(defconst calc-f-oper-keys '( ( ( ?b 2 calcFunc-beta )
( ?e 1 calcFunc-erf )
( ?g 1 calcFunc-gamma )
( ?h 2 calcFunc-hypot )
( ?i 1 calcFunc-im )
( ?j 2 calcFunc-besJ )
( ?n 2 calcFunc-min )
( ?r 1 calcFunc-re )
( ?s 1 calcFunc-sign )
( ?x 2 calcFunc-max )
( ?y 2 calcFunc-besY )
( ?A 1 calcFunc-abssqr )
( ?B 3 calcFunc-betaI )
( ?E 1 calcFunc-expm1 )
( ?G 2 calcFunc-gammaP )
( ?I 2 calcFunc-ilog )
( ?L 1 calcFunc-lnp1 )
( ?M 1 calcFunc-mant )
( ?Q 1 calcFunc-isqrt )
( ?S 1 calcFunc-scf )
( ?T 2 calcFunc-arctan2 )
( ?X 1 calcFunc-xpon )
( ?\[ 2 calcFunc-decr )
( ?\] 2 calcFunc-incr ) )
( ( ?e 1 calcFunc-erfc )
( ?E 1 calcFunc-lnp1 )
( ?G 2 calcFunc-gammaQ )
( ?L 1 calcFunc-expm1 ) )
( ( ?B 3 calcFunc-betaB )
( ?G 2 calcFunc-gammag) )
( ( ?G 2 calcFunc-gammaG ) )))
(defconst calc-k-oper-keys '( ( ( ?b 1 calcFunc-bern )
( ?c 2 calcFunc-choose )
( ?d 1 calcFunc-dfact )
( ?e 1 calcFunc-euler )
( ?f 1 calcFunc-prfac )
( ?g 2 calcFunc-gcd )
( ?h 2 calcFunc-shuffle )
( ?l 2 calcFunc-lcm )
( ?m 1 calcFunc-moebius )
( ?n 1 calcFunc-nextprime )
( ?r 1 calcFunc-random )
( ?s 2 calcFunc-stir1 )
( ?t 1 calcFunc-totient )
( ?B 3 calcFunc-utpb )
( ?C 2 calcFunc-utpc )
( ?F 3 calcFunc-utpf )
( ?N 3 calcFunc-utpn )
( ?P 2 calcFunc-utpp )
( ?T 2 calcFunc-utpt ) )
( ( ?n 1 calcFunc-prevprime )
( ?B 3 calcFunc-ltpb )
( ?C 2 calcFunc-ltpc )
( ?F 3 calcFunc-ltpf )
( ?N 3 calcFunc-ltpn )
( ?P 2 calcFunc-ltpp )
( ?T 2 calcFunc-ltpt ) )
( ( ?b 2 calcFunc-bern )
( ?c 2 calcFunc-perm )
( ?e 2 calcFunc-euler )
( ?s 2 calcFunc-stir2 ) )))
(defconst calc-s-oper-keys '( ( ( ?: 2 calcFunc-assign )
( ?= 1 calcFunc-evalto ) )))
(defconst calc-t-oper-keys '( ( ( ?C 3 calcFunc-tzconv )
( ?D 1 calcFunc-date )
( ?I 2 calcFunc-incmonth )
( ?J 1 calcFunc-julian )
( ?M 1 calcFunc-newmonth )
( ?W 1 calcFunc-newweek )
( ?U 1 calcFunc-unixtime )
( ?Y 1 calcFunc-newyear ) )))
(defconst calc-u-oper-keys '( ( ( ?C 2 calcFunc-vcov )
( ?G 1 calcFunc-vgmean )
( ?M 1 calcFunc-vmean )
( ?N 1 calcFunc-vmin )
( ?S 1 calcFunc-vsdev )
( ?X 1 calcFunc-vmax ) )
( ( ?C 2 calcFunc-vpcov )
( ?M 1 calcFunc-vmeane )
( ?S 1 calcFunc-vpsdev ) )
( ( ?C 2 calcFunc-vcorr )
( ?G 1 calcFunc-agmean )
( ?M 1 calcFunc-vmedian )
( ?S 1 calcFunc-vvar ) )
( ( ?M 1 calcFunc-vhmean )
( ?S 1 calcFunc-vpvar ) )))
(defconst calc-v-oper-keys '( ( ( ?a 2 calcFunc-arrange )
( ?b 2 calcFunc-cvec )
( ?c 2 calcFunc-mcol )
( ?d 2 calcFunc-diag )
( ?e 2 calcFunc-vexp )
( ?f 2 calcFunc-find )
( ?h 1 calcFunc-head )
( ?k 2 calcFunc-cons )
( ?l 1 calcFunc-vlen )
( ?m 2 calcFunc-vmask )
( ?n 1 calcFunc-rnorm )
( ?p 2 calcFunc-pack )
( ?r 2 calcFunc-mrow )
( ?s 3 calcFunc-subvec )
( ?t 1 calcFunc-trn )
( ?u 1 calcFunc-unpack )
( ?v 1 calcFunc-rev )
( ?x 1 calcFunc-index )
( ?A 1 calcFunc-apply )
( ?C 1 calcFunc-cross )
( ?D 1 calcFunc-det )
( ?E 1 calcFunc-venum )
( ?F 1 calcFunc-vfloor )
( ?G 1 calcFunc-grade )
( ?H 2 calcFunc-histogram )
( ?I 2 calcFunc-inner )
( ?L 1 calcFunc-lud )
( ?M 0 calcFunc-map )
( ?N 1 calcFunc-cnorm )
( ?O 2 calcFunc-outer )
( ?R 1 calcFunc-reduce )
( ?S 1 calcFunc-sort )
( ?T 1 calcFunc-tr )
( ?U 1 calcFunc-accum )
( ?V 2 calcFunc-vunion )
( ?X 2 calcFunc-vxor )
( ?- 2 calcFunc-vdiff )
( ?^ 2 calcFunc-vint )
( ?~ 1 calcFunc-vcompl )
( ?# 1 calcFunc-vcard )
( ?: 1 calcFunc-vspan )
( ?+ 1 calcFunc-rdup ) )
( ( ?h 1 calcFunc-tail )
( ?s 3 calcFunc-rsubvec )
( ?G 1 calcFunc-rgrade )
( ?R 1 calcFunc-rreduce )
( ?S 1 calcFunc-rsort )
( ?U 1 calcFunc-raccum ) )
( ( ?e 3 calcFunc-vexp )
( ?h 1 calcFunc-rhead )
( ?k 2 calcFunc-rcons )
( ?H 3 calcFunc-histogram )
( ?R 2 calcFunc-nest )
( ?U 2 calcFunc-anest ) )
( ( ?h 1 calcFunc-rtail )
( ?R 1 calcFunc-fixp )
( ?U 1 calcFunc-afixp ) )))
;;; Return a list of the form (nargs func name)
(defun calc-get-operator (msg &optional nargs)
(setq calc-aborted-prefix nil)
@ -441,309 +749,6 @@
(if (> (length name) 3)
(substring name 0 3)
name))))))
(setq calc-verify-arglist t)
(setq calc-mapping-dir nil)
(defconst calc-oper-keys '( ( ( ?+ 2 calcFunc-add )
( ?- 2 calcFunc-sub )
( ?* 2 calcFunc-mul )
( ?/ 2 calcFunc-div )
( ?^ 2 calcFunc-pow )
( ?| 2 calcFunc-vconcat )
( ?% 2 calcFunc-mod )
( ?\\ 2 calcFunc-idiv )
( ?! 1 calcFunc-fact )
( ?& 1 calcFunc-inv )
( ?n 1 calcFunc-neg )
( ?x user )
( ?z user )
( ?A 1 calcFunc-abs )
( ?J 1 calcFunc-conj )
( ?G 1 calcFunc-arg )
( ?Q 1 calcFunc-sqrt )
( ?N 2 calcFunc-min )
( ?X 2 calcFunc-max )
( ?F 1 calcFunc-floor )
( ?R 1 calcFunc-round )
( ?S 1 calcFunc-sin )
( ?C 1 calcFunc-cos )
( ?T 1 calcFunc-tan )
( ?L 1 calcFunc-ln )
( ?E 1 calcFunc-exp )
( ?B 2 calcFunc-log ) )
( ( ?F 1 calcFunc-ceil ) ; inverse
( ?R 1 calcFunc-trunc )
( ?Q 1 calcFunc-sqr )
( ?S 1 calcFunc-arcsin )
( ?C 1 calcFunc-arccos )
( ?T 1 calcFunc-arctan )
( ?L 1 calcFunc-exp )
( ?E 1 calcFunc-ln )
( ?B 2 calcFunc-alog )
( ?^ 2 calcFunc-nroot )
( ?| 2 calcFunc-vconcatrev ) )
( ( ?F 1 calcFunc-ffloor ) ; hyperbolic
( ?R 1 calcFunc-fround )
( ?S 1 calcFunc-sinh )
( ?C 1 calcFunc-cosh )
( ?T 1 calcFunc-tanh )
( ?L 1 calcFunc-log10 )
( ?E 1 calcFunc-exp10 )
( ?| 2 calcFunc-append ) )
( ( ?F 1 calcFunc-fceil ) ; inverse-hyperbolic
( ?R 1 calcFunc-ftrunc )
( ?S 1 calcFunc-arcsinh )
( ?C 1 calcFunc-arccosh )
( ?T 1 calcFunc-arctanh )
( ?L 1 calcFunc-exp10 )
( ?E 1 calcFunc-log10 )
( ?| 2 calcFunc-appendrev ) )
))
(defconst calc-a-oper-keys '( ( ( ?a 3 calcFunc-apart )
( ?b 3 calcFunc-subst )
( ?c 2 calcFunc-collect )
( ?d 2 calcFunc-deriv )
( ?e 1 calcFunc-esimplify )
( ?f 2 calcFunc-factor )
( ?g 2 calcFunc-pgcd )
( ?i 2 calcFunc-integ )
( ?m 2 calcFunc-match )
( ?n 1 calcFunc-nrat )
( ?r 2 calcFunc-rewrite )
( ?s 1 calcFunc-simplify )
( ?t 3 calcFunc-taylor )
( ?x 1 calcFunc-expand )
( ?M 2 calcFunc-mapeq )
( ?N 3 calcFunc-minimize )
( ?P 2 calcFunc-roots )
( ?R 3 calcFunc-root )
( ?S 2 calcFunc-solve )
( ?T 4 calcFunc-table )
( ?X 3 calcFunc-maximize )
( ?= 2 calcFunc-eq )
( ?\# 2 calcFunc-neq )
( ?< 2 calcFunc-lt )
( ?> 2 calcFunc-gt )
( ?\[ 2 calcFunc-leq )
( ?\] 2 calcFunc-geq )
( ?{ 2 calcFunc-in )
( ?! 1 calcFunc-lnot )
( ?& 2 calcFunc-land )
( ?\| 2 calcFunc-lor )
( ?: 3 calcFunc-if )
( ?. 2 calcFunc-rmeq )
( ?+ 4 calcFunc-sum )
( ?- 4 calcFunc-asum )
( ?* 4 calcFunc-prod )
( ?_ 2 calcFunc-subscr )
( ?\\ 2 calcFunc-pdiv )
( ?% 2 calcFunc-prem )
( ?/ 2 calcFunc-pdivrem ) )
( ( ?m 2 calcFunc-matchnot )
( ?M 2 calcFunc-mapeqr )
( ?S 2 calcFunc-finv ) )
( ( ?d 2 calcFunc-tderiv )
( ?f 2 calcFunc-factors )
( ?M 2 calcFunc-mapeqp )
( ?N 3 calcFunc-wminimize )
( ?R 3 calcFunc-wroot )
( ?S 2 calcFunc-fsolve )
( ?X 3 calcFunc-wmaximize )
( ?/ 2 calcFunc-pdivide ) )
( ( ?S 2 calcFunc-ffinv ) )
))
(defconst calc-b-oper-keys '( ( ( ?a 2 calcFunc-and )
( ?o 2 calcFunc-or )
( ?x 2 calcFunc-xor )
( ?d 2 calcFunc-diff )
( ?n 1 calcFunc-not )
( ?c 1 calcFunc-clip )
( ?l 2 calcFunc-lsh )
( ?r 2 calcFunc-rsh )
( ?L 2 calcFunc-ash )
( ?R 2 calcFunc-rash )
( ?t 2 calcFunc-rot )
( ?p 1 calcFunc-vpack )
( ?u 1 calcFunc-vunpack )
( ?D 4 calcFunc-ddb )
( ?F 3 calcFunc-fv )
( ?I 1 calcFunc-irr )
( ?M 3 calcFunc-pmt )
( ?N 2 calcFunc-npv )
( ?P 3 calcFunc-pv )
( ?S 3 calcFunc-sln )
( ?T 3 calcFunc-rate )
( ?Y 4 calcFunc-syd )
( ?\# 3 calcFunc-nper )
( ?\% 2 calcFunc-relch ) )
( ( ?F 3 calcFunc-fvb )
( ?I 1 calcFunc-irrb )
( ?M 3 calcFunc-pmtb )
( ?N 2 calcFunc-npvb )
( ?P 3 calcFunc-pvb )
( ?T 3 calcFunc-rateb )
( ?\# 3 calcFunc-nperb ) )
( ( ?F 3 calcFunc-fvl )
( ?M 3 calcFunc-pmtl )
( ?P 3 calcFunc-pvl )
( ?T 3 calcFunc-ratel )
( ?\# 3 calcFunc-nperl ) )
))
(defconst calc-c-oper-keys '( ( ( ?d 1 calcFunc-deg )
( ?r 1 calcFunc-rad )
( ?h 1 calcFunc-hms )
( ?f 1 calcFunc-float )
( ?F 1 calcFunc-frac ) )
))
(defconst calc-f-oper-keys '( ( ( ?b 2 calcFunc-beta )
( ?e 1 calcFunc-erf )
( ?g 1 calcFunc-gamma )
( ?h 2 calcFunc-hypot )
( ?i 1 calcFunc-im )
( ?j 2 calcFunc-besJ )
( ?n 2 calcFunc-min )
( ?r 1 calcFunc-re )
( ?s 1 calcFunc-sign )
( ?x 2 calcFunc-max )
( ?y 2 calcFunc-besY )
( ?A 1 calcFunc-abssqr )
( ?B 3 calcFunc-betaI )
( ?E 1 calcFunc-expm1 )
( ?G 2 calcFunc-gammaP )
( ?I 2 calcFunc-ilog )
( ?L 1 calcFunc-lnp1 )
( ?M 1 calcFunc-mant )
( ?Q 1 calcFunc-isqrt )
( ?S 1 calcFunc-scf )
( ?T 2 calcFunc-arctan2 )
( ?X 1 calcFunc-xpon )
( ?\[ 2 calcFunc-decr )
( ?\] 2 calcFunc-incr ) )
( ( ?e 1 calcFunc-erfc )
( ?E 1 calcFunc-lnp1 )
( ?G 2 calcFunc-gammaQ )
( ?L 1 calcFunc-expm1 ) )
( ( ?B 3 calcFunc-betaB )
( ?G 2 calcFunc-gammag) )
( ( ?G 2 calcFunc-gammaG ) )
))
(defconst calc-k-oper-keys '( ( ( ?b 1 calcFunc-bern )
( ?c 2 calcFunc-choose )
( ?d 1 calcFunc-dfact )
( ?e 1 calcFunc-euler )
( ?f 1 calcFunc-prfac )
( ?g 2 calcFunc-gcd )
( ?h 2 calcFunc-shuffle )
( ?l 2 calcFunc-lcm )
( ?m 1 calcFunc-moebius )
( ?n 1 calcFunc-nextprime )
( ?r 1 calcFunc-random )
( ?s 2 calcFunc-stir1 )
( ?t 1 calcFunc-totient )
( ?B 3 calcFunc-utpb )
( ?C 2 calcFunc-utpc )
( ?F 3 calcFunc-utpf )
( ?N 3 calcFunc-utpn )
( ?P 2 calcFunc-utpp )
( ?T 2 calcFunc-utpt ) )
( ( ?n 1 calcFunc-prevprime )
( ?B 3 calcFunc-ltpb )
( ?C 2 calcFunc-ltpc )
( ?F 3 calcFunc-ltpf )
( ?N 3 calcFunc-ltpn )
( ?P 2 calcFunc-ltpp )
( ?T 2 calcFunc-ltpt ) )
( ( ?b 2 calcFunc-bern )
( ?c 2 calcFunc-perm )
( ?e 2 calcFunc-euler )
( ?s 2 calcFunc-stir2 ) )
))
(defconst calc-s-oper-keys '( ( ( ?: 2 calcFunc-assign )
( ?= 1 calcFunc-evalto ) )
))
(defconst calc-t-oper-keys '( ( ( ?C 3 calcFunc-tzconv )
( ?D 1 calcFunc-date )
( ?I 2 calcFunc-incmonth )
( ?J 1 calcFunc-julian )
( ?M 1 calcFunc-newmonth )
( ?W 1 calcFunc-newweek )
( ?U 1 calcFunc-unixtime )
( ?Y 1 calcFunc-newyear ) )
))
(defconst calc-u-oper-keys '( ( ( ?C 2 calcFunc-vcov )
( ?G 1 calcFunc-vgmean )
( ?M 1 calcFunc-vmean )
( ?N 1 calcFunc-vmin )
( ?S 1 calcFunc-vsdev )
( ?X 1 calcFunc-vmax ) )
( ( ?C 2 calcFunc-vpcov )
( ?M 1 calcFunc-vmeane )
( ?S 1 calcFunc-vpsdev ) )
( ( ?C 2 calcFunc-vcorr )
( ?G 1 calcFunc-agmean )
( ?M 1 calcFunc-vmedian )
( ?S 1 calcFunc-vvar ) )
( ( ?M 1 calcFunc-vhmean )
( ?S 1 calcFunc-vpvar ) )
))
(defconst calc-v-oper-keys '( ( ( ?a 2 calcFunc-arrange )
( ?b 2 calcFunc-cvec )
( ?c 2 calcFunc-mcol )
( ?d 2 calcFunc-diag )
( ?e 2 calcFunc-vexp )
( ?f 2 calcFunc-find )
( ?h 1 calcFunc-head )
( ?k 2 calcFunc-cons )
( ?l 1 calcFunc-vlen )
( ?m 2 calcFunc-vmask )
( ?n 1 calcFunc-rnorm )
( ?p 2 calcFunc-pack )
( ?r 2 calcFunc-mrow )
( ?s 3 calcFunc-subvec )
( ?t 1 calcFunc-trn )
( ?u 1 calcFunc-unpack )
( ?v 1 calcFunc-rev )
( ?x 1 calcFunc-index )
( ?A 1 calcFunc-apply )
( ?C 1 calcFunc-cross )
( ?D 1 calcFunc-det )
( ?E 1 calcFunc-venum )
( ?F 1 calcFunc-vfloor )
( ?G 1 calcFunc-grade )
( ?H 2 calcFunc-histogram )
( ?I 2 calcFunc-inner )
( ?L 1 calcFunc-lud )
( ?M 0 calcFunc-map )
( ?N 1 calcFunc-cnorm )
( ?O 2 calcFunc-outer )
( ?R 1 calcFunc-reduce )
( ?S 1 calcFunc-sort )
( ?T 1 calcFunc-tr )
( ?U 1 calcFunc-accum )
( ?V 2 calcFunc-vunion )
( ?X 2 calcFunc-vxor )
( ?- 2 calcFunc-vdiff )
( ?^ 2 calcFunc-vint )
( ?~ 1 calcFunc-vcompl )
( ?# 1 calcFunc-vcard )
( ?: 1 calcFunc-vspan )
( ?+ 1 calcFunc-rdup ) )
( ( ?h 1 calcFunc-tail )
( ?s 3 calcFunc-rsubvec )
( ?G 1 calcFunc-rgrade )
( ?R 1 calcFunc-rreduce )
( ?S 1 calcFunc-rsort )
( ?U 1 calcFunc-raccum ) )
( ( ?e 3 calcFunc-vexp )
( ?h 1 calcFunc-rhead )
( ?k 2 calcFunc-rcons )
( ?H 3 calcFunc-histogram )
( ?R 2 calcFunc-nest )
( ?U 2 calcFunc-anest ) )
( ( ?h 1 calcFunc-rtail )
( ?R 1 calcFunc-fixp )
( ?U 1 calcFunc-afixp ) )
))
;;; Convert a variable name (as a formula) into a like-looking function name.

19
lisp/calc/calc-math.el
View File

@ -1,6 +1,9 @@
;; Calculator for GNU Emacs, part II [calc-math.el]
;;; calc-math.el --- mathematical functions for Calc
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Written by Dave Gillespie, daveg@synaptics.com.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.
@ -19,7 +22,9 @@
;; file named COPYING. Among other things, the copyright notice
;; and this notice must be preserved on all copies.
;;; Commentary:
;;; Code:
;; This file is autoloaded from calc-ext.el.
(require 'calc-ext)
@ -236,7 +241,7 @@
(cond ((= arg 1)
(calc-wrapper
(calc-change-mode 'calc-angle-mode 'deg)
(message "Angles measured in degrees.")))
(message "Angles measured in degrees")))
((= arg 2) (calc-radians-mode))
((= arg 3) (calc-hms-mode))
(t (error "Prefix argument out of range"))))
@ -245,7 +250,7 @@
(interactive)
(calc-wrapper
(calc-change-mode 'calc-angle-mode 'rad)
(message "Angles measured in radians.")))
(message "Angles measured in radians")))
;;; Compute the integer square-root floor(sqrt(A)). A > 0. [I I] [Public]
@ -412,7 +417,7 @@
(progn
(calc-record-why 'numberp a)
(list 'calcFunc-sqrt a))))
(defalias calcFunc-sqrt 'math-sqrt)
(defalias 'calcFunc-sqrt 'math-sqrt)
(defun math-infinite-dir (a &optional inf)
(or inf (setq inf (math-infinitep a)))
@ -532,7 +537,7 @@
((eq (car-safe b) 'hms)
(math-to-hms (math-hypot a (math-from-hms b 'deg))))
(t nil)))
(defalias calcFunc-hypot 'math-hypot)
(defalias 'calcFunc-hypot 'math-hypot)
(defun calcFunc-sqr (x)
(math-pow x 2))
@ -1324,13 +1329,13 @@
(cons (equal pow x) sum)))
(defvar math-log-base-cache nil)
(defun math-log-base-raw (b) ; [N N]
(if (not (and (equal (car math-log-base-cache) b)
(eq (nth 1 math-log-base-cache) calc-internal-prec)))
(setq math-log-base-cache (list b calc-internal-prec
(math-ln-raw (math-float b)))))
(nth 2 math-log-base-cache))
(setq math-log-base-cache nil)
(defun calcFunc-lnp1 (x) ; [N N] [Public]
(cond ((Math-equal-int x -1)

12
lisp/calc/calc-mtx.el
View File

@ -1,6 +1,9 @@
;; Calculator for GNU Emacs, part II [calc-mat.el]
;;; calc-mtx.el --- matrix functions for Calc
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Written by Dave Gillespie, daveg@synaptics.com.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.
@ -19,6 +22,9 @@
;; file named COPYING. Among other things, the copyright notice
;; and this notice must be preserved on all copies.
;;; Commentary:
;;; Code:
;; This file is autoloaded from calc-ext.el.
@ -215,6 +221,7 @@
;;; This returns a list (LU index d), or NIL if not possible.
;;; Argument M must be a square matrix.
(defvar math-lud-cache nil)
(defun math-matrix-lud (m)
(let ((old (assoc m math-lud-cache))
(context (list calc-internal-prec calc-prefer-frac)))
@ -226,7 +233,6 @@
(setcdr old entry)
(setq math-lud-cache (cons (cons m entry) math-lud-cache)))
lud))))
(defvar math-lud-cache nil)
;;; Numerical Recipes section 2.3; implicit pivoting omitted.
(defun math-do-matrix-lud (m)

13
lisp/calc/calc-poly.el
View File

@ -1,6 +1,9 @@
;; Calculator for GNU Emacs, part II [calc-poly.el]
;;; calc-poly.el --- polynomial functions for Calc
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Written by Dave Gillespie, daveg@synaptics.com.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.
@ -19,7 +22,9 @@
;; file named COPYING. Among other things, the copyright notice
;; and this notice must be preserved on all copies.
;;; Commentary:
;;; Code:
;; This file is autoloaded from calc-ext.el.
(require 'calc-ext)
@ -133,7 +138,7 @@
;;; Originally by Ove Ewerlid (ewerlid@mizar.DoCS.UU.SE).
;;; Modifications and simplifications by daveg.
(setq math-poly-modulus 1)
(defvar math-poly-modulus 1)
;;; Return gcd of two polynomials
(defun calcFunc-pgcd (pn pd)
@ -233,11 +238,11 @@
;;; Divide two polynomials. Return (quotient . remainder).
(defvar math-poly-div-base nil)
(defun math-poly-div (u v &optional math-poly-div-base)
(if math-poly-div-base
(math-do-poly-div u v)
(math-do-poly-div (calcFunc-expand u) (calcFunc-expand v))))
(setq math-poly-div-base nil)
(defun math-poly-div-exact (u v &optional base)
(let ((res (math-poly-div u v base)))

31
lisp/calc/calc-prog.el
View File

@ -1,6 +1,9 @@
;; Calculator for GNU Emacs, part II [calc-prog.el]
;;; calc-prog.el --- user programmability functions for Calc
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Written by Dave Gillespie, daveg@synaptics.com.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.
@ -19,6 +22,9 @@
;; file named COPYING. Among other things, the copyright notice
;; and this notice must be preserved on all copies.
;;; Commentary:
;;; Code:
;; This file is autoloaded from calc-ext.el.
@ -102,8 +108,8 @@
(calc-wrapper
(calc-change-mode 'calc-timing n nil t)
(message (if calc-timing
"Reporting timing of slow commands in Trail."
"Not reporting timing of commands."))))
"Reporting timing of slow commands in Trail"
"Not reporting timing of commands"))))
(defun calc-pass-errors ()
(interactive)
@ -116,7 +122,7 @@
(or (memq (car (car place)) '(error xxxerror))
(error "foo"))
(setcar (car place) 'xxxerror))
(error (error "The calc-do function has been modified; unable to patch."))))
(error (error "The calc-do function has been modified; unable to patch"))))
(defun calc-user-define ()
(interactive)
@ -1106,7 +1112,7 @@
(calc-pop-stack 1)
(if (math-is-true cond)
(if defining-kbd-macro
(message "If true..."))
(message "If true.."))
(if defining-kbd-macro
(message "Condition is false; skipping to Z: or Z] ..."))
(calc-kbd-skip-to-else-if t)))))
@ -1218,7 +1224,7 @@
(null parts)
(null counter)
(progn
(message "Warning: Infinite loop! Not executing.")
(message "Warning: Infinite loop! Not executing")
(setq rpt-count 0)))
(or (not initial) dir
(setq dir (math-compare final initial)))
@ -1266,9 +1272,10 @@
(let ((cond (calc-top-n 1)))
(calc-pop-stack 1)
(if (math-is-true cond)
(error "Keyboard macro aborted.")))))
(error "Keyboard macro aborted")))))
(defvar calc-kbd-push-level 0)
(defun calc-kbd-push (arg)
(interactive "P")
(calc-wrapper
@ -1324,7 +1331,6 @@
(let ((calc-kbd-push-level (1+ calc-kbd-push-level)))
(message "Saving modes; type Z' to restore")
(recursive-edit))))))
(setq calc-kbd-push-level 0)
(defun calc-kbd-pop ()
(interactive)
@ -1673,7 +1679,6 @@
;;;; User-programmability.
;;; Compiling Lisp-like forms to use the math library.
@ -2118,7 +2123,7 @@
(if (math-body-refers-to body 'math-break)
(cons 'catch (cons '(quote math-break) (list body)))
body)))
;; (put 'math-while 'lisp-indent-hook 1)
(defmacro math-for (head &rest body)
(let ((body (if head
@ -2127,6 +2132,7 @@
(if (math-body-refers-to body 'math-break)
(cons 'catch (cons '(quote math-break) (list body)))
body)))
;; (put 'math-for 'lisp-indent-hook 1)
(defun math-handle-for (head body)
(let* ((var (nth 0 (car head)))
@ -2184,13 +2190,12 @@
var
save-step)))))))))))
(defmacro math-foreach (head &rest body)
(let ((body (math-handle-foreach head body)))
(if (math-body-refers-to body 'math-break)
(cons 'catch (cons '(quote math-break) (list body)))
body)))
;; (put 'math-foreach 'lisp-indent-hook 1)
(defun math-handle-foreach (head body)
(let ((var (nth 0 (car head)))

22
lisp/calc/calc-rewr.el
View File

@ -1,6 +1,9 @@
;; Calculator for GNU Emacs, part II [calc-rewr.el]
;;; calc-rewr.el --- rewriting functions for Calc
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Written by Dave Gillespie, daveg@synaptics.com.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.
@ -19,7 +22,9 @@
;; file named COPYING. Among other things, the copyright notice
;; and this notice must be preserved on all copies.
;;; Commentary:
;;; Code:
;; This file is autoloaded from calc-ext.el.
(require 'calc-ext)
@ -29,6 +34,7 @@
(defun calc-Need-calc-rewr () nil)
(defvar math-rewrite-default-iters 100)
(defun calc-rewrite-selection (rules-str &optional many prefix)
(interactive "sRewrite rule(s): \np")
(calc-slow-wrapper
@ -43,7 +49,7 @@
(math-rewrite-default-iters 1))
(if (or (null rules-str) (equal rules-str "") (equal rules-str "$"))
(if (= num 1)
(error "Can't use same stack entry for formula and rules.")
(error "Can't use same stack entry for formula and rules")
(setq rules (calc-top-n 1 t)
pop-rules t))
(setq rules (if (stringp rules-str)
@ -203,7 +209,6 @@
(if (= mmt-many 0) " (reached iteration limit)" "")
":\n" fmt "\n"))))
whole-expr))
(setq math-rewrite-default-iters 100)
(defun math-rewrite-phase (sched)
(while (and sched (/= mmt-many 0))
@ -479,9 +484,9 @@
(if (eq (car-safe pats) 'vec)
(cdr pats)
(list pats)))))))))
(setq math-rewrite-whole nil)
(setq math-make-import-list nil)
(defvar math-rewrite-whole nil)
(defvar math-make-import-list nil)
(defun math-compile-rewrites (rules &optional name)
(if (eq (car-safe rules) 'var)
(let ((prop (get (nth 2 rules) 'math-rewrite-cache))
@ -805,10 +810,11 @@
(cons (car expr)
(mapcar 'math-rwcomp-subst-rec (cdr expr)))))))
(setq math-rwcomp-tracing nil)
(defvar math-rwcomp-tracing nil)
(defun math-rwcomp-trace (instr)
(if math-rwcomp-tracing (progn (terpri) (princ instr)))
(when math-rwcomp-tracing
(terpri) (princ instr))
instr)
(defun math-rwcomp-instr (&rest instr)

9
lisp/calc/calc-rules.el
View File

@ -1,6 +1,9 @@
;; Calculator for GNU Emacs, part II [calc-rules.el]
;;; calc-rules.el ---
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Written by Dave Gillespie, daveg@synaptics.com.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.
@ -19,7 +22,9 @@
;; file named COPYING. Among other things, the copyright notice
;; and this notice must be preserved on all copies.
;;; Commentary:
;;; Code:
;; This file is autoloaded from calc-ext.el.
(require 'calc-ext)

14
lisp/calc/calc-sel.el
View File

@ -1,6 +1,9 @@
;; Calculator for GNU Emacs, part II [calc-sel.el]
;;; calc-sel.el --- data selection functions for Calc
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Written by Dave Gillespie, daveg@synaptics.com.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.
@ -19,7 +22,9 @@
;; file named COPYING. Among other things, the copyright notice
;; and this notice must be preserved on all copies.
;;; Commentary:
;;; Code:
;; This file is autoloaded from calc-ext.el.
(require 'calc-ext)
@ -31,6 +36,8 @@
;;; Selection commands.
(defvar calc-keep-selection t)
(defun calc-select-here (num &optional once keep)
(interactive "P")
(calc-wrapper
@ -349,6 +356,7 @@
"Selection treats a+b+c as a sum of three terms"
"Selection treats a+b+c as (a+b)+c"))))
(defvar calc-selection-cache-entry nil)
(defun calc-prepare-selection (&optional num)
(or num (setq num (calc-locate-cursor-element (point))))
(setq calc-selection-true-num num
@ -371,7 +379,6 @@
(length calc-left-label)
(if calc-line-numbering 4 0))))))
(calc-preserve-point))
(setq calc-selection-cache-entry nil)
;;; The following ensures that no two subformulas will be "eq" to each other!
(defun calc-encase-atoms (x)
@ -508,7 +515,6 @@
(t (calc-sel-error))))
(calc-pop-stack n m t)
(calc-push-list vals m)))
(setq calc-keep-selection t)
(defun calc-delete-selection (n)
(let ((entry (calc-top n 'entry)))

9
lisp/calc/calc-stat.el
View File

@ -1,6 +1,9 @@
;; Calculator for GNU Emacs, part II [calc-stat.el]
;;; calc-stat.el --- statistical functions for Calc
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Written by Dave Gillespie, daveg@synaptics.com.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.
@ -19,7 +22,9 @@
;; file named COPYING. Among other things, the copyright notice
;; and this notice must be preserved on all copies.
;;; Commentary:
;;; Code:
;; This file is autoloaded from calc-ext.el.
(require 'calc-ext)

39
lisp/calc/calc-store.el
View File

@ -1,6 +1,9 @@
;; Calculator for GNU Emacs, part II [calc-store.el]
;;; calc-store.el --- value storage functions for Calc
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Written by Dave Gillespie, daveg@synaptics.com.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.
@ -19,7 +22,9 @@
;; file named COPYING. Among other things, the copyright notice
;; and this notice must be preserved on all copies.
;;; Commentary:
;;; Code:
;; This file is autoloaded from calc-ext.el.
(require 'calc-ext)
@ -31,12 +36,13 @@
;;; Memory commands.
(defvar calc-store-keep nil)
(defun calc-store (&optional var)
(interactive)
(let ((calc-store-keep t))
(calc-store-into var)))
(setq calc-store-keep nil)
(defvar calc-given-value-flag nil)
(defun calc-store-into (&optional var)
(interactive)
(calc-wrapper
@ -170,7 +176,6 @@
(setq calc-given-value (math-evaluate-expr calc-given-value))
svar))
(intern var)))))
(setq calc-given-value-flag nil)
(defvar calc-var-name-map nil "Keymap for reading Calc variable names.")
(if calc-var-name-map
@ -369,6 +374,7 @@
(if var2
(calc-store-value var2 value ""))))))
(defvar calc-last-edited-variable nil)
(defun calc-edit-variable (&optional var)
(interactive)
(calc-wrapper
@ -389,7 +395,6 @@
(and value
(insert (math-format-nice-expr value (frame-width)) "\n")))))
(calc-show-edit-buffer))
(setq calc-last-edited-variable nil)
(defun calc-edit-Decls ()
(interactive)
@ -513,6 +518,17 @@
decl)))))))
(calc-refresh-evaltos 'var-Decls))))
(defvar calc-dont-insert-variables '(var-FitRules var-FactorRules
var-CommuteRules var-JumpRules
var-DistribRules var-MergeRules
var-NegateRules var-InvertRules
var-IntegAfterRules
var-TimeZone var-PlotRejects
var-PlotData1 var-PlotData2
var-PlotData3 var-PlotData4
var-PlotData5 var-PlotData6
var-DUMMY))
(defun calc-permanent-variable (&optional var)
(interactive)
(calc-wrapper
@ -532,17 +548,8 @@
(not (eq (car-safe (symbol-value x)) 'special-const))
(calc-insert-permanent-variable x))))))
(save-buffer))))
(defvar calc-dont-insert-variables '(var-FitRules var-FactorRules
var-CommuteRules var-JumpRules
var-DistribRules var-MergeRules
var-NegateRules var-InvertRules
var-IntegAfterRules
var-TimeZone var-PlotRejects
var-PlotData1 var-PlotData2
var-PlotData3 var-PlotData4
var-PlotData5 var-PlotData6
var-DUMMY
))
(defun calc-insert-permanent-variable (var)
(goto-char (point-min))

19
lisp/calc/calc-stuff.el
View File

@ -1,6 +1,9 @@
;; Calculator for GNU Emacs, part II [calc-stuff.el]
;;; calc-stuff.el --- miscellaneous functions for Calc
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Written by Dave Gillespie, daveg@synaptics.com.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.
@ -19,7 +22,9 @@
;; file named COPYING. Among other things, the copyright notice
;; and this notice must be preserved on all copies.
;;; Commentary:
;;; Code:
;; This file is autoloaded from calc-ext.el.
(require 'calc-ext)
@ -68,6 +73,8 @@ With a prefix, push that prefix as a number onto the stack."
(message "max-lisp-eval-depth is now %d" max-lisp-eval-depth))
(defvar calc-which-why nil)
(defvar calc-last-why-command nil)
(defun calc-explain-why (why &optional more)
(if (eq (car why) '*)
(setq why (cdr why)))
@ -151,13 +158,11 @@ With a prefix, push that prefix as a number onto the stack."
(message "(No further explanations available)")
(setq calc-which-why calc-why))
(message "No explanations available"))))
(setq calc-which-why nil)
(setq calc-last-why-command nil)
(defun calc-version ()
(interactive)
(message "Calc %s, installed %s" calc-version calc-installed-date))
(message "Calc %s" calc-version))
(defun calc-flush-caches ()
@ -179,7 +184,7 @@ With a prefix, push that prefix as a number onto the stack."
math-format-date-cache nil
math-holidays-cache-tag t)
(mapcar (function (lambda (x) (set x -100))) math-cache-list)
(message "All internal calculator caches have been reset.")))
(message "All internal calculator caches have been reset")))
;;; Conversions.
@ -209,6 +214,7 @@ With a prefix, push that prefix as a number onto the stack."
(error "Number required"))))))
(defvar math-chopping-small nil)
(defun calcFunc-clean (a &optional prec) ; [X X S] [Public]
(if prec
(cond ((Math-messy-integerp prec)
@ -250,7 +256,6 @@ With a prefix, push that prefix as a number onto the stack."
((Math-objectp a) a)
((math-infinitep a) a)
(t (list 'calcFunc-clean a)))))
(setq math-chopping-small nil)
(defun calcFunc-pclean (a &optional prec)
(math-map-over-constants (function (lambda (x) (calcFunc-clean x prec)))

9
lisp/calc/calc-trail.el
View File

@ -1,6 +1,9 @@
;; Calculator for GNU Emacs, part II [calc-trail.el]
;;; calc-trail.el --- functions for manipulating the Calc "trail"
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Written by Dave Gillespie, daveg@synaptics.com.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.
@ -19,7 +22,9 @@
;; file named COPYING. Among other things, the copyright notice
;; and this notice must be preserved on all copies.
;;; Commentary:
;;; Code:
;; This file is autoloaded from calc-ext.el.
(require 'calc-ext)

81
lisp/calc/calc-undo.el
View File

@ -1,6 +1,9 @@
;; Calculator for GNU Emacs, part II [calc-undo.el]
;;; calc-undo.el --- undo functions for Calc
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Written by Dave Gillespie, daveg@synaptics.com.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.
@ -19,7 +22,9 @@
;; file named COPYING. Among other things, the copyright notice
;; and this notice must be preserved on all copies.
;;; Commentary:
;;; Code:
;; This file is autoloaded from calc-ext.el.
(require 'calc-ext)
@ -33,15 +38,15 @@
(defun calc-undo (n)
(interactive "p")
(and calc-executing-macro
(error "Use C-x e, not X, to run a keyboard macro that uses Undo."))
(when calc-executing-macro
(error "Use C-x e, not X, to run a keyboard macro that uses Undo"))
(if (<= n 0)
(if (< n 0)
(calc-redo (- n))
(calc-last-args 1))
(calc-wrapper
(if (null (nthcdr (1- n) calc-undo-list))
(error "No further undo information available"))
(when (null (nthcdr (1- n) calc-undo-list))
(error "No further undo information available"))
(setq calc-undo-list
(prog1
(nthcdr n calc-undo-list)
@ -52,16 +57,15 @@
(message "Undo!"))))
(defun calc-handle-undos (cl n)
(if (> n 0)
(progn
(let ((old-redo calc-redo-list))
(setq calc-undo-list nil)
(calc-handle-undo (car cl))
(setq calc-redo-list (append calc-undo-list old-redo)))
(calc-handle-undos (cdr cl) (1- n)))))
(when (> n 0)
(let ((old-redo calc-redo-list))
(setq calc-undo-list nil)
(calc-handle-undo (car cl))
(setq calc-redo-list (append calc-undo-list old-redo)))
(calc-handle-undos (cdr cl) (1- n))))
(defun calc-handle-undo (list)
(and list
(when list
(let ((action (car list)))
(cond
((eq (car action) 'push)
@ -90,13 +94,13 @@
(defun calc-redo (n)
(interactive "p")
(and calc-executing-macro
(error "Use C-x e, not X, to run a keyboard macro that uses Redo."))
(when calc-executing-macro
(error "Use C-x e, not X, to run a keyboard macro that uses Redo"))
(if (<= n 0)
(calc-undo (- n))
(calc-wrapper
(if (null (nthcdr (1- n) calc-redo-list))
(error "Unable to redo"))
(when (null (nthcdr (1- n) calc-redo-list))
(error "Unable to redo"))
(setq calc-redo-list
(prog1
(nthcdr n calc-redo-list)
@ -107,18 +111,17 @@
(message "Redo!"))))
(defun calc-handle-redos (cl n)
(if (> n 0)
(progn
(let ((old-undo calc-undo-list))
(setq calc-undo-list nil)
(calc-handle-undo (car cl))
(setq calc-undo-list (append calc-undo-list old-undo)))
(calc-handle-redos (cdr cl) (1- n)))))
(when (> n 0)
(let ((old-undo calc-undo-list))
(setq calc-undo-list nil)
(calc-handle-undo (car cl))
(setq calc-undo-list (append calc-undo-list old-undo)))
(calc-handle-redos (cdr cl) (1- n))))
(defun calc-last-args (n)
(interactive "p")
(and calc-executing-macro
(error "Use C-x e, not X, to run a keyboard macro that uses last-args."))
(when calc-executing-macro
(error "Use C-x e, not X, to run a keyboard macro that uses last-args"))
(calc-wrapper
(let ((urec (calc-find-last-x calc-undo-list n)))
(if urec
@ -126,20 +129,20 @@
(error "Not enough undo information available")))))
(defun calc-handle-last-x (list)
(and list
(let ((action (car list)))
(if (eq (car action) 'pop)
(calc-pop-push-record-list 0 "larg"
(delq 'top-of-stack (nth 2 action))))
(calc-handle-last-x (cdr list)))))
(when list
(let ((action (car list)))
(if (eq (car action) 'pop)
(calc-pop-push-record-list 0 "larg"
(delq 'top-of-stack (nth 2 action))))
(calc-handle-last-x (cdr list)))))
(defun calc-find-last-x (ul n)
(and ul
(if (calc-undo-does-pushes (car ul))
(if (<= n 1)
(car ul)
(calc-find-last-x (cdr ul) (1- n)))
(calc-find-last-x (cdr ul) n))))
(when ul
(if (calc-undo-does-pushes (car ul))
(if (<= n 1)
(car ul)
(calc-find-last-x (cdr ul) (1- n)))
(calc-find-last-x (cdr ul) n))))
(defun calc-undo-does-pushes (list)
(and list

15
lisp/calc/calc-vec.el
View File

@ -1,6 +1,9 @@
;; Calculator for GNU Emacs, part II [calc-vec.el]
;;; calc-vec.el --- vector functions for Calc
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Written by Dave Gillespie, daveg@synaptics.com.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.
@ -19,7 +22,9 @@
;; file named COPYING. Among other things, the copyright notice
;; and this notice must be preserved on all copies.
;;; Commentary:
;;; Code:
;; This file is autoloaded from calc-ext.el.
(require 'calc-ext)
@ -33,8 +38,8 @@
(interactive "P")
(calc-wrapper
(message (if (calc-change-mode 'calc-display-strings n t t)
"Displaying vectors of integers as quoted strings."
"Displaying vectors of integers normally."))))
"Displaying vectors of integers as quoted strings"
"Displaying vectors of integers normally"))))
(defun calc-pack (n)
@ -204,6 +209,7 @@
(t
(error "Invalid packing mode: %d" mode))))
(defvar calc-unpack-with-type nil)
(defun calc-unpack (mode)
(interactive "P")
(calc-wrapper
@ -328,7 +334,6 @@
(error "Expected a floating-point number")))
(t
(error "Invalid unpacking mode: %d" mode))))
(setq calc-unpack-with-type nil)
(defun calc-diag (n)
(interactive "P")

93
lisp/calc/calc-yank.el
View File

@ -1,6 +1,9 @@
;; Calculator for GNU Emacs, part II [calc-yank.el]
;;; calc-yank.el --- kill-ring functionality for Calc
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Written by Dave Gillespie, daveg@synaptics.com.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.
@ -19,7 +22,9 @@
;; file named COPYING. Among other things, the copyright notice
;; and this notice must be preserved on all copies.
;;; Commentary:
;;; Code:
;; This file is autoloaded from calc-ext.el.
(require 'calc-ext)
@ -140,8 +145,8 @@
(defun calc-do-grab-region (top bot arg)
(and (memq major-mode '(calc-mode calc-trail-mode))
(error "This command works only in a regular text buffer."))
(when (memq major-mode '(calc-mode calc-trail-mode))
(error "This command works only in a regular text buffer"))
(let* ((from-buffer (current-buffer))
(calc-was-started (get-buffer-window "*Calculator*"))
(single nil)
@ -187,7 +192,7 @@
(defun calc-do-grab-rectangle (top bot arg &optional reduce)
(and (memq major-mode '(calc-mode calc-trail-mode))
(error "This command works only in a regular text buffer."))
(error "This command works only in a regular text buffer"))
(let* ((col1 (save-excursion (goto-char top) (current-column)))
(col2 (save-excursion (goto-char bot) (current-column)))
(from-buffer (current-buffer))
@ -195,8 +200,8 @@
data mat vals lnum pt pos)
(if (= col1 col2)
(save-excursion
(or (= col1 0)
(error "Point and mark must be at beginning of line, or define a rectangle"))
(unless (= col1 0)
(error "Point and mark must be at beginning of line, or define a rectangle"))
(goto-char top)
(while (< (point) bot)
(setq pt (point))
@ -207,8 +212,8 @@
(calc)
(setq mat (list 'vec)
lnum 0)
(and arg
(setq arg (if (consp arg) 0 (prefix-numeric-value arg))))
(when arg
(setq arg (if (consp arg) 0 (prefix-numeric-value arg))))
(while data
(if (natnump arg)
(progn
@ -243,8 +248,8 @@
vals (math-read-expr (concat "[" s "]")))
(if (eq (car-safe vals) 'error)
(let ((v2 (math-read-expr s)))
(or (eq (car-safe v2) 'error)
(setq vals (list 'vec v2)))))))))
(unless (eq (car-safe v2) 'error)
(setq vals (list 'vec v2)))))))))
(if (eq (car-safe vals) 'error)
(progn
(if calc-was-started
@ -255,8 +260,8 @@
(forward-line lnum)
(forward-char (+ (nth 1 vals) (min col1 col2) pos))
(error (nth 2 vals))))
(or (equal vals '(vec))
(setq mat (cons vals mat)))
(unless (equal vals '(vec))
(setq mat (cons vals mat)))
(setq data (cdr data)
lnum (1+ lnum)))
(calc-slow-wrapper
@ -334,22 +339,23 @@
(delete-char 4)
(setq n (1+ n)))
(forward-line n))))
(if thebuf (setq movept (point)))
(if (get-buffer-window (current-buffer))
(set-window-point (get-buffer-window (current-buffer))
(point)))))))
(if movept (goto-char movept))
(and (consp nn)
(not thebuf)
(progn
(calc-quit t)
(switch-to-buffer newbuf)))))
(when thebuf
(setq movept (point)))
(when (get-buffer-window (current-buffer))
(set-window-point (get-buffer-window (current-buffer))
(point)))))))
(when movept
(goto-char movept))
(when (and (consp nn)
(not thebuf))
(calc-quit t)
(switch-to-buffer newbuf))))
(defun calc-overwrite-string (str eat-lnums)
(if (string-match "\n\\'" str)
(setq str (substring str 0 -1)))
(if eat-lnums
(setq str (substring str 4)))
(when (string-match "\n\\'" str)
(setq str (substring str 0 -1)))
(when eat-lnums
(setq str (substring str 4)))
(if (and (string-match "\\`[-+]?[0-9.]+\\(e-?[0-9]+\\)?\\'" str)
(looking-at "[-+]?[0-9.]+\\(e-?[0-9]+\\)?"))
(progn
@ -385,8 +391,8 @@
(defun calc-edit (n)
(interactive "p")
(calc-slow-wrapper
(if (eq n 0)
(setq n (calc-stack-size)))
(when (eq n 0)
(setq n (calc-stack-size)))
(let* ((flag nil)
(allow-ret (> n 1))
(list (math-showing-full-precision
@ -425,8 +431,8 @@
"Calculator editing mode. Press RET, LFD, or C-c C-c to finish.
To cancel the edit, simply kill the *Calc Edit* buffer."
(interactive)
(or handler
(error "This command can be used only indirectly through calc-edit."))
(unless handler
(error "This command can be used only indirectly through calc-edit"))
(let ((oldbuf (current-buffer))
(buf (get-buffer-create "*Calc Edit*")))
(set-buffer buf)
@ -495,21 +501,21 @@ To cancel the edit, simply kill the *Calc Edit* buffer."
(boundp 'calc-edit-handler)
(boundp 'calc-restore-trail)
(eq major-mode 'calc-edit-mode))
(error "This command is valid only in buffers created by calc-edit."))
(error "This command is valid only in buffers created by calc-edit"))
(let ((buf (current-buffer))
(original calc-original-buffer)
(return calc-return-buffer)
(one-window calc-one-window)
(disp-trail calc-restore-trail))
(save-excursion
(if (or (null (buffer-name original))
(progn
(set-buffer original)
(not (eq major-mode 'calc-mode))))
(error "Original calculator buffer has been corrupted.")))
(when (or (null (buffer-name original))
(progn
(set-buffer original)
(not (eq major-mode 'calc-mode))))
(error "Original calculator buffer has been corrupted")))
(goto-char (point-min))
(if (looking-at "Calc Edit\\|Editing ")
(forward-line 1))
(when (looking-at "Calc Edit\\|Editing ")
(forward-line 1))
(if (buffer-modified-p)
(eval calc-edit-handler))
(if one-window
@ -545,11 +551,10 @@ To cancel the edit, simply kill the *Calc Edit* buffer."
(math-expr-opers math-standard-opers))
(and (string-match "[^\n\t ]" str)
(math-read-exprs str)))))
(if (eq (car-safe vals) 'error)
(progn
(switch-to-buffer buf)
(goto-char (+ start (nth 1 vals)))
(error (nth 2 vals))))
(when (eq (car-safe vals) 'error)
(switch-to-buffer buf)
(goto-char (+ start (nth 1 vals)))
(error (nth 2 vals)))
(calc-wrapper
(if (symbolp num)
(progn

46
lisp/calc/calcalg2.el
View File

@ -1,6 +1,9 @@
;; Calculator for GNU Emacs, part II [calc-alg-2.el]
;;; calcalg2.el --- more algebraic functions for Calc
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Written by Dave Gillespie, daveg@synaptics.com.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.
@ -19,7 +22,9 @@
;; file named COPYING. Among other things, the copyright notice
;; and this notice must be preserved on all copies.
;;; Commentary:
;;; Code:
;; This file is autoloaded from calc-ext.el.
(require 'calc-ext)
@ -32,7 +37,8 @@
(defun calc-derivative (var num)
(interactive "sDifferentiate with respect to: \np")
(calc-slow-wrapper
(and (< num 0) (error "Order of derivative must be positive"))
(when (< num 0)
(error "Order of derivative must be positive"))
(let ((func (if (calc-is-hyperbolic) 'calcFunc-tderiv 'calcFunc-deriv))
n expr)
(if (or (equal var "") (equal var "$"))
@ -40,8 +46,8 @@
expr (calc-top-n 2)
var (calc-top-n 1))
(setq var (math-read-expr var))
(if (eq (car-safe var) 'error)
(error "Bad format in expression: %s" (nth 1 var)))
(when (eq (car-safe var) 'error)
(error "Bad format in expression: %s" (nth 1 var)))
(setq n 1
expr (calc-top-n 1)))
(while (>= (setq num (1- num)) 0)
@ -592,14 +598,11 @@
(math-derivative (nth 2 expr)))))))
(setq math-integ-var '(var X ---))
(setq math-integ-var-2 '(var Y ---))
(setq math-integ-vars (list 'f math-integ-var math-integ-var-2))
(setq math-integ-var-list (list math-integ-var))
(setq math-integ-var-list-list (list math-integ-var-list))
(defvar math-integ-var '(var X ---))
(defvar math-integ-var-2 '(var Y ---))
(defvar math-integ-vars (list 'f math-integ-var math-integ-var-2))
(defvar math-integ-var-list (list math-integ-var))
(defvar math-integ-var-list-list (list math-integ-var-list))
(defmacro math-tracing-integral (&rest parts)
(list 'and
@ -1704,6 +1707,8 @@
(defvar math-tabulate-initial nil)
(defvar math-tabulate-function nil)
(defun calcFunc-table (expr var &optional low high step)
(or low (setq low '(neg (var inf var-inf)) high '(var inf var-inf)))
(or high (setq high low low 1))
@ -1761,9 +1766,6 @@
(list low high))
(and step (list step))))))
(setq math-tabulate-initial nil)
(setq math-tabulate-function nil)
(defun math-scan-for-limits (x)
(cond ((Math-primp x))
((and (eq (car x) 'calcFunc-subscr)
@ -1785,13 +1787,13 @@
(math-scan-for-limits (car x))))))
(defvar math-disable-sums nil)
(defun calcFunc-sum (expr var &optional low high step)
(if math-disable-sums (math-reject-arg))
(let* ((res (let* ((calc-internal-prec (+ calc-internal-prec 2)))
(math-sum-rec expr var low high step)))
(math-disable-sums t))
(math-normalize res)))
(setq math-disable-sums nil)
(defun math-sum-rec (expr var &optional low high step)
(or low (setq low '(neg (var inf var-inf)) high '(var inf var-inf)))
@ -1941,6 +1943,7 @@
(setq temp (list '* (car not-const) temp)))
temp)))))
(defvar math-sum-int-pow-cache (list '(0 1)))
;; Following is from CRC Math Tables, 27th ed, pp. 52-53.
(defun math-sum-integer-power (pow)
(let ((calc-prefer-frac t)
@ -1963,7 +1966,6 @@
(nconc math-sum-int-pow-cache (list (nreverse new)))
n (1+ n))))
(nth pow math-sum-int-pow-cache)))
(setq math-sum-int-pow-cache (list '(0 1)))
(defun math-to-exponentials (expr)
(and (consp expr)
@ -2013,13 +2015,13 @@
(cons (car expr) (mapcar 'math-to-exps (cdr expr))))))
(defvar math-disable-prods nil)
(defun calcFunc-prod (expr var &optional low high step)
(if math-disable-prods (math-reject-arg))
(let* ((res (let* ((calc-internal-prec (+ calc-internal-prec 2)))
(math-prod-rec expr var low high step)))
(math-disable-prods t))
(math-normalize res)))
(setq math-disable-prods nil)
(defun math-prod-rec (expr var &optional low high step)
(or low (setq low '(neg (var inf var-inf)) high '(var inf var-inf)))
@ -2165,6 +2167,7 @@
(defvar math-solve-ranges nil)
;;; Attempt to reduce lhs = rhs to solve-var = rhs', where solve-var appears
;;; in lhs but not in rhs or rhs'; return rhs'.
;;; Uses global values: solve-*.
@ -2311,7 +2314,6 @@
(calc-record-why "*No inverse known" lhs)
nil))))
(setq math-solve-ranges nil)
(defun math-try-solve-prod ()
(cond ((eq (car lhs) '*)
@ -2656,6 +2658,8 @@
(math-div a 4))))
nil t))
(defvar math-symbolic-solve nil)
(defvar math-int-coefs nil)
(defun math-poly-all-roots (var p &optional math-factoring)
(catch 'ouch
(let* ((math-symbolic-solve calc-symbolic-mode)
@ -2750,7 +2754,6 @@
vec
(math-solve-get-int 1 (1- (length orig-p)) 1))
vec))))))
(setq math-symbolic-solve nil)
(defun math-lcm-denoms (&rest fracs)
(let ((den 1))
@ -2870,7 +2873,6 @@
(math-mul (math-sqrt (math-sub (math-sqr aa)
rnd0))
(if (math-negp xim) -1 1)))))))))))
(setq math-int-coefs nil)
;;; The following routine is from Numerical Recipes, section 9.5.
(defun math-poly-laguerre-root (p x polish)

51
lisp/calc/calcalg3.el
View File

@ -1,6 +1,9 @@
;; Calculator for GNU Emacs, part II [calc-alg-3.el]
;;; calcalg3.el --- more algebraic functions for Calc
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Written by Dave Gillespie, daveg@synaptics.com.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.
@ -19,7 +22,9 @@
;; file named COPYING. Among other things, the copyright notice
;; and this notice must be preserved on all copies.
;;; Commentary:
;;; Code:
;; This file is autoloaded from calc-ext.el.
(require 'calc-ext)
@ -601,9 +606,9 @@
(set (nth 2 (aref math-root-vars m)) (car p)))
(setq expr-val (math-evaluate-expr expr)
jacob-val (math-evaluate-expr jacob))
(or (and (math-constp expr-val)
(math-constp jacob-val))
(math-reject-arg guess "*Newton's method encountered a singularity"))
(unless (and (math-constp expr-val)
(math-constp jacob-val))
(math-reject-arg guess "*Newton's method encountered a singularity"))
(setq next (math-add guess (math-div (math-float (math-neg expr-val))
(math-float jacob-val)))
p guess p2 next)
@ -626,10 +631,10 @@
(var-DUMMY nil)
(jacob (list 'vec))
p p2 m row)
(or (eq (car-safe var) 'vec)
(math-reject-arg var 'vectorp))
(or (= (length var) (1+ n))
(math-dimension-error))
(unless (eq (car-safe var) 'vec)
(math-reject-arg var 'vectorp))
(unless (= (length var) (1+ n))
(math-dimension-error))
(setq expr (copy-sequence expr))
(while (>= n (length math-root-vars))
(let ((symb (intern (concat "math-root-v"
@ -648,10 +653,10 @@
(while (setq p2 (cdr p2))
(setcar p2 (math-expr-subst (car p2) (car p)
(aref math-root-vars m)))))
(or (eq (car-safe guess) 'vec)
(math-reject-arg guess 'vectorp))
(or (= (length guess) (1+ n))
(math-dimension-error))
(unless (eq (car-safe guess) 'vec)
(math-reject-arg guess 'vectorp))
(unless (= (length guess) (1+ n))
(math-dimension-error))
(setq guess (copy-sequence guess)
p guess)
(while (setq p (cdr p))
@ -677,10 +682,10 @@
(setq m (math-abs-approx guess))
(math-newton-multi expr jacob n guess guess
(if (math-zerop m) '(float 1 3) (math-mul m 10))))
(or (eq (car-safe var) 'var)
(math-reject-arg var "*Expected a variable"))
(or (math-expr-contains expr var)
(math-reject-arg expr "*Formula does not contain specified variable"))
(unless (eq (car-safe var) 'var)
(math-reject-arg var "*Expected a variable"))
(unless (math-expr-contains expr var)
(math-reject-arg expr "*Formula does not contain specified variable"))
(if (assq (car expr) calc-tweak-eqn-table)
(setq expr (math-sub (nth 1 expr) (nth 2 expr))))
(math-with-extra-prec 2
@ -758,6 +763,7 @@
a
(math-reject-arg a 'realp))))
(defvar math-min-or-max "minimum")
;;; A bracket for a minimum is a < b < c where f(b) < f(a) and f(b) < f(c).
@ -1145,7 +1151,6 @@
(if isvec
(list 'vec vec (nth 2 res))
(list 'vec (nth 1 vec) (nth 2 res)))))))
(setq math-min-or-max "minimum")
(defun calcFunc-minimize (expr var guess)
(let ((calc-internal-prec (max (/ calc-internal-prec 2) 3))
@ -1390,9 +1395,8 @@
;;; The following algorithms come from Numerical Recipes, chapter 14.
(setq math-dummy-vars [(var DUMMY var-DUMMY)])
(setq math-dummy-counter 0)
(defvar math-dummy-vars [(var DUMMY var-DUMMY)])
(defvar math-dummy-counter 0)
(defun math-dummy-variable ()
(if (= math-dummy-counter (length math-dummy-vars))
(let ((symb (intern (format "math-dummy-%d" math-dummy-counter))))
@ -1403,7 +1407,8 @@
(aref math-dummy-vars math-dummy-counter)
(setq math-dummy-counter (1+ math-dummy-counter))))
(defvar math-in-fit 0)
(defvar calc-fit-to-trail nil)
(defun calcFunc-fit (expr vars &optional coefs data)
(let ((math-in-fit 10))
@ -1708,8 +1713,6 @@
'(var nan var-nan)))
expr))))
(setq math-in-fit 0)
(setq calc-fit-to-trail nil)
(defun calcFunc-fitvar (x)
(if (>= math-in-fit 2)

112
lisp/calc/calccomp.el
View File

@ -1,6 +1,9 @@
;; Calculator for GNU Emacs, part II [calc-comp.el]
;;; calccomp.el --- composition functions for Calc
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Written by Dave Gillespie, daveg@synaptics.com.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.
@ -19,7 +22,9 @@
;; file named COPYING. Among other things, the copyright notice
;; and this notice must be preserved on all copies.
;;; Commentary:
;;; Code:
;; This file is autoloaded from calc-ext.el.
(require 'calc-ext)
@ -28,6 +33,13 @@
(defun calc-Need-calc-comp () nil)
(defconst math-eqn-special-funcs
'( calcFunc-log
calcFunc-ln calcFunc-exp
calcFunc-sin calcFunc-cos calcFunc-tan
calcFunc-sinh calcFunc-cosh calcFunc-tanh
calcFunc-arcsin calcFunc-arccos calcFunc-arctan
calcFunc-arcsinh calcFunc-arccosh calcFunc-arctanh))
;;; A "composition" has one of the following forms:
;;;
@ -880,15 +892,6 @@
0)
right)))))))))
(defconst math-eqn-special-funcs
'( calcFunc-log
calcFunc-ln calcFunc-exp
calcFunc-sin calcFunc-cos calcFunc-tan
calcFunc-sinh calcFunc-cosh calcFunc-tanh
calcFunc-arcsin calcFunc-arccos calcFunc-arctan
calcFunc-arcsinh calcFunc-arccosh calcFunc-arctanh
))
(defun math-prod-first-term (x)
(while (eq (car-safe x) '*)
@ -993,6 +996,17 @@
(<= (nth 1 (car a)) 255)))))
(null a))
(defconst math-vector-to-string-chars '( ( ?\" . "\\\"" )
( ?\\ . "\\\\" )
( ?\a . "\\a" )
( ?\b . "\\b" )
( ?\e . "\\e" )
( ?\f . "\\f" )
( ?\n . "\\n" )
( ?\r . "\\r" )
( ?\t . "\\t" )
( ?\^? . "\\^?" )))
(defun math-vector-to-string (a &optional quoted)
(setq a (concat (mapcar (function (lambda (x) (if (consp x) (nth 1 x) x)))
(cdr a))))
@ -1015,17 +1029,7 @@
(if quoted
(concat "\"" a "\"")
a))
(defconst math-vector-to-string-chars '( ( ?\" . "\\\"" )
( ?\\ . "\\\\" )
( ?\a . "\\a" )
( ?\b . "\\b" )
( ?\e . "\\e" )
( ?\f . "\\f" )
( ?\n . "\\n" )
( ?\r . "\\r" )
( ?\t . "\\t" )
( ?\^? . "\\^?" )
))
(defun math-to-underscores (x)
(if (string-match "\\`\\(.*\\)#\\(.*\\)\\'" x)
@ -1067,38 +1071,38 @@
(put 'calcFunc-deriv 'math-compose-big 'math-compose-deriv)
(put 'calcFunc-tderiv 'math-compose-big 'math-compose-deriv)
(defun math-compose-deriv (a prec)
(and (= (length a) 3)
(math-compose-expr (list '/
(list 'calcFunc-choriz
(list 'vec
'(calcFunc-string (vec ?d))
(nth 1 a)))
(list 'calcFunc-choriz
(list 'vec
'(calcFunc-string (vec ?d))
(nth 2 a))))
prec)))
(when (= (length a) 3)
(math-compose-expr (list '/
(list 'calcFunc-choriz
(list 'vec
'(calcFunc-string (vec ?d))
(nth 1 a)))
(list 'calcFunc-choriz
(list 'vec
'(calcFunc-string (vec ?d))
(nth 2 a))))
prec)))
(put 'calcFunc-sqrt 'math-compose-big 'math-compose-sqrt)
(defun math-compose-sqrt (a prec)
(and (= (length a) 2)
(let* ((c (math-compose-expr (nth 1 a) 0))
(a (math-comp-ascent c))
(d (math-comp-descent c))
(h (+ a d))
(w (math-comp-width c)))
(list 'vleft
a
(concat (if (= h 1) " " " ")
(make-string (+ w 2) ?\_))
(list 'horiz
(if (= h 1)
"V"
(append (list 'vleft (1- a))
(make-list (1- h) " |")
'("\\|")))
" "
c)))))
(when (= (length a) 2)
(let* ((c (math-compose-expr (nth 1 a) 0))
(a (math-comp-ascent c))
(d (math-comp-descent c))
(h (+ a d))
(w (math-comp-width c)))
(list 'vleft
a
(concat (if (= h 1) " " " ")
(make-string (+ w 2) ?\_))
(list 'horiz
(if (= h 1)
"V"
(append (list 'vleft (1- a))
(make-list (1- h) " |")
'("\\|")))
" "
c)))))
(put 'calcFunc-choose 'math-compose-big 'math-compose-choose)
(defun math-compose-choose (a prec)
@ -1245,6 +1249,9 @@
(math-vert-comp-to-string
(math-comp-simplify c width)))))
(defvar math-comp-buf-string (make-vector 10 ""))
(defvar math-comp-buf-margin (make-vector 10 0))
(defvar math-comp-buf-level (make-vector 10 0))
(defun math-comp-is-flat (c) ; check if c's height is 1.
(cond ((not (consp c)) t)
((memq (car c) '(set break)) t)
@ -1292,9 +1299,6 @@
(setq prefix " "))
(setq prefix "\n"))))
(concat comp-buf prefix str)))))
(setq math-comp-buf-string (make-vector 10 ""))
(setq math-comp-buf-margin (make-vector 10 0))
(setq math-comp-buf-level (make-vector 10 0))
(defun math-comp-to-string-flat-term (c)
(cond ((not (consp c))

9
lisp/calc/calcsel2.el
View File

@ -1,6 +1,9 @@
;; Calculator for GNU Emacs, part II [calc-sel-2.el]
;;; calcsel2.el --- selection functions for Calc
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Written by Dave Gillespie, daveg@synaptics.com.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.
@ -19,7 +22,9 @@
;; file named COPYING. Among other things, the copyright notice
;; and this notice must be preserved on all copies.
;;; Commentary:
;;; Code:
;; This file is autoloaded from calc-ext.el.
(require 'calc-ext)