diff options
| author | Colin Walters <walters@gnu.org> | 2001-11-19 07:43:43 +0000 |
|---|---|---|
| committer | Colin Walters <walters@gnu.org> | 2001-11-19 07:43:43 +0000 |
| commit | f0317931520807c6b28b2dd5b2a50b3f393a74a5 (patch) | |
| tree | 07a22fec0d079478110bea463e8bca58a80413b0 | |
| parent | 78e7f57d36af9fa93ca9508e957135ebfc4676da (diff) | |
| download | emacs-f0317931520807c6b28b2dd5b2a50b3f393a74a5.tar.gz | |
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.
34 files changed, 923 insertions, 812 deletions
diff --git a/lisp/calc/calc-aent.el b/lisp/calc/calc-aent.el index 709b67d6e7c..2f5270b3e91 100644 --- a/lisp/calc/calc-aent.el +++ b/lisp/calc/calc-aent.el @@ -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))) diff --git a/lisp/calc/calc-alg.el b/lisp/calc/calc-alg.el index 522deb2ee54..790d665d7de 100644 --- a/lisp/calc/calc-alg.el +++ b/lisp/calc/calc-alg.el @@ -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))))) diff --git a/lisp/calc/calc-arith.el b/lisp/calc/calc-arith.el index d510c484364..95b60bc0523 100644 --- a/lisp/calc/calc-arith.el +++ b/lisp/calc/calc-arith.el @@ -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)) diff --git a/lisp/calc/calc-bin.el b/lisp/calc/calc-bin.el index 3d153049975..e97c97828c4 100644 --- a/lisp/calc/calc-bin.el +++ b/lisp/calc/calc-bin.el @@ -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 diff --git a/lisp/calc/calc-comb.el b/lisp/calc/calc-comb.el index 91dfd405154..7c1b36de7fd 100644 --- a/lisp/calc/calc-comb.el +++ b/lisp/calc/calc-comb.el @@ -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 diff --git a/lisp/calc/calc-cplx.el b/lisp/calc/calc-cplx.el index df0ebffc74b..e888758ae0d 100644 --- a/lisp/calc/calc-cplx.el +++ b/lisp/calc/calc-cplx.el @@ -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. diff --git a/lisp/calc/calc-embed.el b/lisp/calc/calc-embed.el index b07df1eda04..5529a6879c0 100644 --- a/lisp/calc/calc-embed.el +++ b/lisp/calc/calc-embed.el @@ -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 - - - diff --git a/lisp/calc/calc-ext.el b/lisp/calc/calc-ext.el index 031ffae9b85..1253d464336 100644 --- a/lisp/calc/calc-ext.el +++ b/lisp/calc/calc-ext.el @@ -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. diff --git a/lisp/calc/calc-fin.el b/lisp/calc/calc-fin.el index 85c9700f55c..64ce3b309fc 100644 --- a/lisp/calc/calc-fin.el +++ b/lisp/calc/calc-fin.el @@ -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) diff --git a/lisp/calc/calc-forms.el b/lisp/calc/calc-forms.el index 0c3029b5986..255abe8811b 100644 --- a/lisp/calc/calc-forms.el +++ b/lisp/calc/calc-forms.el @@ -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) diff --git a/lisp/calc/calc-graph.el b/lisp/calc/calc-graph.el index a7ab6843f6d..417e1e436a9 100644 --- a/lisp/calc/calc-graph.el +++ b/lisp/calc/calc-graph.el @@ -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 diff --git a/lisp/calc/calc-help.el b/lisp/calc/calc-help.el index ed66d65c2e2..f3242ab1d48 100644 --- a/lisp/calc/calc-help.el +++ b/lisp/calc/calc-help.el @@ -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") diff --git a/lisp/calc/calc-incom.el b/lisp/calc/calc-incom.el index 2c7a95339bd..a1b1e959370 100644 --- a/lisp/calc/calc-incom.el +++ b/lisp/calc/calc-incom.el @@ -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) diff --git a/lisp/calc/calc-lang.el b/lisp/calc/calc-lang.el index 03dd4d29813..79681dde9e9 100644 --- a/lisp/calc/calc-lang.el +++ b/lisp/calc/calc-lang.el @@ -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 ) diff --git a/lisp/calc/calc-maint.el b/lisp/calc/calc-maint.el index a5d92c969bd..83af931a428 100644 --- a/lisp/calc/calc-maint.el +++ b/lisp/calc/calc-maint.el @@ -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)) diff --git a/lisp/calc/calc-map.el b/lisp/calc/calc-map.el index 17ea4f2b829..baed3573789 100644 --- a/lisp/calc/calc-map.el +++ b/lisp/calc/calc-map.el @@ -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,259 +198,6 @@ (calc-top-list-n 2 (+ 1 mul-used calc-dollar-used))))))) -;;; Return a list of the form (nargs func name) -(defun calc-get-operator (msg &optional nargs) - (setq calc-aborted-prefix nil) - (let ((inv nil) (hyp nil) (prefix nil) (forcenargs nil) - done key oper (which 0) - (msgs '( "(Press ? for help)" - "+, -, *, /, ^, %, \\, :, &, !, |, Neg" - "SHIFT + Abs, conJ, arG; maX, miN; Floor, Round; sQrt" - "SHIFT + Inv, Hyp; Sin, Cos, Tan; Exp, Ln, logB" - "Algebra + Simp, Esimp, Deriv, Integ, !, =, etc." - "Binary + And, Or, Xor, Diff; l/r/t/L/R shifts; Not, Clip" - "Conversions + Deg, Rad, HMS; Float; SHIFT + Fraction" - "Functions + Re, Im; Hypot; Mant, Expon, Scale; etc." - "Kombinatorics + Dfact, Lcm, Gcd, Choose; Random; etc." - "Time/date + newYear, Incmonth, etc." - "Vectors + Length, Row, Col, Diag, Mask, etc." - "_ = mapr/reducea, : = mapc/reduced, = = reducer" - "X or Z = any function by name; ' = alg entry; $ = stack"))) - (while (not done) - (message "%s%s: %s: %s%s%s" - msg - (cond ((equal calc-mapping-dir "r") " rows") - ((equal calc-mapping-dir "c") " columns") - ((equal calc-mapping-dir "a") " across") - ((equal calc-mapping-dir "d") " down") - (t "")) - (if forcenargs - (format "(%d arg%s)" - forcenargs (if (= forcenargs 1) "" "s")) - (nth which msgs)) - (if inv "Inv " "") (if hyp "Hyp " "") - (if prefix (concat (char-to-string prefix) "-") "")) - (setq key (read-char)) - (if (>= key 128) (setq key (- key 128))) - (cond ((memq key '(?\C-g ?q)) - (keyboard-quit)) - ((memq key '(?\C-u ?\e))) - ((= key ??) - (setq which (% (1+ which) (length msgs)))) - ((and (= key ?I) (null prefix)) - (setq inv (not inv))) - ((and (= key ?H) (null prefix)) - (setq hyp (not hyp))) - ((and (eq key prefix) (not (eq key ?v))) - (setq prefix nil)) - ((and (memq key '(?a ?b ?c ?f ?k ?s ?t ?u ?v ?V)) - (null prefix)) - (setq prefix (downcase key))) - ((and (eq key ?\=) (null prefix)) - (if calc-mapping-dir - (setq calc-mapping-dir (if (equal calc-mapping-dir "r") - "" "r")) - (beep))) - ((and (eq key ?\_) (null prefix)) - (if calc-mapping-dir - (if (string-match "map$" msg) - (setq calc-mapping-dir (if (equal calc-mapping-dir "r") - "" "r")) - (setq calc-mapping-dir (if (equal calc-mapping-dir "a") - "" "a"))) - (beep))) - ((and (eq key ?\:) (null prefix)) - (if calc-mapping-dir - (if (string-match "map$" msg) - (setq calc-mapping-dir (if (equal calc-mapping-dir "c") - "" "c")) - (setq calc-mapping-dir (if (equal calc-mapping-dir "d") - "" "d"))) - (beep))) - ((and (>= key ?0) (<= key ?9) (null prefix)) - (setq forcenargs (if (eq forcenargs (- key ?0)) nil (- key ?0))) - (and nargs forcenargs (/= nargs forcenargs) (>= nargs 0) - (error "Must be a %d-argument operator" nargs))) - ((memq key '(?\$ ?\')) - (let* ((arglist nil) - (has-args nil) - (record-entry nil) - (expr (if (eq key ?\$) - (progn - (setq calc-dollar-used 1) - (if calc-dollar-values - (car calc-dollar-values) - (error "Stack underflow"))) - (let* ((calc-dollar-values calc-arg-values) - (calc-dollar-used 0) - (calc-hashes-used 0) - (func (calc-do-alg-entry "" "Function: "))) - (setq record-entry t) - (or (= (length func) 1) - (error "Bad format")) - (if (> calc-dollar-used 0) - (progn - (setq has-args calc-dollar-used - arglist (calc-invent-args has-args)) - (math-multi-subst (car func) - (reverse arglist) - arglist)) - (if (> calc-hashes-used 0) - (setq has-args calc-hashes-used - arglist (calc-invent-args has-args))) - (car func)))))) - (if (eq (car-safe expr) 'calcFunc-lambda) - (setq oper (list "$" (- (length expr) 2) expr) - done t) - (or has-args - (progn - (calc-default-formula-arglist expr) - (setq record-entry t - arglist (sort arglist 'string-lessp)) - (if calc-verify-arglist - (setq arglist (read-from-minibuffer - "Function argument list: " - (if arglist - (prin1-to-string arglist) - "()") - minibuffer-local-map - t))) - (setq arglist (mapcar (function - (lambda (x) - (list 'var - x - (intern - (concat - "var-" - (symbol-name x)))))) - arglist)))) - (setq oper (list "$" - (length arglist) - (append '(calcFunc-lambda) arglist - (list expr))) - done t)) - (if record-entry - (calc-record (nth 2 oper) "oper")))) - ((setq oper (assq key (nth (if inv (if hyp 3 1) (if hyp 2 0)) - (if prefix - (symbol-value - (intern (format "calc-%c-oper-keys" - prefix))) - calc-oper-keys)))) - (if (eq (nth 1 oper) 'user) - (let ((func (intern - (completing-read "Function name: " - obarray 'fboundp - nil "calcFunc-")))) - (if (or forcenargs nargs) - (setq oper (list "z" (or forcenargs nargs) func) - done t) - (if (fboundp func) - (let* ((defn (symbol-function func))) - (and (symbolp defn) - (setq defn (symbol-function defn))) - (if (eq (car-safe defn) 'lambda) - (let ((args (nth 1 defn)) - (nargs 0)) - (while (not (memq (car args) '(&optional - &rest nil))) - (setq nargs (1+ nargs) - args (cdr args))) - (setq oper (list "z" nargs func) - done t)) - (error - "Function is not suitable for this operation"))) - (message "Number of arguments: ") - (let ((nargs (read-char))) - (if (and (>= nargs ?0) (<= nargs ?9)) - (setq oper (list "z" (- nargs ?0) func) - done t) - (beep)))))) - (if (or (and (eq prefix ?v) (memq key '(?A ?I ?M ?O ?R ?U))) - (and (eq prefix ?a) (eq key ?M))) - (let* ((dir (cond ((and (equal calc-mapping-dir "") - (string-match "map$" msg)) - (setq calc-mapping-dir "r") - " rows") - ((equal calc-mapping-dir "r") " rows") - ((equal calc-mapping-dir "c") " columns") - ((equal calc-mapping-dir "a") " across") - ((equal calc-mapping-dir "d") " down") - (t ""))) - (calc-mapping-dir (and (memq (nth 2 oper) - '(calcFunc-map - calcFunc-reduce - calcFunc-rreduce)) - "")) - (oper2 (calc-get-operator - (format "%s%s, %s%s" msg dir - (substring (symbol-name (nth 2 oper)) - 9) - (if (eq key ?I) " (mult)" "")) - (cdr (assq (nth 2 oper) - '((calcFunc-reduce . 2) - (calcFunc-rreduce . 2) - (calcFunc-accum . 2) - (calcFunc-raccum . 2) - (calcFunc-nest . 2) - (calcFunc-anest . 2) - (calcFunc-fixp . 2) - (calcFunc-afixp . 2)))))) - (oper3 (if (eq (nth 2 oper) 'calcFunc-inner) - (calc-get-operator - (format "%s%s, inner (add)" msg dir - (substring - (symbol-name (nth 2 oper)) - 9))) - '(0 0 0))) - (args nil) - (nargs (if (> (nth 1 oper) 0) - (nth 1 oper) - (car oper2))) - (n nargs) - (p calc-arg-values)) - (while (and p (> n 0)) - (or (math-expr-contains (nth 1 oper2) (car p)) - (math-expr-contains (nth 1 oper3) (car p)) - (setq args (nconc args (list (car p))) - n (1- n))) - (setq p (cdr p))) - (setq oper (list "" nargs - (append - '(calcFunc-lambda) - args - (list (math-build-call - (intern - (concat - (symbol-name (nth 2 oper)) - calc-mapping-dir)) - (cons (math-calcFunc-to-var - (nth 1 oper2)) - (if (eq key ?I) - (cons - (math-calcFunc-to-var - (nth 1 oper3)) - args) - args)))))) - done t)) - (setq done t)))) - (t (beep)))) - (and nargs (>= nargs 0) - (/= nargs (nth 1 oper)) - (error "Must be a %d-argument operator" nargs)) - (append (if forcenargs - (cons forcenargs (cdr (cdr oper))) - (cdr oper)) - (list - (let ((name (concat (if inv "I" "") (if hyp "H" "") - (if prefix (char-to-string prefix) "") - (char-to-string key)))) - (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 ) @@ -497,8 +251,8 @@ ( ?T 1 calcFunc-arctanh ) ( ?L 1 calcFunc-exp10 ) ( ?E 1 calcFunc-log10 ) - ( ?| 2 calcFunc-appendrev ) ) -)) + ( ?| 2 calcFunc-appendrev ) ))) + (defconst calc-a-oper-keys '( ( ( ?a 3 calcFunc-apart ) ( ?b 3 calcFunc-subst ) ( ?c 2 calcFunc-collect ) @@ -550,8 +304,8 @@ ( ?S 2 calcFunc-fsolve ) ( ?X 3 calcFunc-wmaximize ) ( ?/ 2 calcFunc-pdivide ) ) - ( ( ?S 2 calcFunc-ffinv ) ) -)) + ( ( ?S 2 calcFunc-ffinv ) ))) + (defconst calc-b-oper-keys '( ( ( ?a 2 calcFunc-and ) ( ?o 2 calcFunc-or ) ( ?x 2 calcFunc-xor ) @@ -587,14 +341,14 @@ ( ?M 3 calcFunc-pmtl ) ( ?P 3 calcFunc-pvl ) ( ?T 3 calcFunc-ratel ) - ( ?\# 3 calcFunc-nperl ) ) -)) + ( ?\# 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 ) ) -)) + ( ?F 1 calcFunc-frac ) ))) + (defconst calc-f-oper-keys '( ( ( ?b 2 calcFunc-beta ) ( ?e 1 calcFunc-erf ) ( ?g 1 calcFunc-gamma ) @@ -625,8 +379,8 @@ ( ?L 1 calcFunc-expm1 ) ) ( ( ?B 3 calcFunc-betaB ) ( ?G 2 calcFunc-gammag) ) - ( ( ?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 ) @@ -656,11 +410,11 @@ ( ( ?b 2 calcFunc-bern ) ( ?c 2 calcFunc-perm ) ( ?e 2 calcFunc-euler ) - ( ?s 2 calcFunc-stir2 ) ) -)) + ( ?s 2 calcFunc-stir2 ) ))) + (defconst calc-s-oper-keys '( ( ( ?: 2 calcFunc-assign ) - ( ?= 1 calcFunc-evalto ) ) -)) + ( ?= 1 calcFunc-evalto ) ))) + (defconst calc-t-oper-keys '( ( ( ?C 3 calcFunc-tzconv ) ( ?D 1 calcFunc-date ) ( ?I 2 calcFunc-incmonth ) @@ -668,8 +422,8 @@ ( ?M 1 calcFunc-newmonth ) ( ?W 1 calcFunc-newweek ) ( ?U 1 calcFunc-unixtime ) - ( ?Y 1 calcFunc-newyear ) ) -)) + ( ?Y 1 calcFunc-newyear ) ))) + (defconst calc-u-oper-keys '( ( ( ?C 2 calcFunc-vcov ) ( ?G 1 calcFunc-vgmean ) ( ?M 1 calcFunc-vmean ) @@ -684,8 +438,8 @@ ( ?M 1 calcFunc-vmedian ) ( ?S 1 calcFunc-vvar ) ) ( ( ?M 1 calcFunc-vhmean ) - ( ?S 1 calcFunc-vpvar ) ) -)) + ( ?S 1 calcFunc-vpvar ) ))) + (defconst calc-v-oper-keys '( ( ( ?a 2 calcFunc-arrange ) ( ?b 2 calcFunc-cvec ) ( ?c 2 calcFunc-mcol ) @@ -742,8 +496,259 @@ ( ?U 2 calcFunc-anest ) ) ( ( ?h 1 calcFunc-rtail ) ( ?R 1 calcFunc-fixp ) - ( ?U 1 calcFunc-afixp ) ) -)) + ( ?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) + (let ((inv nil) (hyp nil) (prefix nil) (forcenargs nil) + done key oper (which 0) + (msgs '( "(Press ? for help)" + "+, -, *, /, ^, %, \\, :, &, !, |, Neg" + "SHIFT + Abs, conJ, arG; maX, miN; Floor, Round; sQrt" + "SHIFT + Inv, Hyp; Sin, Cos, Tan; Exp, Ln, logB" + "Algebra + Simp, Esimp, Deriv, Integ, !, =, etc." + "Binary + And, Or, Xor, Diff; l/r/t/L/R shifts; Not, Clip" + "Conversions + Deg, Rad, HMS; Float; SHIFT + Fraction" + "Functions + Re, Im; Hypot; Mant, Expon, Scale; etc." + "Kombinatorics + Dfact, Lcm, Gcd, Choose; Random; etc." + "Time/date + newYear, Incmonth, etc." + "Vectors + Length, Row, Col, Diag, Mask, etc." + "_ = mapr/reducea, : = mapc/reduced, = = reducer" + "X or Z = any function by name; ' = alg entry; $ = stack"))) + (while (not done) + (message "%s%s: %s: %s%s%s" + msg + (cond ((equal calc-mapping-dir "r") " rows") + ((equal calc-mapping-dir "c") " columns") + ((equal calc-mapping-dir "a") " across") + ((equal calc-mapping-dir "d") " down") + (t "")) + (if forcenargs + (format "(%d arg%s)" + forcenargs (if (= forcenargs 1) "" "s")) + (nth which msgs)) + (if inv "Inv " "") (if hyp "Hyp " "") + (if prefix (concat (char-to-string prefix) "-") "")) + (setq key (read-char)) + (if (>= key 128) (setq key (- key 128))) + (cond ((memq key '(?\C-g ?q)) + (keyboard-quit)) + ((memq key '(?\C-u ?\e))) + ((= key ??) + (setq which (% (1+ which) (length msgs)))) + ((and (= key ?I) (null prefix)) + (setq inv (not inv))) + ((and (= key ?H) (null prefix)) + (setq hyp (not hyp))) + ((and (eq key prefix) (not (eq key ?v))) + (setq prefix nil)) + ((and (memq key '(?a ?b ?c ?f ?k ?s ?t ?u ?v ?V)) + (null prefix)) + (setq prefix (downcase key))) + ((and (eq key ?\=) (null prefix)) + (if calc-mapping-dir + (setq calc-mapping-dir (if (equal calc-mapping-dir "r") + "" "r")) + (beep))) + ((and (eq key ?\_) (null prefix)) + (if calc-mapping-dir + (if (string-match "map$" msg) + (setq calc-mapping-dir (if (equal calc-mapping-dir "r") + "" "r")) + (setq calc-mapping-dir (if (equal calc-mapping-dir "a") + "" "a"))) + (beep))) + ((and (eq key ?\:) (null prefix)) + (if calc-mapping-dir + (if (string-match "map$" msg) + (setq calc-mapping-dir (if (equal calc-mapping-dir "c") + "" "c")) + (setq calc-mapping-dir (if (equal calc-mapping-dir "d") + "" "d"))) + (beep))) + ((and (>= key ?0) (<= key ?9) (null prefix)) + (setq forcenargs (if (eq forcenargs (- key ?0)) nil (- key ?0))) + (and nargs forcenargs (/= nargs forcenargs) (>= nargs 0) + (error "Must be a %d-argument operator" nargs))) + ((memq key '(?\$ ?\')) + (let* ((arglist nil) + (has-args nil) + (record-entry nil) + (expr (if (eq key ?\$) + (progn + (setq calc-dollar-used 1) + (if calc-dollar-values + (car calc-dollar-values) + (error "Stack underflow"))) + (let* ((calc-dollar-values calc-arg-values) + (calc-dollar-used 0) + (calc-hashes-used 0) + (func (calc-do-alg-entry "" "Function: "))) + (setq record-entry t) + (or (= (length func) 1) + (error "Bad format")) + (if (> calc-dollar-used 0) + (progn + (setq has-args calc-dollar-used + arglist (calc-invent-args has-args)) + (math-multi-subst (car func) + (reverse arglist) + arglist)) + (if (> calc-hashes-used 0) + (setq has-args calc-hashes-used + arglist (calc-invent-args has-args))) + (car func)))))) + (if (eq (car-safe expr) 'calcFunc-lambda) + (setq oper (list "$" (- (length expr) 2) expr) + done t) + (or has-args + (progn + (calc-default-formula-arglist expr) + (setq record-entry t + arglist (sort arglist 'string-lessp)) + (if calc-verify-arglist + (setq arglist (read-from-minibuffer + "Function argument list: " + (if arglist + (prin1-to-string arglist) + "()") + minibuffer-local-map + t))) + (setq arglist (mapcar (function + (lambda (x) + (list 'var + x + (intern + (concat + "var-" + (symbol-name x)))))) + arglist)))) + (setq oper (list "$" + (length arglist) + (append '(calcFunc-lambda) arglist + (list expr))) + done t)) + (if record-entry + (calc-record (nth 2 oper) "oper")))) + ((setq oper (assq key (nth (if inv (if hyp 3 1) (if hyp 2 0)) + (if prefix + (symbol-value + (intern (format "calc-%c-oper-keys" + prefix))) + calc-oper-keys)))) + (if (eq (nth 1 oper) 'user) + (let ((func (intern + (completing-read "Function name: " + obarray 'fboundp + nil "calcFunc-")))) + (if (or forcenargs nargs) + (setq oper (list "z" (or forcenargs nargs) func) + done t) + (if (fboundp func) + (let* ((defn (symbol-function func))) + (and (symbolp defn) + (setq defn (symbol-function defn))) + (if (eq (car-safe defn) 'lambda) + (let ((args (nth 1 defn)) + (nargs 0)) + (while (not (memq (car args) '(&optional + &rest nil))) + (setq nargs (1+ nargs) + args (cdr args))) + (setq oper (list "z" nargs func) + done t)) + (error + "Function is not suitable for this operation"))) + (message "Number of arguments: ") + (let ((nargs (read-char))) + (if (and (>= nargs ?0) (<= nargs ?9)) + (setq oper (list "z" (- nargs ?0) func) + done t) + (beep)))))) + (if (or (and (eq prefix ?v) (memq key '(?A ?I ?M ?O ?R ?U))) + (and (eq prefix ?a) (eq key ?M))) + (let* ((dir (cond ((and (equal calc-mapping-dir "") + (string-match "map$" msg)) + (setq calc-mapping-dir "r") + " rows") + ((equal calc-mapping-dir "r") " rows") + ((equal calc-mapping-dir "c") " columns") + ((equal calc-mapping-dir "a") " across") + ((equal calc-mapping-dir "d") " down") + (t ""))) + (calc-mapping-dir (and (memq (nth 2 oper) + '(calcFunc-map + calcFunc-reduce + calcFunc-rreduce)) + "")) + (oper2 (calc-get-operator + (format "%s%s, %s%s" msg dir + (substring (symbol-name (nth 2 oper)) + 9) + (if (eq key ?I) " (mult)" "")) + (cdr (assq (nth 2 oper) + '((calcFunc-reduce . 2) + (calcFunc-rreduce . 2) + (calcFunc-accum . 2) + (calcFunc-raccum . 2) + (calcFunc-nest . 2) + (calcFunc-anest . 2) + (calcFunc-fixp . 2) + (calcFunc-afixp . 2)))))) + (oper3 (if (eq (nth 2 oper) 'calcFunc-inner) + (calc-get-operator + (format "%s%s, inner (add)" msg dir + (substring + (symbol-name (nth 2 oper)) + 9))) + '(0 0 0))) + (args nil) + (nargs (if (> (nth 1 oper) 0) + (nth 1 oper) + (car oper2))) + (n nargs) + (p calc-arg-values)) + (while (and p (> n 0)) + (or (math-expr-contains (nth 1 oper2) (car p)) + (math-expr-contains (nth 1 oper3) (car p)) + (setq args (nconc args (list (car p))) + n (1- n))) + (setq p (cdr p))) + (setq oper (list "" nargs + (append + '(calcFunc-lambda) + args + (list (math-build-call + (intern + (concat + (symbol-name (nth 2 oper)) + calc-mapping-dir)) + (cons (math-calcFunc-to-var + (nth 1 oper2)) + (if (eq key ?I) + (cons + (math-calcFunc-to-var + (nth 1 oper3)) + args) + args)))))) + done t)) + (setq done t)))) + (t (beep)))) + (and nargs (>= nargs 0) + (/= nargs (nth 1 oper)) + (error "Must be a %d-argument operator" nargs)) + (append (if forcenargs + (cons forcenargs (cdr (cdr oper))) + (cdr oper)) + (list + (let ((name (concat (if inv "I" "") (if hyp "H" "") + (if prefix (char-to-string prefix) "") + (char-to-string key)))) + (if (> (length name) 3) + (substring name 0 3) + name)))))) ;;; Convert a variable name (as a formula) into a like-looking function name. diff --git a/lisp/calc/calc-math.el b/lisp/calc/calc-math.el index 81a2503cfb5..2bc6c681c4b 100644 --- a/lisp/calc/calc-math.el +++ b/lisp/calc/calc-math.el @@ -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) diff --git a/lisp/calc/calc-mtx.el b/lisp/calc/calc-mtx.el index 0031ca7c8b2..3e3d2a37607 100644 --- a/lisp/calc/calc-mtx.el +++ b/lisp/calc/calc-mtx.el @@ -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) diff --git a/lisp/calc/calc-poly.el b/lisp/calc/calc-poly.el index c2dfd71f69a..acb5d34ea50 100644 --- a/lisp/calc/calc-poly.el +++ b/lisp/calc/calc-poly.el @@ -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))) diff --git a/lisp/calc/calc-prog.el b/lisp/calc/calc-prog.el index cf2fc0cc5a1..160e7cfce2a 100644 --- a/lisp/calc/calc-prog.el +++ b/lisp/calc/calc-prog.el @@ -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))) diff --git a/lisp/calc/calc-rewr.el b/lisp/calc/calc-rewr.el index a1c26159d9c..5e46e135ae2 100644 --- a/lisp/calc/calc-rewr.el +++ b/lisp/calc/calc-rewr.el @@ -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) diff --git a/lisp/calc/calc-rules.el b/lisp/calc/calc-rules.el index cdeebba55bd..4cb1d745b66 100644 --- a/lisp/calc/calc-rules.el +++ b/lisp/calc/calc-rules.el @@ -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) diff --git a/lisp/calc/calc-sel.el b/lisp/calc/calc-sel.el index 139440e2488..6a580c990be 100644 --- a/lisp/calc/calc-sel.el +++ b/lisp/calc/calc-sel.el @@ -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))) diff --git a/lisp/calc/calc-stat.el b/lisp/calc/calc-stat.el index dc37922cccc..0d4d1a5e895 100644 --- a/lisp/calc/calc-stat.el +++ b/lisp/calc/calc-stat.el @@ -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) diff --git a/lisp/calc/calc-store.el b/lisp/calc/calc-store.el index c087ff38a81..4485a471e41 100644 --- a/lisp/calc/calc-store.el +++ b/lisp/calc/calc-store.el @@ -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)) diff --git a/lisp/calc/calc-stuff.el b/lisp/calc/calc-stuff.el index bbf520dcaef..fb3891f5c45 100644 --- a/lisp/calc/calc-stuff.el +++ b/lisp/calc/calc-stuff.el @@ -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))) diff --git a/lisp/calc/calc-trail.el b/lisp/calc/calc-trail.el index 8111424460c..018851f76d8 100644 --- a/lisp/calc/calc-trail.el +++ b/lisp/calc/calc-trail.el @@ -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) diff --git a/lisp/calc/calc-undo.el b/lisp/calc/calc-undo.el index 5f545a51fac..a27e4fc629c 100644 --- a/lisp/calc/calc-undo.el +++ b/lisp/calc/calc-undo.el @@ -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 diff --git a/lisp/calc/calc-vec.el b/lisp/calc/calc-vec.el index 772004c42fe..321fd4c3cd9 100644 --- a/lisp/calc/calc-vec.el +++ b/lisp/calc/calc-vec.el @@ -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") diff --git a/lisp/calc/calc-yank.el b/lisp/calc/calc-yank.el index e6d4b86ad1d..77c80b9291b 100644 --- a/lisp/calc/calc-yank.el +++ b/lisp/calc/calc-yank.el @@ -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 diff --git a/lisp/calc/calcalg2.el b/lisp/calc/calcalg2.el index c7957feb3d7..c5ed7688d3d 100644 --- a/lisp/calc/calcalg2.el +++ b/lisp/calc/calcalg2.el @@ -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) diff --git a/lisp/calc/calcalg3.el b/lisp/calc/calcalg3.el index 1b2b2b8f349..842290df259 100644 --- a/lisp/calc/calcalg3.el +++ b/lisp/calc/calcalg3.el @@ -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) diff --git a/lisp/calc/calccomp.el b/lisp/calc/calccomp.el index 3d5cc6ab74b..2022891cd89 100644 --- a/lisp/calc/calccomp.el +++ b/lisp/calc/calccomp.el @@ -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)) diff --git a/lisp/calc/calcsel2.el b/lisp/calc/calcsel2.el index 84733b81524..2f630f8d7f9 100644 --- a/lisp/calc/calcsel2.el +++ b/lisp/calc/calcsel2.el @@ -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) |