diff options
Diffstat (limited to 'lisp/calc')
43 files changed, 1759 insertions, 1780 deletions
diff --git a/lisp/calc/README b/lisp/calc/README index c33e5d92c8f..a9e2813673c 100644 --- a/lisp/calc/README +++ b/lisp/calc/README @@ -12,7 +12,7 @@ Written by: daveg@synaptics.com, uunet!synaptx!daveg Currently maintained by: - D. Goel <deego@gnufans.org> and Colin Walters <walters@debian.org> + Jay Belanger <belanger@truman.edu> From the introduction to the manual: diff --git a/lisp/calc/calc-aent.el b/lisp/calc/calc-aent.el index 182b3b0635c..4c62e570349 100644 --- a/lisp/calc/calc-aent.el +++ b/lisp/calc/calc-aent.el @@ -3,8 +3,7 @@ ;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. ;; Author: Dave Gillespie <daveg@synaptics.com> -;; Maintainers: D. Goel <deego@gnufans.org> -;; Colin Walters <walters@debian.org> +;; Maintainer: Jay Belanger <belanger@truman.edu> ;; This file is part of GNU Emacs. @@ -28,13 +27,9 @@ ;;; Code: ;; This file is autoloaded from calc.el. -(require 'calc) +(require 'calc) (require 'calc-macs) -(eval-when-compile '(require calc-macs)) - -(defun calc-Need-calc-aent () nil) - (defun calc-do-quick-calc () (calc-check-defines) @@ -52,20 +47,20 @@ (entry (calc-do-alg-entry "" "Quick calc: " t)) (alg-exp (mapcar (function (lambda (x) - (if (and (not calc-extensions-loaded) + (if (and (not (featurep 'calc-ext)) calc-previous-alg-entry (string-match "\\`[-0-9._+*/^() ]+\\'" calc-previous-alg-entry)) (calc-normalize x) - (calc-extensions) + (require 'calc-ext) (math-evaluate-expr x)))) entry))) (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) + (require 'calc-ext) (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))))) @@ -92,7 +87,7 @@ "") ")"))) (if (and (< (length buf) (frame-width)) (= (length entry) 1) - calc-extensions-loaded) + (featurep 'calc-ext)) (let ((long (concat (math-format-value (car entry) 1000) " => " buf))) (if (<= (length long) (- (frame-width) 8)) @@ -148,7 +143,7 @@ ((eq separator 'eval) (eval str)) ((eq separator 'macro) - (calc-extensions) + (require 'calc-ext) (let* ((calc-buffer (current-buffer)) (calc-window (get-buffer-window calc-buffer)) (save-window (selected-window))) @@ -209,7 +204,7 @@ (and (memq 'clear-message calc-command-flags) (message "")) (cond ((eq separator 'pred) - (calc-extensions) + (require 'calc-ext) (if (= (length res) 1) (math-is-true (car res)) (calc-eval-error '(0 "Single value expected")))) @@ -241,9 +236,14 @@ res (cdr res))) buf))))))))) +(defvar calc-eval-error nil + "Determines how calc handles errors. +NIL means return a list containing the character position of error. +STRING means return error message as string rather than list. +T means abort and give an error message.") + (defun calc-eval-error (msg) - (if (and (boundp 'calc-eval-error) - calc-eval-error) + (if calc-eval-error (if (eq calc-eval-error 'string) (nth 1 msg) (error "%s" (nth 1 msg))) @@ -272,19 +272,19 @@ (alg-exp (calc-do-alg-entry initial prompt t))) (if (stringp alg-exp) (progn - (calc-extensions) + (require 'calc-ext) (calc-alg-edit alg-exp)) (let* ((calc-simplify-mode (if (eq last-command-char ?\C-j) 'none calc-simplify-mode)) (nvals (mapcar 'calc-normalize alg-exp))) (while alg-exp - (calc-record (if calc-extensions-loaded (car alg-exp) (car nvals)) + (calc-record (if (featurep 'calc-ext) (car alg-exp) (car nvals)) "alg'") (calc-pop-push-record-list calc-dollar-used (and (not (equal (car alg-exp) (car nvals))) - calc-extensions-loaded + (featurep 'calc-ext) "") (list (car nvals))) (setq alg-exp (cdr alg-exp) @@ -386,6 +386,8 @@ (and (> (length calc-alg-exp) 0) (setq calc-previous-alg-entry calc-alg-exp)) (exit-minibuffer))) +(defvar calc-buffer) + (defun calcAlg-enter () (interactive) (let* ((str (minibuffer-contents)) @@ -443,6 +445,10 @@ ((eq last-command-char ?@) "0@ ") (t (char-to-string last-command-char))))) +;; The variable calc-digit-value is initially declared in calc.el, +;; but can be set by calcDigit-algebraic and calcDigit-edit. +(defvar calc-digit-value) + (defun calcDigit-algebraic () (interactive) (if (calc-minibuffer-contains ".*[@oh] *[^'m ]+[^'m]*\\'") @@ -459,20 +465,22 @@ ;;; Algebraic expression parsing. [Public] -;;; The next few variables are local to math-read-exprs (and math-read-expr) -;;; but are set in functions they call. +;; The next few variables are local to math-read-exprs (and math-read-expr +;; in calc-ext.el), but are set in functions they call. (defvar math-exp-pos) (defvar math-exp-str) (defvar math-exp-old-pos) (defvar math-exp-token) (defvar math-exp-keep-spaces) +(defvar math-expr-data) (defun math-read-exprs (math-exp-str) (let ((math-exp-pos 0) (math-exp-old-pos 0) (math-exp-keep-spaces nil) math-exp-token math-expr-data) + (setq math-exp-str (math-read-preprocess-string math-exp-str)) (if calc-language-input-filter (setq math-exp-str (funcall calc-language-input-filter math-exp-str))) (while (setq math-exp-token (string-match "\\.\\.\\([^.]\\|.[^.]\\)" math-exp-str)) @@ -727,6 +735,9 @@ math-expr-data (char-to-string ch) math-exp-pos (1+ math-exp-pos))))))) +(defconst math-alg-inequalities + '(calcFunc-lt calcFunc-gt calcFunc-leq calcFunc-geq + calcFunc-eq calcFunc-neq)) (defun math-read-expr-level (exp-prec &optional exp-term) (let* ((x (math-read-factor)) (first t) op op2) @@ -771,7 +782,7 @@ (if (not (equal (car op) "2x")) (math-read-token)) (and (memq (nth 1 op) '(sdev mod)) - (calc-extensions)) + (require 'calc-ext)) (setq x (cond ((consp (nth 1 op)) (funcall (car (nth 1 op)) x op)) ((eq (nth 3 op) -1) @@ -787,7 +798,7 @@ ((and (not first) (memq (nth 1 op) math-alg-inequalities) (memq (car-safe x) math-alg-inequalities)) - (calc-extensions) + (require 'calc-ext) (math-composite-inequalities x op)) (t (list (nth 1 op) x @@ -815,7 +826,7 @@ (or (not (listp (setq matches (calc-match-user-syntax rule)))) (let ((args (progn - (calc-extensions) + (require 'calc-ext) calc-arg-values)) (conds nil) temp) @@ -830,7 +841,7 @@ conds) match (nth 1 match))) (while (and conds match) - (calc-extensions) + (require 'calc-ext) (cond ((eq (car-safe (car conds)) 'calcFunc-let) (setq temp (car conds)) @@ -941,10 +952,6 @@ matches "Failed")) matches)) -(defconst math-alg-inequalities - '(calcFunc-lt calcFunc-gt calcFunc-leq calcFunc-geq - calcFunc-eq calcFunc-neq)) - (defun math-remove-dashes (x) (if (string-match "\\`\\(.*\\)-\\(.*\\)\\'" x) (math-remove-dashes @@ -1026,7 +1033,7 @@ (throw 'syntax "Expected `)'")) (math-read-token) (if (and (eq calc-language 'fortran) args - (calc-extensions) + (require 'calc-ext) (let ((calc-matrix-mode 'scalar)) (math-known-matrixp (list 'var sym @@ -1085,7 +1092,7 @@ ((eq math-exp-token 'hash) (or calc-hashes-used (throw 'syntax "#'s not allowed in this context")) - (calc-extensions) + (require 'calc-ext) (if (<= math-expr-data (length calc-arg-values)) (let ((num math-expr-data)) (math-read-token) @@ -1116,7 +1123,7 @@ (setq exp (if (and exp2 (Math-realp exp) (Math-anglep exp2)) (math-normalize (list 'polar exp exp2)) - (calc-extensions) + (require 'calc-ext) (list '* exp (list 'calcFunc-exp (list '* @@ -1143,18 +1150,20 @@ (math-read-token) exp)) ((eq math-exp-token 'string) - (calc-extensions) + (require 'calc-ext) (math-read-string)) ((equal math-expr-data "[") - (calc-extensions) + (require 'calc-ext) (math-read-brackets t "]")) ((equal math-expr-data "{") - (calc-extensions) + (require 'calc-ext) (math-read-brackets nil "}")) ((equal math-expr-data "<") - (calc-extensions) + (require 'calc-ext) (math-read-angle-brackets)) (t (throw 'syntax "Expected a number"))))) +(provide 'calc-aent) + ;;; arch-tag: 5599e45d-e51e-44bb-9a20-9f4ed8c96c32 ;;; calc-aent.el ends here diff --git a/lisp/calc/calc-alg.el b/lisp/calc/calc-alg.el index d64e7d7aac1..4901883d094 100644 --- a/lisp/calc/calc-alg.el +++ b/lisp/calc/calc-alg.el @@ -27,12 +27,10 @@ ;;; Code: ;; This file is autoloaded from calc-ext.el. -(require 'calc-ext) +(require 'calc-ext) (require 'calc-macs) -(defun calc-Need-calc-alg () nil) - ;;; Algebra commands. (defun calc-alg-evaluate (arg) @@ -333,9 +331,19 @@ aa))) -;; Placeholder, to synchronize autoloading. -(defun math-need-std-simps () - nil) +(defmacro math-defsimplify (funcs &rest code) + (append '(progn) + (mapcar (function + (lambda (func) + (list 'put (list 'quote func) ''math-simplify + (list 'nconc + (list 'get (list 'quote func) ''math-simplify) + (list 'list + (list 'function + (append '(lambda (math-simplify-expr)) + code))))))) + (if (symbolp funcs) (list funcs) funcs)))) +(put 'math-defsimplify 'lisp-indent-hook 1) ;; The function created by math-defsimplify uses the variable ;; math-simplify-expr, and so is used by functions in math-defsimplify @@ -1587,14 +1595,18 @@ (defvar math-poly-base-const-ok) (defvar math-poly-base-pred) -(defun math-polynomial-base (mpb-top-expr &optional math-poly-base-pred) +;; The variable math-poly-base-top-expr is local to math-polynomial-base, +;; but is used by math-polynomial-p1 in calc-poly.el, which is called +;; by math-polynomial-base. + +(defun math-polynomial-base (math-poly-base-top-expr &optional math-poly-base-pred) (or math-poly-base-pred (setq math-poly-base-pred (function (lambda (base) (math-polynomial-p - mpb-top-expr base))))) + math-poly-base-top-expr base))))) (or (let ((math-poly-base-const-ok nil)) - (math-polynomial-base-rec mpb-top-expr)) + (math-polynomial-base-rec math-poly-base-top-expr)) (let ((math-poly-base-const-ok t)) - (math-polynomial-base-rec mpb-top-expr)))) + (math-polynomial-base-rec math-poly-base-top-expr)))) (defun math-polynomial-base-rec (mpb-expr) (and (not (Math-objvecp mpb-expr)) @@ -1688,5 +1700,7 @@ (math-scale-int 1 (- (nth 2 f))))))) f)) +(provide 'calc-alg) + ;;; arch-tag: 52e7dcdf-9688-464d-a02b-4bbe789348d0 ;;; calc-alg.el ends here diff --git a/lisp/calc/calc-arith.el b/lisp/calc/calc-arith.el index b8893bb3e1d..3a436cb1d36 100644 --- a/lisp/calc/calc-arith.el +++ b/lisp/calc/calc-arith.el @@ -3,8 +3,7 @@ ;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> -;; Maintainers: D. Goel <deego@gnufans.org> -;; Colin Walters <walters@debian.org> +;; Maintainer: Jay Belanger <belanger@truman.edu> ;; This file is part of GNU Emacs. @@ -28,11 +27,73 @@ ;;; Code: ;; This file is autoloaded from calc-ext.el. -(require 'calc-ext) +(require 'calc-ext) (require 'calc-macs) -(defun calc-Need-calc-arith () nil) +;;; The following lists are not exhaustive. +(defvar math-scalar-functions '(calcFunc-det + calcFunc-cnorm calcFunc-rnorm + calcFunc-vlen calcFunc-vcount + calcFunc-vsum calcFunc-vprod + calcFunc-vmin calcFunc-vmax)) + +(defvar math-nonscalar-functions '(vec calcFunc-idn calcFunc-diag + calcFunc-cvec calcFunc-index + calcFunc-trn + | calcFunc-append + calcFunc-cons calcFunc-rcons + calcFunc-tail calcFunc-rhead)) + +(defvar math-scalar-if-args-functions '(+ - * / neg)) + +(defvar math-real-functions '(calcFunc-arg + calcFunc-re calcFunc-im + calcFunc-floor calcFunc-ceil + calcFunc-trunc calcFunc-round + calcFunc-rounde calcFunc-roundu + calcFunc-ffloor calcFunc-fceil + calcFunc-ftrunc calcFunc-fround + calcFunc-frounde calcFunc-froundu)) + +(defvar math-positive-functions '()) + +(defvar math-nonnegative-functions '(calcFunc-cnorm calcFunc-rnorm + calcFunc-vlen calcFunc-vcount)) + +(defvar math-real-scalar-functions '(% calcFunc-idiv calcFunc-abs + calcFunc-choose calcFunc-perm + calcFunc-eq calcFunc-neq + calcFunc-lt calcFunc-gt + calcFunc-leq calcFunc-geq + calcFunc-lnot + calcFunc-max calcFunc-min)) + +(defvar math-real-if-arg-functions '(calcFunc-sin calcFunc-cos + calcFunc-tan calcFunc-arctan + calcFunc-sinh calcFunc-cosh + calcFunc-tanh calcFunc-exp + calcFunc-gamma calcFunc-fact)) + +(defvar math-integer-functions '(calcFunc-idiv + calcFunc-isqrt calcFunc-ilog + calcFunc-vlen calcFunc-vcount)) + +(defvar math-num-integer-functions '()) + +(defvar math-rounding-functions '(calcFunc-floor + calcFunc-ceil + calcFunc-round calcFunc-trunc + calcFunc-rounde calcFunc-roundu)) + +(defvar math-float-rounding-functions '(calcFunc-ffloor + calcFunc-fceil + calcFunc-fround calcFunc-ftrunc + calcFunc-frounde calcFunc-froundu)) + +(defvar math-integer-if-args-functions '(+ - * % neg calcFunc-abs + calcFunc-min calcFunc-max + calcFunc-choose calcFunc-perm)) ;;; Arithmetic. @@ -164,6 +225,19 @@ ;;; TYPES is a list of type symbols (any, int, frac, ...) ;;; RANGE is a sorted vector of intervals describing the range. +(defvar math-super-types + '((int numint rat real number) + (numint real number) + (frac rat real number) + (rat real number) + (float real number) + (real number) + (number) + (scalar) + (matrix vector) + (vector) + (const))) + (defun math-setup-declarations () (or (eq math-decls-cache-tag (calc-var-value 'var-Decls)) (let ((p (calc-var-value 'var-Decls)) @@ -214,19 +288,6 @@ (error nil))))) (setq math-decls-all (assq 'var-All math-decls-cache))))) -(defvar math-super-types - '((int numint rat real number) - (numint real number) - (frac rat real number) - (rat real number) - (float real number) - (real number) - (number) - (scalar) - (matrix vector) - (vector) - (const))) - (defun math-known-scalarp (a &optional assume-scalar) (math-setup-declarations) (if (if calc-matrix-mode @@ -326,9 +387,12 @@ ((Math-negp a) 1) ((Math-zerop a) 2) ((eq (car a) 'intv) - (cond ((Math-zerop (nth 2 a)) 6) - ((Math-zerop (nth 3 a)) 3) - (t 7))) + (cond + ((math-known-posp (nth 2 a)) 4) + ((math-known-negp (nth 3 a)) 1) + ((Math-zerop (nth 2 a)) 6) + ((Math-zerop (nth 3 a)) 3) + (t 7))) ((eq (car a) 'sdev) (if (math-known-realp (nth 1 a)) 7 15)) (t 8))) @@ -819,71 +883,6 @@ (math-reject-arg a 'objectp 'quiet)))) -;;; The following lists are not exhaustive. -(defvar math-scalar-functions '(calcFunc-det - calcFunc-cnorm calcFunc-rnorm - calcFunc-vlen calcFunc-vcount - calcFunc-vsum calcFunc-vprod - calcFunc-vmin calcFunc-vmax)) - -(defvar math-nonscalar-functions '(vec calcFunc-idn calcFunc-diag - calcFunc-cvec calcFunc-index - calcFunc-trn - | calcFunc-append - calcFunc-cons calcFunc-rcons - calcFunc-tail calcFunc-rhead)) - -(defvar math-scalar-if-args-functions '(+ - * / neg)) - -(defvar math-real-functions '(calcFunc-arg - calcFunc-re calcFunc-im - calcFunc-floor calcFunc-ceil - calcFunc-trunc calcFunc-round - calcFunc-rounde calcFunc-roundu - calcFunc-ffloor calcFunc-fceil - calcFunc-ftrunc calcFunc-fround - calcFunc-frounde calcFunc-froundu)) - -(defvar math-positive-functions '()) - -(defvar math-nonnegative-functions '(calcFunc-cnorm calcFunc-rnorm - calcFunc-vlen calcFunc-vcount)) - -(defvar math-real-scalar-functions '(% calcFunc-idiv calcFunc-abs - calcFunc-choose calcFunc-perm - calcFunc-eq calcFunc-neq - calcFunc-lt calcFunc-gt - calcFunc-leq calcFunc-geq - calcFunc-lnot - calcFunc-max calcFunc-min)) - -(defvar math-real-if-arg-functions '(calcFunc-sin calcFunc-cos - calcFunc-tan calcFunc-arctan - calcFunc-sinh calcFunc-cosh - calcFunc-tanh calcFunc-exp - calcFunc-gamma calcFunc-fact)) - -(defvar math-integer-functions '(calcFunc-idiv - calcFunc-isqrt calcFunc-ilog - calcFunc-vlen calcFunc-vcount)) - -(defvar math-num-integer-functions '()) - -(defvar math-rounding-functions '(calcFunc-floor - calcFunc-ceil - calcFunc-round calcFunc-trunc - calcFunc-rounde calcFunc-roundu)) - -(defvar math-float-rounding-functions '(calcFunc-ffloor - calcFunc-fceil - calcFunc-fround calcFunc-ftrunc - calcFunc-frounde calcFunc-froundu)) - -(defvar math-integer-if-args-functions '(+ - * % neg calcFunc-abs - calcFunc-min calcFunc-max - calcFunc-choose calcFunc-perm)) - - ;;;; Arithmetic. (defsubst calcFunc-neg (a) @@ -1742,23 +1741,35 @@ (math-normalize (list '^ a b))) (defun math-pow-of-zero (a b) - (if (Math-zerop b) - (if calc-infinite-mode - '(var nan var-nan) - (math-reject-arg (list '^ a b) "*Indeterminate form")) - (if (math-floatp b) (setq a (math-float a))) - (if (math-posp b) - a - (if (math-negp b) - (math-div 1 a) - (if (math-infinitep b) - '(var nan var-nan) - (if (and (eq (car b) 'intv) (math-intv-constp b) - calc-infinite-mode) - '(intv 3 (neg (var inf var-inf)) (var inf var-inf)) - (if (math-objectp b) - (list '^ a b) - a))))))) + "Raise A to the power of B, where A is a form of zero." + (if (math-floatp b) (setq a (math-float a))) + (cond + ;; 0^0 = 1 + ((eq b 0) + 1) + ;; 0^0.0, etc., are undetermined + ((Math-zerop b) + (if calc-infinite-mode + '(var nan var-nan) + (math-reject-arg (list '^ a b) "*Indeterminate form"))) + ;; 0^positive = 0 + ((math-known-posp b) + a) + ;; 0^negative is undefined (let math-div handle it) + ((math-known-negp b) + (math-div 1 a)) + ;; 0^infinity is undefined + ((math-infinitep b) + '(var nan var-nan)) + ;; Some intervals + ((and (eq (car b) 'intv) + calc-infinite-mode + (math-negp (nth 2 b)) + (math-posp (nth 3 b))) + '(intv 3 (neg (var inf var-inf)) (var inf var-inf))) + ;; If none of the above, leave it alone. + (t + (list '^ a b)))) (defun math-pow-zero (a b) (if (eq (car-safe a) 'mod) @@ -2185,6 +2196,10 @@ (defalias 'calcFunc-float 'math-float) +;; The variable math-trunc-prec is local to math-trunc in calc-misc.el, +;; but used by math-trunc-fancy which is called by math-trunc. +(defvar math-trunc-prec) + (defun math-trunc-fancy (a) (cond ((eq (car a) 'frac) (math-quotient (nth 1 a) (nth 2 a))) ((eq (car a) 'cplx) (math-trunc (nth 1 a))) @@ -2214,7 +2229,7 @@ (math-trunc (nth 3 a))))) ((math-provably-integerp a) a) ((Math-vectorp a) - (math-map-vec (function (lambda (x) (math-trunc x prec))) a)) + (math-map-vec (function (lambda (x) (math-trunc x math-trunc-prec))) a)) ((math-infinitep a) (if (or (math-posp a) (math-negp a)) a @@ -2251,6 +2266,10 @@ a (math-float (math-trunc a prec)))) +;; The variable math-floor-prec is local to math-floor in calc-misc.el, +;; but used by math-floor-fancy which is called by math-floor. +(defvar math-floor-prec) + (defun math-floor-fancy (a) (cond ((math-provably-integerp a) a) ((eq (car a) 'hms) @@ -2273,7 +2292,7 @@ (math-add (math-floor (nth 3 a)) -1) (math-floor (nth 3 a))))) ((Math-vectorp a) - (math-map-vec (function (lambda (x) (math-floor x prec))) a)) + (math-map-vec (function (lambda (x) (math-floor x math-floor-prec))) a)) ((math-infinitep a) (if (or (math-posp a) (math-negp a)) a @@ -2629,6 +2648,11 @@ (defvar math-combine-prod-e '(var e var-e)) ;;; The following is expanded out four ways for speed. + +;; math-unit-prefixes is defined in calc-units.el, +;; but used here. +(defvar math-unit-prefixes) + (defun math-combine-prod (a b inva invb scalar-okay) (cond ((or (and inva (Math-zerop a)) @@ -2761,23 +2785,28 @@ (math-div a b) (math-mul a b))))) +;; The variable math-com-bterms is local to math-commutative-equal, +;; but is used by math-commutative collect, which is called by +;; math-commutative-equal. +(defvar math-com-bterms) + (defun math-commutative-equal (a b) (if (memq (car-safe a) '(+ -)) (and (memq (car-safe b) '(+ -)) - (let ((bterms nil) aterms p) + (let ((math-com-bterms nil) aterms p) (math-commutative-collect b nil) - (setq aterms bterms bterms nil) + (setq aterms math-com-bterms math-com-bterms nil) (math-commutative-collect a nil) - (and (= (length aterms) (length bterms)) + (and (= (length aterms) (length math-com-bterms)) (progn (while (and aterms (progn - (setq p bterms) + (setq p math-com-bterms) (while (and p (not (equal (car aterms) (car p)))) (setq p (cdr p))) p)) - (setq bterms (delq (car p) bterms) + (setq math-com-bterms (delq (car p) math-com-bterms) aterms (cdr aterms))) (not aterms))))) (equal a b))) @@ -2791,7 +2820,9 @@ (progn (math-commutative-collect (nth 1 b) neg) (math-commutative-collect (nth 2 b) (not neg))) - (setq bterms (cons (if neg (math-neg b) b) bterms))))) + (setq math-com-bterms (cons (if neg (math-neg b) b) math-com-bterms))))) + +(provide 'calc-arith) ;;; arch-tag: 6c396b5b-14c6-40ed-bb2a-7cc2e8111465 ;;; calc-arith.el ends here diff --git a/lisp/calc/calc-bin.el b/lisp/calc/calc-bin.el index aaaa4683fcf..e960220c09b 100644 --- a/lisp/calc/calc-bin.el +++ b/lisp/calc/calc-bin.el @@ -3,8 +3,7 @@ ;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> -;; Maintainers: D. Goel <deego@gnufans.org> -;; Colin Walters <walters@debian.org> +;; Maintainer: Jay Belanger <belanger@truman.edu> ;; This file is part of GNU Emacs. @@ -28,13 +27,10 @@ ;;; Code: ;; This file is autoloaded from calc-ext.el. -(require 'calc-ext) +(require 'calc-ext) (require 'calc-macs) -(defun calc-Need-calc-bin () nil) - - ;;; b-prefix binary commands. (defun calc-and (n) @@ -656,7 +652,8 @@ (let ((fmt (car calc-float-format)) (figs (nth 1 calc-float-format)) (point calc-point-char) - (str nil)) + (str nil) + pos) (if (eq fmt 'fix) (let* ((afigs (math-abs figs)) (fp (math-float-parts a (> afigs 0))) @@ -751,8 +748,8 @@ (if explo (let ((estr (let ((calc-number-radix 10) (calc-group-digits nil)) - (setq estr (math-format-number - (math-sub explo eadj)))))) + (math-format-number + (math-sub explo eadj))))) (setq str (if (or (memq calc-language '(math maple)) (> calc-number-radix 14)) (format "%s*%d.^%s" str calc-number-radix estr) @@ -774,6 +771,7 @@ math-radix-digits-cache)))))))) (defvar math-radix-float-cache-tag nil) +(defvar math-radix-float-cache) (defun math-radix-float-power (n) (if (eq n 0) @@ -803,6 +801,7 @@ calc-number-radix)))))) math-radix-float-cache)))))))) +(provide 'calc-bin) ;;; arch-tag: f6dba7bc-53b2-41ae-919c-c266ab0ca8b3 ;;; calc-bin.el ends here diff --git a/lisp/calc/calc-comb.el b/lisp/calc/calc-comb.el index 8b0dffe3f15..24e3e5f182e 100644 --- a/lisp/calc/calc-comb.el +++ b/lisp/calc/calc-comb.el @@ -3,8 +3,7 @@ ;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> -;; Maintainers: D. Goel <deego@gnufans.org> -;; Colin Walters <walters@debian.org> +;; Maintainer: Jay Belanger <belanger@truman.edu> ;; This file is part of GNU Emacs. @@ -28,12 +27,10 @@ ;;; Code: ;; This file is autoloaded from calc-ext.el. -(require 'calc-ext) +(require 'calc-ext) (require 'calc-macs) -(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 @@ -1020,8 +1017,7 @@ (aref math-primes-table hi)) 2)) - - +(provide 'calc-comb) ;;; arch-tag: 1d75ee9b-0815-42bd-a321-bb3dc001cc02 ;;; calc-comb.el ends here diff --git a/lisp/calc/calc-cplx.el b/lisp/calc/calc-cplx.el index 0f9c0d1cf9b..90d90e666bb 100644 --- a/lisp/calc/calc-cplx.el +++ b/lisp/calc/calc-cplx.el @@ -3,8 +3,7 @@ ;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> -;; Maintainers: D. Goel <deego@gnufans.org> -;; Colin Walters <walters@debian.org> +;; Maintainer: Jay Belanger <belanger@truman.edu> ;; This file is part of GNU Emacs. @@ -28,13 +27,10 @@ ;;; Code: ;; This file is autoloaded from calc-ext.el. -(require 'calc-ext) +(require 'calc-ext) (require 'calc-macs) -(defun calc-Need-calc-cplx () nil) - - (defun calc-argument (arg) (interactive "P") (calc-slow-wrapper @@ -358,5 +354,7 @@ (t (calc-record-why 'numberp a) (list 'calcFunc-im a))))) +(provide 'calc-cplx) + ;;; arch-tag: de73a331-941c-4507-ae76-46c76adc70dd ;;; calc-cplx.el ends here diff --git a/lisp/calc/calc-embed.el b/lisp/calc/calc-embed.el index b3c5a4cff64..067d233bf4a 100644 --- a/lisp/calc/calc-embed.el +++ b/lisp/calc/calc-embed.el @@ -3,8 +3,7 @@ ;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> -;; Maintainers: D. Goel <deego@gnufans.org> -;; Colin Walters <walters@debian.org> +;; Maintainer: Jay Belanger <belanger@truman.edu> ;; This file is part of GNU Emacs. @@ -28,12 +27,10 @@ ;;; Code: ;; This file is autoloaded from calc-ext.el. -(require 'calc-ext) +(require 'calc-ext) (require 'calc-macs) -(defun calc-Need-calc-embed () nil) - (defun calc-show-plain (n) (interactive "P") (calc-wrapper @@ -152,6 +149,16 @@ This is not required to be present for user-written mode annotations.") ;;; rather than using buffer-local variables because the latter are ;;; thrown away when a buffer changes major modes. +;; The variables calc-embed-outer-top, calc-embed-outer-bot, +;; calc-embed-top and calc-embed-bot are +;; local to calc-do-embedded, calc-embedded-mark-formula, +;; calc-embedded-duplicate, calc-embedded-new-formula and +;; calc-embedded-make-info, but are used by calc-embedded-find-bounds, +;; which is called (directly or indirectly) by the above functions. +(defvar calc-embed-outer-top) +(defvar calc-embed-outer-bot) +(defvar calc-embed-top) +(defvar calc-embed-bot) (defvar calc-embedded-quiet nil) (defun calc-do-embedded (arg end obeg oend) @@ -204,7 +211,7 @@ This is not required to be present for user-written mode annotations.") (let ((modes (list mode-line-buffer-identification (current-local-map) truncate-lines)) - top bot outer-top outer-bot + calc-embed-top calc-embed-bot calc-embed-outer-top calc-embed-outer-bot info chg ident) (barf-if-buffer-read-only) (or calc-embedded-globals @@ -300,6 +307,8 @@ This is not required to be present for user-written mode annotations.") (insert str "\n"))) (calc-show-edit-buffer)) +(defvar calc-original-buffer) + (defun calc-embedded-finish-edit (info) (let ((buf (current-buffer)) (str (buffer-substring (point) (point-max))) @@ -320,7 +329,6 @@ This is not required to be present for user-written mode annotations.") (aset info 8 val) (calc-embedded-update info 14 t t)))) -;;;###autoload (defun calc-do-embedded-activate (arg cbuf) (calc-plain-buffer-only) (if arg @@ -388,11 +396,11 @@ With any prefix argument, marks only the formula itself." (interactive "P") (and (eq major-mode 'calc-mode) (error "This command should be used in a normal editing buffer")) - (let (top bot outer-top outer-bot) + (let (calc-embed-top calc-embed-bot calc-embed-outer-top calc-embed-outer-bot) (save-excursion (calc-embedded-find-bounds body-only)) - (push-mark (if body-only bot outer-bot) t) - (goto-char (if body-only top outer-top)))) + (push-mark (if body-only calc-embed-bot calc-embed-outer-bot) t) + (goto-char (if body-only calc-embed-top calc-embed-outer-top)))) (defun calc-embedded-find-bounds (&optional plain) ;; (while (and (bolp) (eq (following-char) ?\n)) @@ -407,7 +415,7 @@ With any prefix argument, marks only the formula itself." (and (eq (preceding-char) ?\$) ; backward search for \$\$? won't back (eq (following-char) ?\$) ; up over a second $, so do it by hand. (forward-char -1)) - (setq outer-top (point)) + (setq calc-embed-outer-top (point)) (goto-char (match-end 0)) (if (eq (following-char) ?\n) (forward-char 1)) @@ -419,21 +427,21 @@ With any prefix argument, marks only the formula itself." (progn (goto-char (match-end 0)) (search-forward calc-embedded-close-plain)))) - (setq top (point)) + (setq calc-embed-top (point)) (or (re-search-forward calc-embedded-close-formula nil t) (error "Can't find end of formula")) (if (< (point) home) (error "Not inside a formula")) (and (eq (following-char) ?\n) (not (bolp)) (forward-char 1)) - (setq outer-bot (point)) + (setq calc-embed-outer-bot (point)) (goto-char (match-beginning 0)) (if (eq (preceding-char) ?\n) (backward-char 1)) (or (eolp) (while (eq (preceding-char) ?\ ) (backward-char 1))) - (setq bot (point)))) + (setq calc-embed-bot (point)))) (defun calc-embedded-kill-formula () "Kill the formula surrounding point. @@ -458,25 +466,26 @@ The command \\[yank] can retrieve it from there." (defun calc-embedded-duplicate () (interactive) (let ((already calc-embedded-info) - top bot outer-top outer-bot new-top) + calc-embed-top calc-embed-bot calc-embed-outer-top calc-embed-outer-bot new-top) (if calc-embedded-info (progn - (setq top (+ (aref calc-embedded-info 2)) - bot (+ (aref calc-embedded-info 3)) - outer-top (+ (aref calc-embedded-info 4)) - outer-bot (+ (aref calc-embedded-info 5))) + (setq calc-embed-top (+ (aref calc-embedded-info 2)) + calc-embed-bot (+ (aref calc-embedded-info 3)) + calc-embed-outer-top (+ (aref calc-embedded-info 4)) + calc-embed-outer-bot (+ (aref calc-embedded-info 5))) (calc-embedded nil)) (calc-embedded-find-bounds)) - (goto-char outer-bot) + (goto-char calc-embed-outer-bot) (insert "\n") (setq new-top (point)) - (insert-buffer-substring (current-buffer) outer-top outer-bot) - (goto-char (+ new-top (- top outer-top))) + (insert-buffer-substring (current-buffer) + calc-embed-outer-top calc-embed-outer-bot) + (goto-char (+ new-top (- calc-embed-top calc-embed-outer-top))) (let ((calc-embedded-quiet (if already t 'x))) - (calc-embedded (+ new-top (- top outer-top)) - (+ new-top (- bot outer-top)) + (calc-embedded (+ new-top (- calc-embed-top calc-embed-outer-top)) + (+ new-top (- calc-embed-bot calc-embed-outer-top)) new-top - (+ new-top (- outer-bot outer-top)))))) + (+ new-top (- calc-embed-outer-bot calc-embed-outer-top)))))) (defun calc-embedded-next (arg) (interactive "P") @@ -515,26 +524,26 @@ The command \\[yank] can retrieve it from there." (error "This command should be used in a normal editing buffer")) (if calc-embedded-info (calc-embedded nil)) - (let (top bot outer-top outer-bot) + (let (calc-embed-top calc-embed-bot calc-embed-outer-top calc-embed-outer-bot) (if (and (eq (preceding-char) ?\n) (string-match "\\`\n" calc-embedded-open-new-formula)) (progn - (setq outer-top (1- (point))) + (setq calc-embed-outer-top (1- (point))) (forward-char -1) (insert (substring calc-embedded-open-new-formula 1))) - (setq outer-top (point)) + (setq calc-embed-outer-top (point)) (insert calc-embedded-open-new-formula)) - (setq top (point)) + (setq calc-embed-top (point)) (insert " ") - (setq bot (point)) + (setq calc-embed-bot (point)) (insert calc-embedded-close-new-formula) (if (and (eq (following-char) ?\n) (string-match "\n\\'" calc-embedded-close-new-formula)) (delete-char 1)) - (setq outer-bot (point)) - (goto-char top) + (setq calc-embed-outer-bot (point)) + (goto-char calc-embed-top) (let ((calc-embedded-quiet 'x)) - (calc-embedded top bot outer-top outer-bot)))) + (calc-embedded calc-embed-top calc-embed-bot calc-embed-outer-top calc-embed-outer-bot)))) (defun calc-embedded-forget () (interactive) @@ -542,6 +551,9 @@ The command \\[yank] can retrieve it from there." calc-embedded-active)) (calc-embedded-active-state nil)) +;; The variables calc-embed-prev-modes is local to calc-embedded-update, +;; but is used by calc-embedded-set-modes. +(defvar calc-embed-prev-modes) (defun calc-embedded-set-modes (gmodes modes local-modes &optional temp) (let ((the-language (calc-embedded-language)) @@ -561,9 +573,10 @@ The command \\[yank] can retrieve it from there." (equal (symbol-value (car (car v))) value)) (progn (setq changed t) - (if temp (setq prev-modes (cons (cons (car (car v)) - (symbol-value (car (car v)))) - prev-modes))) + (if temp (setq calc-embed-prev-modes + (cons (cons (car (car v)) + (symbol-value (car (car v)))) + calc-embed-prev-modes))) (set (car (car v)) value))) (setq v (cdr v))) (setq v modes) @@ -574,9 +587,9 @@ The command \\[yank] can retrieve it from there." (equal (symbol-value (car (car v))) value) (progn (setq changed t) - (if temp (setq prev-modes (cons (cons (car (car v)) + (if temp (setq calc-embed-prev-modes (cons (cons (car (car v)) (symbol-value (car (car v)))) - prev-modes))) + calc-embed-prev-modes))) (set (car (car v)) value))) (setq v (cdr v))) (setq v local-modes) @@ -585,9 +598,9 @@ The command \\[yank] can retrieve it from there." (equal (symbol-value (car (car v))) value) (progn (setq changed t) - (if temp (setq prev-modes (cons (cons (car (car v)) + (if temp (setq calc-embed-prev-modes (cons (cons (car (car v)) (symbol-value (car (car v)))) - prev-modes))) + calc-embed-prev-modes))) (set (car (car v)) value))) (setq v (cdr v))) (and changed (not (eq temp t)) @@ -704,13 +717,18 @@ The command \\[yank] can retrieve it from there." (goto-char save-pt) (list modes emodes pmodes))) +;; The variable calc-embed-vars-used is local to calc-embedded-make-info, +;; calc-embedded-evaluate-expr and calc-embedded-update, but is +;; used by calc-embedded-find-vars, which is called by the above functions. +(defvar calc-embed-vars-used) (defun calc-embedded-make-info (point cbuf fresh &optional - top bot outer-top outer-bot) + calc-embed-top calc-embed-bot + calc-embed-outer-top calc-embed-outer-bot) (let* ((bufentry (assq (current-buffer) calc-embedded-active)) (found bufentry) - (force (and fresh top)) - (fixed top) + (force (and fresh calc-embed-top)) + (fixed calc-embed-top) (new-info nil) info str) (or found @@ -729,7 +747,8 @@ The command \\[yank] can retrieve it from there." (aset info 1 (or cbuf (save-excursion (calc-create-buffer) (current-buffer))))) - (if (and (integerp top) (not bot)) ; started with a user-supplied argument + (if (and (integerp calc-embed-top) (not calc-embed-bot)) + ; started with a user-supplied argument (progn (if (= (setq arg (prefix-numeric-value arg)) 0) (progn @@ -741,18 +760,18 @@ The command \\[yank] can retrieve it from there." (aset info 4 (copy-marker (aref info 2))) (aset info 5 (copy-marker (aref info 3)))) (if (aref info 4) - (setq top (aref info 2) - fixed top) - (if (consp top) + (setq calc-embed-top (aref info 2) + fixed calc-embed-top) + (if (consp calc-embed-top) (let ((calc-embedded-open-formula calc-embedded-open-word) (calc-embedded-close-formula calc-embedded-close-word)) (calc-embedded-find-bounds 'plain)) - (or top + (or calc-embed-top (calc-embedded-find-bounds 'plain))) - (aset info 2 (copy-marker (min top bot))) - (aset info 3 (copy-marker (max top bot))) - (aset info 4 (copy-marker (or outer-top (aref info 2)))) - (aset info 5 (copy-marker (or outer-bot (aref info 3)))))) + (aset info 2 (copy-marker (min calc-embed-top calc-embed-bot))) + (aset info 3 (copy-marker (max calc-embed-top calc-embed-bot))) + (aset info 4 (copy-marker (or calc-embed-outer-top (aref info 2)))) + (aset info 5 (copy-marker (or calc-embed-outer-bot (aref info 3)))))) (goto-char (aref info 2)) (if new-info (progn @@ -776,7 +795,7 @@ The command \\[yank] can retrieve it from there." (let* ((open-plain calc-embedded-open-plain) (close-plain calc-embedded-close-plain) (pref-len (length open-plain)) - (vars-used nil) + (calc-embed-vars-used nil) suff-pos val temp) (save-excursion (set-buffer (aref info 1)) @@ -810,7 +829,7 @@ The command \\[yank] can retrieve it from there." (nth 1 temp))) (if (memq (car-safe val) '(calcFunc-evalto calcFunc-assign)) (calc-embedded-find-vars val)) - (aset info 10 vars-used) + (aset info 10 calc-embed-vars-used) (aset info 11 nil)))) (if new-info (progn @@ -821,8 +840,8 @@ The command \\[yank] can retrieve it from there." (defun calc-embedded-find-vars (x) (cond ((Math-primp x) (and (eq (car-safe x) 'var) - (not (assoc x vars-used)) - (setq vars-used (cons (list x) vars-used)))) + (not (assoc x calc-embed-vars-used)) + (setq calc-embed-vars-used (cons (list x) calc-embed-vars-used)))) ((eq (car x) 'calcFunc-evalto) (calc-embedded-find-vars (nth 1 x))) ((eq (car x) 'calcFunc-assign) @@ -831,16 +850,16 @@ The command \\[yank] can retrieve it from there." (and (eq (car x) 'calcFunc-subscr) (eq (car-safe (nth 1 x)) 'var) (Math-primp (nth 2 x)) - (not (assoc x vars-used)) - (setq vars-used (cons (list x) vars-used))) + (not (assoc x calc-embed-vars-used)) + (setq calc-embed-vars-used (cons (list x) calc-embed-vars-used))) (while (setq x (cdr x)) (calc-embedded-find-vars (car x)))))) (defun calc-embedded-evaluate-expr (x) - (let ((vars-used (aref calc-embedded-info 10))) - (or vars-used (calc-embedded-find-vars x)) - (if vars-used + (let ((calc-embed-vars-used (aref calc-embedded-info 10))) + (or calc-embed-vars-used (calc-embedded-find-vars x)) + (if calc-embed-vars-used (let ((active (assq (aref calc-embedded-info 0) calc-embedded-active)) (args nil)) (save-excursion @@ -850,9 +869,9 @@ The command \\[yank] can retrieve it from there." (calc-embedded-activate) (setq active (assq (aref calc-embedded-info 0) calc-embedded-active)))) - (while vars-used - (calc-embedded-eval-get-var (car (car vars-used)) active) - (setq vars-used (cdr vars-used)))) + (while calc-embed-vars-used + (calc-embedded-eval-get-var (car (car calc-embed-vars-used)) active) + (setq calc-embed-vars-used (cdr calc-embed-vars-used)))) (calc-embedded-subst x)) (calc-normalize (math-evaluate-expr-rec x))))) @@ -900,10 +919,10 @@ The command \\[yank] can retrieve it from there." (defun calc-embedded-update (info which need-eval need-display &optional str entry old-val) - (let* ((prev-modes nil) + (let* ((calc-embed-prev-modes nil) (open-plain calc-embedded-open-plain) (close-plain calc-embedded-close-plain) - (vars-used nil) + (calc-embed-vars-used nil) (evalled nil) (val (aref info 8)) (old-eval (aref info 11))) @@ -926,7 +945,7 @@ The command \\[yank] can retrieve it from there." (if (or (eq need-eval 'eval) (eq (car-safe val) 'calcFunc-evalto)) (aset info 8 val)) (aset info 9 nil) - (aset info 10 vars-used) + (aset info 10 calc-embed-vars-used) (aset info 11 nil) (if (or need-display (eq (car-safe val) 'calcFunc-evalto)) (let ((extra (if (eq calc-language 'big) 1 0))) @@ -978,16 +997,17 @@ The command \\[yank] can retrieve it from there." (if (eq (car-safe old-val) 'calcFunc-assign) (calc-embedded-var-change (nth 1 old-val) (aref info 0))))) (set-buffer (aref info 1)) - (while prev-modes - (cond ((eq (car (car prev-modes)) 'the-language) + (while calc-embed-prev-modes + (cond ((eq (car (car calc-embed-prev-modes)) 'the-language) (if need-display - (calc-embedded-set-language (cdr (car prev-modes))))) - ((eq (car (car prev-modes)) 'the-display-just) + (calc-embedded-set-language (cdr (car calc-embed-prev-modes))))) + ((eq (car (car calc-embed-prev-modes)) 'the-display-just) (if need-display - (calc-embedded-set-justify (cdr (car prev-modes))))) + (calc-embedded-set-justify (cdr (car calc-embed-prev-modes))))) (t - (set (car (car prev-modes)) (cdr (car prev-modes))))) - (setq prev-modes (cdr prev-modes)))))) + (set (car (car calc-embed-prev-modes)) + (cdr (car calc-embed-prev-modes))))) + (setq calc-embed-prev-modes (cdr calc-embed-prev-modes)))))) @@ -1203,5 +1223,7 @@ The command \\[yank] can retrieve it from there." (setq bp (if buf nil (cdr bp)))) (or first calc-embedded-quiet (message ""))))) +(provide 'calc-embed) + ;;; arch-tag: 1b8f311e-fba1-40d3-b8c3-1d6f68fd26fc ;;; calc-embed.el ends here diff --git a/lisp/calc/calc-ext.el b/lisp/calc/calc-ext.el index 249e6bc2b79..d308a391a05 100644 --- a/lisp/calc/calc-ext.el +++ b/lisp/calc/calc-ext.el @@ -26,26 +26,7 @@ ;;; Code: -(provide 'calc-ext) (require 'calc) - -(setq calc-extensions-loaded t) - -;;; This function is the autoload "hook" to cause this file to be loaded. -;;;###autoload -(defun calc-extensions () - "This function is part of the autoload linkage for parts of Calc." - t) - -;;; Auto-load calc.el part, in case this part was loaded first. -(if (fboundp 'calc-dispatch) - (and (eq (car-safe (symbol-function 'calc-dispatch)) 'autoload) - (load (nth 1 (symbol-function 'calc-dispatch)))) - (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"))) - (require 'calc-macs) (defvar math-simplifying nil) @@ -668,7 +649,7 @@ (autoload func (car x)))) (cdr x)))) '( - ("calc-alg" calc-Need-calc-alg calc-has-rules + ("calc-alg" calc-has-rules math-defsimplify calc-modify-simplify-mode calcFunc-collect calcFunc-esimplify calcFunc-islin calcFunc-islinnt calcFunc-lin calcFunc-linnt calcFunc-simplify calcFunc-subst math-beforep @@ -676,13 +657,13 @@ math-build-polynomial-expr math-expand-formula math-expr-contains math-expr-contains-count math-expr-depends math-expr-height math-expr-subst math-expr-weight math-integer-plus math-is-linear math-is-multiple math-is-polynomial math-linear-in math-multiple-of -math-need-std-simps math-poly-depends math-poly-mix math-poly-mul +math-poly-depends math-poly-mix math-poly-mul math-poly-simplify math-poly-zerop math-polynomial-base math-polynomial-p math-recompile-eval-rules math-simplify math-simplify-exp math-simplify-extended math-simplify-sqrt math-to-simple-fraction) - ("calcalg2" calc-Need-calc-alg-2 calcFunc-asum calcFunc-deriv + ("calcalg2" calcFunc-asum calcFunc-deriv calcFunc-ffinv calcFunc-finv calcFunc-fsolve calcFunc-gpoly calcFunc-integ calcFunc-poly calcFunc-prod calcFunc-roots calcFunc-solve calcFunc-sum calcFunc-table calcFunc-taylor @@ -691,7 +672,7 @@ math-integral-rational-funcs math-lcm-denoms math-looks-evenp math-poly-all-roots math-prod-rec math-reject-solution math-solve-eqn math-solve-for math-sum-rec math-try-integral) - ("calcalg3" calc-Need-calc-alg-3 calcFunc-efit calcFunc-fit + ("calcalg3" calcFunc-efit calcFunc-fit calcFunc-fitdummy calcFunc-fitparam calcFunc-fitvar calcFunc-hasfitparams calcFunc-hasfitvars calcFunc-maximize calcFunc-minimize calcFunc-ninteg calcFunc-polint calcFunc-ratint @@ -699,7 +680,7 @@ calcFunc-root calcFunc-wmaximize calcFunc-wminimize calcFunc-wroot calcFunc-xfit math-find-minimum math-find-root math-ninteg-evaluate math-ninteg-midpoint math-ninteg-romberg math-poly-interp) - ("calc-arith" calc-Need-calc-arith calcFunc-abs calcFunc-abssqr + ("calc-arith" calcFunc-abs calcFunc-abssqr calcFunc-add calcFunc-ceil calcFunc-decr calcFunc-deven calcFunc-dimag calcFunc-dint calcFunc-div calcFunc-dnatnum calcFunc-dneg calcFunc-dnonneg calcFunc-dnonzero calcFunc-dnumint calcFunc-dodd @@ -725,7 +706,7 @@ math-pow-fancy math-pow-mod math-pow-of-zero math-pow-zero math-quarter-integer math-round math-setup-declarations math-sqr math-sqr-float math-trunc-fancy math-trunc-special) - ("calc-bin" calc-Need-calc-bin calcFunc-and calcFunc-ash + ("calc-bin" calcFunc-and calcFunc-ash calcFunc-clip calcFunc-diff calcFunc-lsh calcFunc-not calcFunc-or calcFunc-rash calcFunc-rot calcFunc-rsh calcFunc-xor math-clip math-compute-max-digits math-convert-radix-digits math-float-parts @@ -734,7 +715,7 @@ math-format-bignum-octal math-format-bignum-radix math-format-binary math-format-radix math-format-radix-float math-integer-log2 math-power-of-2 math-radix-float-power) - ("calc-comb" calc-Need-calc-comb calc-report-prime-test + ("calc-comb" calc-report-prime-test calcFunc-choose calcFunc-dfact calcFunc-egcd calcFunc-fact calcFunc-gcd calcFunc-lcm calcFunc-moebius calcFunc-nextprime calcFunc-perm calcFunc-prevprime calcFunc-prfac calcFunc-prime @@ -742,28 +723,28 @@ calcFunc-random calcFunc-shuffle calcFunc-stir1 calcFunc-stir2 calcFunc-totient math-init-random-base math-member math-prime-test math-random-base) - ("calccomp" calc-Need-calc-comp calcFunc-cascent calcFunc-cdescent + ("calccomp" calcFunc-cascent calcFunc-cdescent calcFunc-cheight calcFunc-cwidth math-comp-ascent math-comp-descent math-comp-height math-comp-width math-compose-expr math-composition-to-string math-stack-value-offset-fancy math-vector-is-string math-vector-to-string) - ("calc-cplx" calc-Need-calc-cplx calcFunc-arg calcFunc-conj + ("calc-cplx" calcFunc-arg calcFunc-conj calcFunc-im calcFunc-polar calcFunc-re calcFunc-rect math-complex math-fix-circular math-imaginary math-imaginary-i math-normalize-polar math-polar math-want-polar) - ("calc-embed" calc-Need-calc-embed calc-do-embedded + ("calc-embed" calc-do-embedded calc-do-embedded-activate calc-embedded-evaluate-expr calc-embedded-modes-change calc-embedded-var-change) - ("calc-fin" calc-Need-calc-fin calc-to-percentage calcFunc-ddb + ("calc-fin" calc-to-percentage calcFunc-ddb calcFunc-fv calcFunc-fvb calcFunc-fvl calcFunc-irr calcFunc-irrb calcFunc-nper calcFunc-nperb calcFunc-nperl calcFunc-npv calcFunc-npvb calcFunc-pmt calcFunc-pmtb calcFunc-pv calcFunc-pvb calcFunc-pvl calcFunc-rate calcFunc-rateb calcFunc-ratel calcFunc-sln calcFunc-syd) - ("calc-forms" calc-Need-calc-forms calcFunc-badd calcFunc-bsub + ("calc-forms" calcFunc-badd calcFunc-bsub calcFunc-date calcFunc-day calcFunc-dsadj calcFunc-hms calcFunc-holiday calcFunc-hour calcFunc-incmonth calcFunc-incyear calcFunc-intv calcFunc-julian calcFunc-makemod calcFunc-minute @@ -778,11 +759,11 @@ math-normalize-mod math-parse-date math-read-angle-brackets math-setup-add-holidays math-setup-holidays math-setup-year-holidays math-sort-intv math-to-business-day math-to-hms) - ("calc-frac" calc-Need-calc-frac calc-add-fractions + ("calc-frac" calc-add-fractions calc-div-fractions calc-mul-fractions calcFunc-fdiv calcFunc-frac math-make-frac) - ("calc-funcs" calc-Need-calc-funcs calc-prob-dist calcFunc-bern + ("calc-funcs" calc-prob-dist calcFunc-bern calcFunc-besJ calcFunc-besY calcFunc-beta calcFunc-betaB calcFunc-betaI calcFunc-erf calcFunc-erfc calcFunc-euler calcFunc-gamma calcFunc-gammaG calcFunc-gammaP calcFunc-gammaQ @@ -791,20 +772,18 @@ calcFunc-ltpn calcFunc-ltpp calcFunc-ltpt calcFunc-utpb calcFunc-utpc calcFunc-utpf calcFunc-utpn calcFunc-utpp calcFunc-utpt math-bernoulli-number math-gammap1-raw) - ("calc-graph" calc-Need-calc-graph calc-graph-show-tty) - - ("calc-help" calc-Need-calc-help) + ("calc-graph" calc-graph-show-tty) - ("calc-incom" calc-Need-calc-incom calc-digit-dots) + ("calc-incom" calc-digit-dots) - ("calc-keypd" calc-Need-calc-keypd calc-do-keypad + ("calc-keypd" calc-do-keypad calc-keypad-x-left-click calc-keypad-x-middle-click calc-keypad-x-right-click) - ("calc-lang" calc-Need-calc-lang calc-set-language + ("calc-lang" calc-set-language math-read-big-balance math-read-big-rec) - ("calc-map" calc-Need-calc-map calc-get-operator calcFunc-accum + ("calc-map" calc-get-operator calcFunc-accum calcFunc-afixp calcFunc-anest calcFunc-apply calcFunc-call calcFunc-fixp calcFunc-inner calcFunc-map calcFunc-mapa calcFunc-mapc calcFunc-mapd calcFunc-mapeq calcFunc-mapeqp calcFunc-mapeqr @@ -815,11 +794,11 @@ calcFunc-rreduced calcFunc-rreducer math-build-call math-calcFunc-to-var math-multi-subst math-multi-subst-rec math-var-to-calcFunc) - ("calc-mtx" calc-Need-calc-mat calcFunc-det calcFunc-lud calcFunc-tr + ("calc-mtx" calcFunc-det calcFunc-lud calcFunc-tr math-col-matrix math-lud-solve math-matrix-inv-raw math-matrix-lud math-mul-mat-vec math-mul-mats math-row-matrix) - ("calc-math" calc-Need-calc-math calcFunc-alog calcFunc-arccos + ("calc-math" calcFunc-alog calcFunc-arccos calcFunc-arccosh calcFunc-arcsin calcFunc-arcsincos calcFunc-arcsinh calcFunc-arctan calcFunc-arctan2 calcFunc-arctanh calcFunc-cos calcFunc-cosh calcFunc-deg calcFunc-exp calcFunc-exp10 calcFunc-expm1 @@ -834,9 +813,9 @@ math-nearly-zerop math-nearly-zerop-float math-nth-root math-sin-cos-raw math-sin-raw math-sqrt math-sqrt-float math-sqrt-raw math-tan-raw math-to-radians math-to-radians-2) - ("calc-mode" calc-Need-calc-mode math-get-modes-vec) + ("calc-mode" math-get-modes-vec) - ("calc-poly" calc-Need-calc-poly calcFunc-apart calcFunc-expand + ("calc-poly" calcFunc-apart calcFunc-expand calcFunc-expandpow calcFunc-factor calcFunc-factors calcFunc-nrat calcFunc-pcont calcFunc-pdeg calcFunc-pdiv calcFunc-pdivide calcFunc-pdivrem calcFunc-pgcd calcFunc-plead calcFunc-pprim @@ -849,7 +828,7 @@ math-partial-fractions math-poly-degree math-poly-deriv-coefs math-poly-gcd-frac-list math-poly-modulus-rec math-ratpoly-p math-to-ratpoly math-to-ratpoly-rec) - ("calc-prog" calc-Need-calc-prog calc-default-formula-arglist + ("calc-prog" calc-default-formula-arglist calc-execute-kbd-macro calc-finish-user-syntax-edit calc-fix-token-name calc-fix-user-formula calc-read-parse-table calc-read-parse-table-part calc-subsetp calc-write-parse-table @@ -862,7 +841,7 @@ math-body-refers-to math-break math-composite-inequalities math-do-defmath math-handle-for math-handle-foreach math-normalize-logical-op math-return) - ("calc-rewr" calc-Need-calc-rewr calcFunc-match calcFunc-matches + ("calc-rewr" calcFunc-match calcFunc-matches calcFunc-matchnot calcFunc-rewrite calcFunc-vmatches math-apply-rewrites math-compile-patterns math-compile-rewrites math-flatten-lands math-match-patterns math-rewrite @@ -870,43 +849,37 @@ math-rewrite-heads) ("calc-rules" calc-CommuteRules calc-DistribRules calc-FactorRules calc-FitRules calc-IntegAfterRules calc-InvertRules calc-JumpRules -calc-MergeRules calc-Need-calc-rules calc-NegateRules +calc-MergeRules calc-NegateRules calc-compile-rule-set) - ("calc-sel" calc-Need-calc-sel calc-auto-selection + ("calc-sel" calc-auto-selection calc-delete-selection calc-encase-atoms calc-find-assoc-parent-formula calc-find-parent-formula calc-find-sub-formula calc-prepare-selection calc-preserve-point calc-replace-selections calc-replace-sub-formula calc-roll-down-with-selections calc-roll-up-with-selections calc-sel-error) - ("calcsel2" calc-Need-calc-sel-2) - - ("calc-stat" calc-Need-calc-stat calc-vector-op calcFunc-agmean + ("calc-stat" calc-vector-op calcFunc-agmean calcFunc-vcorr calcFunc-vcount calcFunc-vcov calcFunc-vflat calcFunc-vgmean calcFunc-vhmean calcFunc-vmax calcFunc-vmean calcFunc-vmeane calcFunc-vmedian calcFunc-vmin calcFunc-vpcov calcFunc-vprod calcFunc-vpsdev calcFunc-vpvar calcFunc-vsdev calcFunc-vsum calcFunc-vvar math-flatten-many-vecs) - ("calc-store" calc-Need-calc-store calc-read-var-name + ("calc-store" calc-read-var-name calc-store-value calc-var-name) - ("calc-stuff" calc-Need-calc-stuff calc-explain-why calcFunc-clean + ("calc-stuff" calc-explain-why calcFunc-clean calcFunc-pclean calcFunc-pfloat calcFunc-pfrac) - ("calc-trail" calc-Need-calc-trail) - - ("calc-undo" calc-Need-calc-undo) - - ("calc-units" calc-Need-calc-units calcFunc-usimplify + ("calc-units" calcFunc-usimplify math-build-units-table math-build-units-table-buffer math-check-unit-name math-convert-temperature math-convert-units math-extract-units math-remove-units math-simplify-units math-single-units-in-expr-p math-to-standard-units math-units-in-expr-p) - ("calc-vec" calc-Need-calc-vec calcFunc-append calcFunc-appendrev + ("calc-vec" calcFunc-append calcFunc-appendrev calcFunc-arrange calcFunc-cnorm calcFunc-cons calcFunc-cross calcFunc-ctrn calcFunc-cvec calcFunc-diag calcFunc-find calcFunc-getdiag calcFunc-grade calcFunc-head calcFunc-histogram @@ -925,7 +898,7 @@ math-dimension-error math-dot-product math-flatten-vector math-map-vec math-map-vec-2 math-mat-col math-mimic-ident math-prepare-set math-read-brackets math-reduce-cols math-reduce-vec math-transpose) - ("calc-yank" calc-Need-calc-yank calc-alg-edit calc-clean-newlines + ("calc-yank" calc-alg-edit calc-clean-newlines calc-do-grab-rectangle calc-do-grab-region calc-finish-stack-edit calc-force-refresh calc-locate-cursor-element calc-show-edit-buffer) @@ -1176,6 +1149,9 @@ calc-kill calc-kill-region calc-yank)))) ;;;; Miscellaneous. +;; calc-command-flags is declared in calc.el +(defvar calc-command-flags) + (defun calc-clear-command-flag (f) (setq calc-command-flags (delq f calc-command-flags))) @@ -1342,7 +1318,16 @@ calc-kill calc-kill-region calc-yank)))) (defun calc-inverse (&optional n) (interactive "P") - (calc-fancy-prefix 'calc-inverse-flag "Inverse..." n)) + (let* ((hyp-flag (if (or + (eq major-mode 'calc-keypad-mode) + (eq major-mode 'calc-trail-mode)) + (with-current-buffer calc-main-buffer + calc-hyperbolic-flag) + calc-hyperbolic-flag)) + (msg (if hyp-flag + "Inverse Hyperbolic..." + "Inverse..."))) + (calc-fancy-prefix 'calc-inverse-flag msg n))) (defconst calc-fancy-prefix-map (let ((map (make-sparse-keymap))) @@ -1410,7 +1395,16 @@ calc-kill calc-kill-region calc-yank)))) (defun calc-hyperbolic (&optional n) (interactive "P") - (calc-fancy-prefix 'calc-hyperbolic-flag "Hyperbolic..." n)) + (let* ((inv-flag (if (or + (eq major-mode 'calc-keypad-mode) + (eq major-mode 'calc-trail-mode)) + (with-current-buffer calc-main-buffer + calc-inverse-flag) + calc-inverse-flag)) + (msg (if inv-flag + "Inverse Hyperbolic..." + "Hyperbolic..."))) + (calc-fancy-prefix 'calc-hyperbolic-flag msg n))) (defun calc-hyperbolic-func () (save-excursion @@ -1654,7 +1648,8 @@ calc-kill calc-kill-region calc-yank)))) (defvar calc-gnuplot-process nil) - +(defvar calc-gnuplot-input) +(defvar calc-gnuplot-buffer) (defun calc-gnuplot-alive () (and calc-gnuplot-process @@ -1670,47 +1665,45 @@ calc-kill calc-kill-region calc-yank)))) (defun calc-load-everything () (interactive) - (calc-need-macros) ; calc-macs.el - (calc-record-list nil) ; calc-misc.el - (math-read-exprs "0") ; calc-aent.el - -;;;; (Loads here) - (calc-Need-calc-alg-2) - (calc-Need-calc-alg-3) - (calc-Need-calc-alg) - (calc-Need-calc-arith) - (calc-Need-calc-bin) - (calc-Need-calc-comb) - (calc-Need-calc-comp) - (calc-Need-calc-cplx) - (calc-Need-calc-embed) - (calc-Need-calc-fin) - (calc-Need-calc-forms) - (calc-Need-calc-frac) - (calc-Need-calc-funcs) - (calc-Need-calc-graph) - (calc-Need-calc-help) - (calc-Need-calc-incom) - (calc-Need-calc-keypd) - (calc-Need-calc-lang) - (calc-Need-calc-map) - (calc-Need-calc-mat) - (calc-Need-calc-math) - (calc-Need-calc-mode) - (calc-Need-calc-poly) - (calc-Need-calc-prog) - (calc-Need-calc-rewr) - (calc-Need-calc-rules) - (calc-Need-calc-sel-2) - (calc-Need-calc-sel) - (calc-Need-calc-stat) - (calc-Need-calc-store) - (calc-Need-calc-stuff) - (calc-Need-calc-trail) - (calc-Need-calc-undo) - (calc-Need-calc-units) - (calc-Need-calc-vec) - (calc-Need-calc-yank) + (require 'calc-aent) + (require 'calc-alg) + (require 'calc-arith) + (require 'calc-bin) + (require 'calc-comb) + (require 'calc-cplx) + (require 'calc-embed) + (require 'calc-fin) + (require 'calc-forms) + (require 'calc-frac) + (require 'calc-funcs) + (require 'calc-graph) + (require 'calc-help) + (require 'calc-incom) + (require 'calc-keypd) + (require 'calc-lang) + (require 'calc-macs) + (require 'calc-map) + (require 'calc-math) + (require 'calc-misc) + (require 'calc-mode) + (require 'calc-mtx) + (require 'calc-poly) + (require 'calc-prog) + (require 'calc-rewr) + (require 'calc-rules) + (require 'calc-sel) + (require 'calc-stat) + (require 'calc-store) + (require 'calc-stuff) + (require 'calc-trail) + (require 'calc-undo) + (require 'calc-units) + (require 'calc-vec) + (require 'calc-yank) + (require 'calcalg2) + (require 'calcalg3) + (require 'calccomp) + (require 'calcsel2) (message "All parts of Calc are now loaded")) @@ -2217,6 +2210,11 @@ calc-kill calc-kill-region calc-yank)))) (math-normalize (car a)) (error "Can't use multi-valued function in an expression"))))) +;; The variable math-normalize-a is local to math-normalize in calc.el, +;; but is used by math-normalize-nonstandard, which is called by +;; math-normalize. +(defvar math-normalize-a) + (defun math-normalize-nonstandard () (if (consp calc-simplify-mode) (progn @@ -2591,20 +2589,6 @@ calc-kill calc-kill-region calc-yank)))) (cons (car x) (mapcar 'math-evaluate-expr-rec (cdr x)))))) x)) -(defmacro math-defsimplify (funcs &rest code) - (append '(progn (math-need-std-simps)) - (mapcar (function - (lambda (func) - (list 'put (list 'quote func) ''math-simplify - (list 'nconc - (list 'get (list 'quote func) ''math-simplify) - (list 'list - (list 'function - (append '(lambda (math-simplify-expr)) - code))))))) - (if (symbolp funcs) (list funcs) funcs)))) -(put 'math-defsimplify 'lisp-indent-hook 1) - (defun math-any-floats (expr) (if (Math-primp expr) (math-floatp expr) @@ -2656,6 +2640,10 @@ calc-kill calc-kill-region calc-yank)))) (eq (car-safe (symbol-value (nth 2 expr))) 'special-const)) (memq (nth 2 expr) '(var-inf var-uinf var-nan))))) +;; The variable math-integral-cache is originally declared in calcalg2.el, +;; but is set by math-defintegral and math-definitegral2. +(defvar math-integral-cache) + (defmacro math-defintegral (funcs &rest code) (setq math-integral-cache nil) (append '(progn) @@ -2886,11 +2874,79 @@ calc-kill calc-kill-region calc-yank)))) (defvar math-expr-data) +(defvar math-read-replacement-list + '(;; Misc symbols + ("±" "+/-") ; plus or minus + ("×" "*") ; multiplication sign + ("÷" ":") ; division sign + ("−" "-") ; subtraction sign + ("∕" "/") ; division sign + ("∗" "*") ; asterisk multiplication + ("∞" "inf") ; infinity symbol + ("≤" "<=") + ("≥" ">=") + ("≦" "<=") + ("≧" ">=") + ;; fractions + ("¼" "(1:4)") ; 1/4 + ("½" "(1:2)") ; 1/2 + ("¾" "(3:4)") ; 3/4 + ("⅓" "(1:3)") ; 1/3 + ("⅔" "(2:3)") ; 2/3 + ("⅕" "(1:5)") ; 1/5 + ("⅖" "(2:5)") ; 2/5 + ("⅗" "(3:5)") ; 3/5 + ("⅘" "(4:5)") ; 4/5 + ("⅙" "(1:6)") ; 1/6 + ("⅚" "(5:6)") ; 5/6 + ("⅛" "(1:8)") ; 1/8 + ("⅜" "(3:8)") ; 3/8 + ("⅝" "(5:8)") ; 5/8 + ("⅞" "(7:8)") ; 7/8 + ("⅟" "1:") ; 1/... + ;; superscripts + ("⁰" "0") ; 0 + ("¹" "1") ; 1 + ("²" "2") ; 2 + ("³" "3") ; 3 + ("⁴" "4") ; 4 + ("⁵" "5") ; 5 + ("⁶" "6") ; 6 + ("⁷" "7") ; 7 + ("⁸" "8") ; 8 + ("⁹" "9") ; 9 + ("⁺" "+") ; + + ("⁻" "-") ; - + ("⁽" "(") ; ( + ("⁾" ")") ; ) + ("ⁿ" "n") ; n + ("ⁱ" "i")) ; i + "A list whose elements (old new) indicate replacements to make +in Calc algebraic input.") + +(defvar math-read-superscripts + "⁰¹²³⁴⁵⁶⁷⁸⁹⁺⁻⁽⁾ⁿⁱ" ; 0123456789+-()ni + "A string consisting of the superscripts allowed by Calc.") + +(defun math-read-preprocess-string (str) + "Replace some substrings of STR by Calc equivalents." + (setq str + (replace-regexp-in-string (concat "[" math-read-superscripts "]+") + "^(\\&)" str)) + (let ((rep-list math-read-replacement-list)) + (while rep-list + (setq str + (replace-regexp-in-string (nth 0 (car rep-list)) + (nth 1 (car rep-list)) str)) + (setq rep-list (cdr rep-list)))) + str) + (defun math-read-expr (math-exp-str) (let ((math-exp-pos 0) (math-exp-old-pos 0) (math-exp-keep-spaces nil) math-exp-token math-expr-data) + (setq math-exp-str (math-read-preprocess-string math-exp-str)) (while (setq math-exp-token (string-match "\\.\\.\\([^.]\\|.[^.]\\)" math-exp-str)) (setq math-exp-str (concat (substring math-exp-str 0 math-exp-token) "\\dots" (substring math-exp-str (+ math-exp-token 2))))) @@ -2943,37 +2999,39 @@ calc-kill calc-kill-region calc-yank)))) (math-expr-function-mapping (get 'tex 'math-function-table)) (math-expr-variable-mapping (get 'tex 'math-variable-table))) (math-read-expr str))) - (let ((lines nil) + (let ((math-read-big-lines nil) (pos 0) (width 0) - (err-msg nil) - the-baseline the-h2 + (math-read-big-err-msg nil) + math-read-big-baseline math-read-big-h2 new-pos p) (while (setq new-pos (string-match "\n" str pos)) - (setq lines (cons (substring str pos new-pos) lines) + (setq math-read-big-lines + (cons (substring str pos new-pos) math-read-big-lines) pos (1+ new-pos))) - (setq lines (nreverse (cons (substring str pos) lines)) - p lines) + (setq math-read-big-lines + (nreverse (cons (substring str pos) math-read-big-lines)) + p math-read-big-lines) (while p (setq width (max width (length (car p))) p (cdr p))) - (if (math-read-big-bigp lines) + (if (math-read-big-bigp math-read-big-lines) (or (catch 'syntax - (math-read-big-rec 0 0 width (length lines))) - err-msg + (math-read-big-rec 0 0 width (length math-read-big-lines))) + math-read-big-err-msg '(error 0 "Syntax error")) (math-read-expr str))))) -(defun math-read-big-bigp (lines) - (and (cdr lines) +(defun math-read-big-bigp (math-read-big-lines) + (and (cdr math-read-big-lines) (let ((matrix nil) (v 0) - (height (if (> (length (car lines)) 0) 1 0))) - (while (and (cdr lines) + (height (if (> (length (car math-read-big-lines)) 0) 1 0))) + (while (and (cdr math-read-big-lines) (let* ((i 0) j - (l1 (car lines)) - (l2 (nth 1 lines)) + (l1 (car math-read-big-lines)) + (l2 (nth 1 math-read-big-lines)) (len (min (length l1) (length l2)))) (if (> (length l2) 0) (setq height (1+ height))) @@ -2984,7 +3042,7 @@ calc-kill calc-kill-region calc-yank)))) (= (aref l2 i) (aref l1 i))) (and (eq (aref l1 i) ?\[) (eq (aref l2 i) ?\[) - (let ((h2 (length l1))) + (let ((math-rb-h2 (length l1))) (setq j (math-read-big-balance (1+ i) v "["))) (setq i (1- j))))) @@ -2994,10 +3052,10 @@ calc-kill calc-kill-region calc-yank)))) (eq (aref l2 i) ?\[) (setq matrix t) nil)))) - (setq lines (cdr lines) + (setq math-read-big-lines (cdr math-read-big-lines) v (1+ v))) (or (and (> height 1) - (not (cdr lines))) + (not (cdr math-read-big-lines))) matrix)))) ;;; Nontrivial "flat" formatting. @@ -3288,5 +3346,7 @@ A key may contain additional specs for Inverse, Hyperbolic, and Inv+Hyp.") (run-hooks 'calc-ext-load-hook) +(provide 'calc-ext) + ;;; arch-tag: 1814ba7f-a390-49dc-9e25-a5adc205e97e ;;; calc-ext.el ends here diff --git a/lisp/calc/calc-fin.el b/lisp/calc/calc-fin.el index 74b5b0dbee2..88af22746a0 100644 --- a/lisp/calc/calc-fin.el +++ b/lisp/calc/calc-fin.el @@ -3,8 +3,7 @@ ;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> -;; Maintainers: D. Goel <deego@gnufans.org> -;; Colin Walters <walters@debian.org> +;; Maintainer: Jay Belanger <belanger@truman.edu> ;; This file is part of GNU Emacs. @@ -28,13 +27,10 @@ ;;; Code: ;; This file is autoloaded from calc-ext.el. -(require 'calc-ext) +(require 'calc-ext) (require 'calc-macs) -(defun calc-Need-calc-fin () nil) - - ;;; Financial functions. (defun calc-fin-pv () @@ -413,5 +409,7 @@ book salvage))) res))) +(provide 'calc-fin) + ;;; arch-tag: 82f30ca8-d02f-4b33-84b4-bb6ecd84597b ;;; calc-fin.el ends here diff --git a/lisp/calc/calc-forms.el b/lisp/calc/calc-forms.el index e64983ad33d..d4ddada6a0c 100644 --- a/lisp/calc/calc-forms.el +++ b/lisp/calc/calc-forms.el @@ -3,8 +3,7 @@ ;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2004 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> -;; Maintainers: D. Goel <deego@gnufans.org> -;; Colin Walters <walters@debian.org> +;; Maintainer: Jay Belanger <belanger@truman.edu> ;; This file is part of GNU Emacs. @@ -28,13 +27,10 @@ ;;; Code: ;; This file is autoloaded from calc-ext.el. -(require 'calc-ext) +(require 'calc-ext) (require 'calc-macs) -(defun calc-Need-calc-forms () nil) - - (defun calc-time () (interactive) (calc-wrapper @@ -510,181 +506,200 @@ (defvar math-format-date-cache nil) -(defun math-format-date (date) - (if (eq (car-safe date) 'date) - (setq date (nth 1 date))) - (let ((entry (list date calc-internal-prec calc-date-format))) + +;; The variables math-fd-date, math-fd-dt, math-fd-year, +;; math-fd-month, math-fd-day, math-fd-weekday, math-fd-hour, +;; math-fd-minute, math-fd-second, math-fd-bc-flag are local +;; to math-format-date, but are used by math-format-date-part, +;; which is called by math-format-date. +(defvar math-fd-date) +(defvar math-fd-dt) +(defvar math-fd-year) +(defvar math-fd-month) +(defvar math-fd-day) +(defvar math-fd-weekday) +(defvar math-fd-hour) +(defvar math-fd-minute) +(defvar math-fd-second) +(defvar math-fd-bc-flag) + +(defun math-format-date (math-fd-date) + (if (eq (car-safe math-fd-date) 'date) + (setq math-fd-date (nth 1 math-fd-date))) + (let ((entry (list math-fd-date calc-internal-prec calc-date-format))) (or (cdr (assoc entry math-format-date-cache)) - (let* ((dt nil) + (let* ((math-fd-dt nil) (calc-group-digits nil) (calc-leading-zeros nil) (calc-number-radix 10) - year month day weekday hour minute second - (bc-flag nil) + math-fd-year math-fd-month math-fd-day math-fd-weekday + math-fd-hour math-fd-minute math-fd-second + (math-fd-bc-flag nil) (fmt (apply 'concat (mapcar 'math-format-date-part calc-date-format)))) (setq math-format-date-cache (cons (cons entry fmt) math-format-date-cache)) - (and (setq dt (nthcdr 10 math-format-date-cache)) - (setcdr dt nil)) + (and (setq math-fd-dt (nthcdr 10 math-format-date-cache)) + (setcdr math-fd-dt nil)) fmt)))) (defun math-format-date-part (x) (cond ((stringp x) x) ((listp x) - (if (math-integerp date) + (if (math-integerp math-fd-date) "" (apply 'concat (mapcar 'math-format-date-part x)))) ((eq x 'X) "") ((eq x 'N) - (math-format-number date)) + (math-format-number math-fd-date)) ((eq x 'n) - (math-format-number (math-floor date))) + (math-format-number (math-floor math-fd-date))) ((eq x 'J) - (math-format-number (math-add date '(float (bigpos 235 214 17) -1)))) + (math-format-number (math-add math-fd-date '(float (bigpos 235 214 17) -1)))) ((eq x 'j) - (math-format-number (math-add (math-floor date) '(bigpos 424 721 1)))) + (math-format-number (math-add (math-floor math-fd-date) '(bigpos 424 721 1)))) ((eq x 'U) - (math-format-number (nth 1 (math-date-parts date 719164)))) + (math-format-number (nth 1 (math-date-parts math-fd-date 719164)))) ((progn - (or dt + (or math-fd-dt (progn - (setq dt (math-date-to-dt date) - year (car dt) - month (nth 1 dt) - day (nth 2 dt) - weekday (math-mod (math-add (math-floor date) 6) 7) - hour (nth 3 dt) - minute (nth 4 dt) - second (nth 5 dt)) + (setq math-fd-dt (math-date-to-dt math-fd-date) + math-fd-year (car math-fd-dt) + math-fd-month (nth 1 math-fd-dt) + math-fd-day (nth 2 math-fd-dt) + math-fd-weekday (math-mod + (math-add (math-floor math-fd-date) 6) 7) + math-fd-hour (nth 3 math-fd-dt) + math-fd-minute (nth 4 math-fd-dt) + math-fd-second (nth 5 math-fd-dt)) (and (memq 'b calc-date-format) - (math-negp year) - (setq year (math-neg year) - bc-flag t)))) + (math-negp math-fd-year) + (setq math-fd-year (math-neg math-fd-year) + math-fd-bc-flag t)))) (memq x '(Y YY BY))) - (if (and (integerp year) (> year 1940) (< year 2040)) + (if (and (integerp math-fd-year) (> math-fd-year 1940) (< math-fd-year 2040)) (format (cond ((eq x 'YY) "%02d") ((eq x 'BYY) "%2d") (t "%d")) - (% year 100)) - (if (and (natnump year) (< year 100)) - (format "+%d" year) - (math-format-number year)))) + (% math-fd-year 100)) + (if (and (natnump math-fd-year) (< math-fd-year 100)) + (format "+%d" math-fd-year) + (math-format-number math-fd-year)))) ((eq x 'YYY) - (math-format-number year)) + (math-format-number math-fd-year)) ((eq x 'YYYY) - (if (and (natnump year) (< year 100)) - (format "+%d" year) - (math-format-number year))) + (if (and (natnump math-fd-year) (< math-fd-year 100)) + (format "+%d" math-fd-year) + (math-format-number math-fd-year))) ((eq x 'b) "") ((eq x 'aa) - (and (not bc-flag) "ad")) + (and (not math-fd-bc-flag) "ad")) ((eq x 'AA) - (and (not bc-flag) "AD")) + (and (not math-fd-bc-flag) "AD")) ((eq x 'aaa) - (and (not bc-flag) "ad ")) + (and (not math-fd-bc-flag) "ad ")) ((eq x 'AAA) - (and (not bc-flag) "AD ")) + (and (not math-fd-bc-flag) "AD ")) ((eq x 'aaaa) - (and (not bc-flag) "a.d.")) + (and (not math-fd-bc-flag) "a.d.")) ((eq x 'AAAA) - (and (not bc-flag) "A.D.")) + (and (not math-fd-bc-flag) "A.D.")) ((eq x 'bb) - (and bc-flag "bc")) + (and math-fd-bc-flag "bc")) ((eq x 'BB) - (and bc-flag "BC")) + (and math-fd-bc-flag "BC")) ((eq x 'bbb) - (and bc-flag " bc")) + (and math-fd-bc-flag " bc")) ((eq x 'BBB) - (and bc-flag " BC")) + (and math-fd-bc-flag " BC")) ((eq x 'bbbb) - (and bc-flag "b.c.")) + (and math-fd-bc-flag "b.c.")) ((eq x 'BBBB) - (and bc-flag "B.C.")) + (and math-fd-bc-flag "B.C.")) ((eq x 'M) - (format "%d" month)) + (format "%d" math-fd-month)) ((eq x 'MM) - (format "%02d" month)) + (format "%02d" math-fd-month)) ((eq x 'BM) - (format "%2d" month)) + (format "%2d" math-fd-month)) ((eq x 'mmm) - (downcase (nth (1- month) math-short-month-names))) + (downcase (nth (1- math-fd-month) math-short-month-names))) ((eq x 'Mmm) - (nth (1- month) math-short-month-names)) + (nth (1- math-fd-month) math-short-month-names)) ((eq x 'MMM) - (upcase (nth (1- month) math-short-month-names))) + (upcase (nth (1- math-fd-month) math-short-month-names))) ((eq x 'Mmmm) - (nth (1- month) math-long-month-names)) + (nth (1- math-fd-month) math-long-month-names)) ((eq x 'MMMM) - (upcase (nth (1- month) math-long-month-names))) + (upcase (nth (1- math-fd-month) math-long-month-names))) ((eq x 'D) - (format "%d" day)) + (format "%d" math-fd-day)) ((eq x 'DD) - (format "%02d" day)) + (format "%02d" math-fd-day)) ((eq x 'BD) - (format "%2d" day)) + (format "%2d" math-fd-day)) ((eq x 'W) - (format "%d" weekday)) + (format "%d" math-fd-weekday)) ((eq x 'www) - (downcase (nth weekday math-short-weekday-names))) + (downcase (nth math-fd-weekday math-short-weekday-names))) ((eq x 'Www) - (nth weekday math-short-weekday-names)) + (nth math-fd-weekday math-short-weekday-names)) ((eq x 'WWW) - (upcase (nth weekday math-short-weekday-names))) + (upcase (nth math-fd-weekday math-short-weekday-names))) ((eq x 'Wwww) - (nth weekday math-long-weekday-names)) + (nth math-fd-weekday math-long-weekday-names)) ((eq x 'WWWW) - (upcase (nth weekday math-long-weekday-names))) + (upcase (nth math-fd-weekday math-long-weekday-names))) ((eq x 'd) - (format "%d" (math-day-number year month day))) + (format "%d" (math-day-number math-fd-year math-fd-month math-fd-day))) ((eq x 'ddd) - (format "%03d" (math-day-number year month day))) + (format "%03d" (math-day-number math-fd-year math-fd-month math-fd-day))) ((eq x 'bdd) - (format "%3d" (math-day-number year month day))) + (format "%3d" (math-day-number math-fd-year math-fd-month math-fd-day))) ((eq x 'h) - (and hour (format "%d" hour))) + (and math-fd-hour (format "%d" math-fd-hour))) ((eq x 'hh) - (and hour (format "%02d" hour))) + (and math-fd-hour (format "%02d" math-fd-hour))) ((eq x 'bh) - (and hour (format "%2d" hour))) + (and math-fd-hour (format "%2d" math-fd-hour))) ((eq x 'H) - (and hour (format "%d" (1+ (% (+ hour 11) 12))))) + (and math-fd-hour (format "%d" (1+ (% (+ math-fd-hour 11) 12))))) ((eq x 'HH) - (and hour (format "%02d" (1+ (% (+ hour 11) 12))))) + (and math-fd-hour (format "%02d" (1+ (% (+ math-fd-hour 11) 12))))) ((eq x 'BH) - (and hour (format "%2d" (1+ (% (+ hour 11) 12))))) + (and math-fd-hour (format "%2d" (1+ (% (+ math-fd-hour 11) 12))))) ((eq x 'p) - (and hour (if (< hour 12) "a" "p"))) + (and math-fd-hour (if (< math-fd-hour 12) "a" "p"))) ((eq x 'P) - (and hour (if (< hour 12) "A" "P"))) + (and math-fd-hour (if (< math-fd-hour 12) "A" "P"))) ((eq x 'pp) - (and hour (if (< hour 12) "am" "pm"))) + (and math-fd-hour (if (< math-fd-hour 12) "am" "pm"))) ((eq x 'PP) - (and hour (if (< hour 12) "AM" "PM"))) + (and math-fd-hour (if (< math-fd-hour 12) "AM" "PM"))) ((eq x 'pppp) - (and hour (if (< hour 12) "a.m." "p.m."))) + (and math-fd-hour (if (< math-fd-hour 12) "a.m." "p.m."))) ((eq x 'PPPP) - (and hour (if (< hour 12) "A.M." "P.M."))) + (and math-fd-hour (if (< math-fd-hour 12) "A.M." "P.M."))) ((eq x 'm) - (and minute (format "%d" minute))) + (and math-fd-minute (format "%d" math-fd-minute))) ((eq x 'mm) - (and minute (format "%02d" minute))) + (and math-fd-minute (format "%02d" math-fd-minute))) ((eq x 'bm) - (and minute (format "%2d" minute))) + (and math-fd-minute (format "%2d" math-fd-minute))) ((eq x 'C) - (and second (not (math-zerop second)) + (and math-fd-second (not (math-zerop math-fd-second)) ":")) ((memq x '(s ss bs SS BS)) - (and second - (not (and (memq x '(SS BS)) (math-zerop second))) - (if (integerp second) + (and math-fd-second + (not (and (memq x '(SS BS)) (math-zerop math-fd-second))) + (if (integerp math-fd-second) (format (cond ((memq x '(ss SS)) "%02d") ((memq x '(bs BS)) "%2d") (t "%d")) - second) - (concat (if (Math-lessp second 10) + math-fd-second) + (concat (if (Math-lessp math-fd-second 10) (cond ((memq x '(ss SS)) "0") ((memq x '(bs BS)) " ") (t "")) @@ -692,29 +707,33 @@ (let ((calc-float-format (list 'fix (min (- 12 calc-internal-prec) 0)))) - (math-format-number second)))))))) + (math-format-number math-fd-second)))))))) +;; The variable math-pd-str is local to math-parse-date and +;; math-parse-standard-date, but is used by math-parse-date-word, +;; which is called by math-parse-date and math-parse-standard-date. +(defvar math-pd-str) -(defun math-parse-date (str) +(defun math-parse-date (math-pd-str) (catch 'syntax - (or (math-parse-standard-date str t) - (math-parse-standard-date str nil) - (and (string-match "\\`[^-+/0-9a-zA-Z]*\\([-+]?[0-9]+\\.?[0-9]*\\([eE][-+]?[0-9]+\\)?\\)[^-+/0-9a-zA-Z]*\\'" str) - (list 'date (math-read-number (math-match-substring str 1)))) + (or (math-parse-standard-date math-pd-str t) + (math-parse-standard-date math-pd-str nil) + (and (string-match "\\`[^-+/0-9a-zA-Z]*\\([-+]?[0-9]+\\.?[0-9]*\\([eE][-+]?[0-9]+\\)?\\)[^-+/0-9a-zA-Z]*\\'" math-pd-str) + (list 'date (math-read-number (math-match-substring math-pd-str 1)))) (let ((case-fold-search t) (year nil) (month nil) (day nil) (weekday nil) (hour nil) (minute nil) (second nil) (bc-flag nil) (a nil) (b nil) (c nil) (bigyear nil) temp) ;; Extract the time, if any. - (if (or (string-match "\\([0-9][0-9]?\\):\\([0-9][0-9]?\\)\\(:\\([0-9][0-9]?\\(\\.[0-9]+\\)?\\)\\)? *\\([ap]m?\\|[ap]\\. *m\\.\\|noon\\|n\\>\\|midnight\\|mid\\>\\|m\\>\\)?" str) - (string-match "\\([0-9][0-9]?\\)\\(\\)\\(\\(\\(\\)\\)\\) *\\([ap]m?\\|[ap]\\. *m\\.\\|noon\\|n\\>\\|midnight\\|mid\\>\\|m\\>\\)" str)) - (let ((ampm (math-match-substring str 6))) - (setq hour (string-to-int (math-match-substring str 1)) - minute (math-match-substring str 2) - second (math-match-substring str 4) - str (concat (substring str 0 (match-beginning 0)) - (substring str (match-end 0)))) + (if (or (string-match "\\([0-9][0-9]?\\):\\([0-9][0-9]?\\)\\(:\\([0-9][0-9]?\\(\\.[0-9]+\\)?\\)\\)? *\\([ap]m?\\|[ap]\\. *m\\.\\|noon\\|n\\>\\|midnight\\|mid\\>\\|m\\>\\)?" math-pd-str) + (string-match "\\([0-9][0-9]?\\)\\(\\)\\(\\(\\(\\)\\)\\) *\\([ap]m?\\|[ap]\\. *m\\.\\|noon\\|n\\>\\|midnight\\|mid\\>\\|m\\>\\)" math-pd-str)) + (let ((ampm (math-match-substring math-pd-str 6))) + (setq hour (string-to-int (math-match-substring math-pd-str 1)) + minute (math-match-substring math-pd-str 2) + second (math-match-substring math-pd-str 4) + math-pd-str (concat (substring math-pd-str 0 (match-beginning 0)) + (substring math-pd-str (match-end 0)))) (if (equal minute "") (setq minute 0) (setq minute (string-to-int minute))) @@ -736,13 +755,13 @@ (setq hour (% (+ hour 12) 24))))))) ;; Rewrite xx-yy-zz to xx/yy/zz to avoid seeing "-" as a minus sign. - (while (string-match "[0-9a-zA-Z]\\(-\\)[0-9a-zA-Z]" str) + (while (string-match "[0-9a-zA-Z]\\(-\\)[0-9a-zA-Z]" math-pd-str) (progn - (setq str (copy-sequence str)) - (aset str (match-beginning 1) ?\/))) + (setq math-pd-str (copy-sequence math-pd-str)) + (aset math-pd-str (match-beginning 1) ?\/))) ;; Extract obvious month or weekday names. - (if (string-match "[a-zA-Z]" str) + (if (string-match "[a-zA-Z]" math-pd-str) (progn (setq month (math-parse-date-word math-long-month-names)) (setq weekday (math-parse-date-word math-long-weekday-names)) @@ -756,31 +775,32 @@ (or (math-parse-date-word '( "ad" "a.d." )) (if (math-parse-date-word '( "bc" "b.c." )) (setq bc-flag t))) - (if (string-match "[a-zA-Z]+" str) + (if (string-match "[a-zA-Z]+" math-pd-str) (throw 'syntax (format "Bad word in date: \"%s\"" - (math-match-substring str 0)))))) + (math-match-substring math-pd-str 0)))))) ;; If there is a huge number other than the year, ignore it. - (while (and (string-match "[-+]?0*[1-9][0-9][0-9][0-9][0-9]+" str) - (setq temp (concat (substring str 0 (match-beginning 0)) - (substring str (match-end 0)))) - (string-match "[4-9][0-9]\\|[0-9][0-9][0-9]\\|[-+][0-9]+[^-]*\\'" temp)) - (setq str temp)) + (while (and (string-match "[-+]?0*[1-9][0-9][0-9][0-9][0-9]+" math-pd-str) + (setq temp (concat (substring math-pd-str 0 (match-beginning 0)) + (substring math-pd-str (match-end 0)))) + (string-match + "[4-9][0-9]\\|[0-9][0-9][0-9]\\|[-+][0-9]+[^-]*\\'" temp)) + (setq math-pd-str temp)) ;; If there is a number with a sign or a large number, it is a year. - (if (or (string-match "\\([-+][0-9]+\\)[^-]*\\'" str) - (string-match "\\(0*[1-9][0-9][0-9]+\\)" str)) - (setq year (math-match-substring str 1) - str (concat (substring str 0 (match-beginning 1)) - (substring str (match-end 1))) + (if (or (string-match "\\([-+][0-9]+\\)[^-]*\\'" math-pd-str) + (string-match "\\(0*[1-9][0-9][0-9]+\\)" math-pd-str)) + (setq year (math-match-substring math-pd-str 1) + math-pd-str (concat (substring math-pd-str 0 (match-beginning 1)) + (substring math-pd-str (match-end 1))) year (math-read-number year) bigyear t)) ;; Collect remaining numbers. (setq temp 0) - (while (string-match "[0-9]+" str temp) + (while (string-match "[0-9]+" math-pd-str temp) (and c (throw 'syntax "Too many numbers in date")) - (setq c (string-to-int (math-match-substring str 0))) + (setq c (string-to-int (math-match-substring math-pd-str 0))) (or b (setq b c c nil)) (or a (setq a b b nil)) (setq temp (match-end 0))) @@ -867,18 +887,18 @@ (while (and names (not (string-match (if (equal (car names) "Sep") "Sept?" (regexp-quote (car names))) - str))) + math-pd-str))) (setq names (cdr names) n (1+ n))) (and names (or (not front) (= (match-beginning 0) 0)) (progn - (setq str (concat (substring str 0 (match-beginning 0)) + (setq math-pd-str (concat (substring math-pd-str 0 (match-beginning 0)) (if front "" " ") - (substring str (match-end 0)))) + (substring math-pd-str (match-end 0)))) n)))) -(defun math-parse-standard-date (str with-time) +(defun math-parse-standard-date (math-pd-str with-time) (let ((case-fold-search t) (okay t) num (fmt calc-date-format) this next (gnext nil) @@ -898,16 +918,16 @@ (setq gnext fmt fmt this))) ((stringp this) - (if (and (<= (length this) (length str)) + (if (and (<= (length this) (length math-pd-str)) (equal this - (substring str 0 (length this)))) - (setq str (substring str (length this))))) + (substring math-pd-str 0 (length this)))) + (setq math-pd-str (substring math-pd-str (length this))))) ((eq this 'X) t) ((memq this '(n N j J)) - (and (string-match "\\`[-+]?[0-9.]+\\([eE][-+]?[0-9]+\\)?" str) - (setq num (math-match-substring str 0) - str (substring str (match-end 0)) + (and (string-match "\\`[-+]?[0-9.]+\\([eE][-+]?[0-9]+\\)?" math-pd-str) + (setq num (math-match-substring math-pd-str 0) + math-pd-str (substring math-pd-str (match-end 0)) num (math-date-to-dt (math-read-number num)) num (math-sub num (if (memq this '(n N)) @@ -924,9 +944,9 @@ month (nth 1 num) day (nth 2 num)))) ((eq this 'U) - (and (string-match "\\`[-+]?[0-9]+" str) - (setq num (math-match-substring str 0) - str (substring str (match-end 0)) + (and (string-match "\\`[-+]?[0-9]+" math-pd-str) + (setq num (math-match-substring math-pd-str 0) + math-pd-str (substring math-pd-str (match-end 0)) num (math-date-to-dt (math-add 719164 (math-div (math-read-number num) @@ -946,63 +966,63 @@ ((memq this '(Wwww WWWW)) (math-parse-date-word math-long-weekday-names t)) ((memq this '(p P)) - (if (string-match "\\`a" str) + (if (string-match "\\`a" math-pd-str) (setq hour (if (= hour 12) 0 hour) - str (substring str 1)) - (if (string-match "\\`p" str) + math-pd-str (substring math-pd-str 1)) + (if (string-match "\\`p" math-pd-str) (setq hour (if (= hour 12) 12 (% (+ hour 12) 24)) - str (substring str 1))))) + math-pd-str (substring math-pd-str 1))))) ((memq this '(pp PP pppp PPPP)) - (if (string-match "\\`am\\|a\\.m\\." str) + (if (string-match "\\`am\\|a\\.m\\." math-pd-str) (setq hour (if (= hour 12) 0 hour) - str (substring str (match-end 0))) - (if (string-match "\\`pm\\|p\\.m\\." str) + math-pd-str (substring math-pd-str (match-end 0))) + (if (string-match "\\`pm\\|p\\.m\\." math-pd-str) (setq hour (if (= hour 12) 12 (% (+ hour 12) 24)) - str (substring str (match-end 0)))))) + math-pd-str (substring math-pd-str (match-end 0)))))) ((memq this '(Y YY BY YYY YYYY)) (and (if (memq next '(MM DD ddd hh HH mm ss SS)) (if (memq this '(Y YY BYY)) - (string-match "\\` *[0-9][0-9]" str) - (string-match "\\`[0-9][0-9][0-9][0-9]" str)) - (string-match "\\`[-+]?[0-9]+" str)) - (setq year (math-match-substring str 0) + (string-match "\\` *[0-9][0-9]" math-pd-str) + (string-match "\\`[0-9][0-9][0-9][0-9]" math-pd-str)) + (string-match "\\`[-+]?[0-9]+" math-pd-str)) + (setq year (math-match-substring math-pd-str 0) bigyear (or (eq this 'YYY) - (memq (aref str 0) '(?\+ ?\-))) - str (substring str (match-end 0)) + (memq (aref math-pd-str 0) '(?\+ ?\-))) + math-pd-str (substring math-pd-str (match-end 0)) year (math-read-number year)))) ((eq this 'b) t) ((memq this '(aa AA aaaa AAAA)) - (if (string-match "\\` *\\(ad\\|a\\.d\\.\\)" str) - (setq str (substring str (match-end 0))))) + (if (string-match "\\` *\\(ad\\|a\\.d\\.\\)" math-pd-str) + (setq math-pd-str (substring math-pd-str (match-end 0))))) ((memq this '(aaa AAA)) - (if (string-match "\\` *ad *" str) - (setq str (substring str (match-end 0))))) + (if (string-match "\\` *ad *" math-pd-str) + (setq math-pd-str (substring math-pd-str (match-end 0))))) ((memq this '(bb BB bbb BBB bbbb BBBB)) - (if (string-match "\\` *\\(bc\\|b\\.c\\.\\)" str) - (setq str (substring str (match-end 0)) + (if (string-match "\\` *\\(bc\\|b\\.c\\.\\)" math-pd-str) + (setq math-pd-str (substring math-pd-str (match-end 0)) bc-flag t))) ((memq this '(s ss bs SS BS)) (and (if (memq next '(YY YYYY MM DD hh HH mm)) - (string-match "\\` *[0-9][0-9]\\(\\.[0-9]+\\)?" str) - (string-match "\\` *[0-9][0-9]?\\(\\.[0-9]+\\)?" str)) - (setq second (math-match-substring str 0) - str (substring str (match-end 0)) + (string-match "\\` *[0-9][0-9]\\(\\.[0-9]+\\)?" math-pd-str) + (string-match "\\` *[0-9][0-9]?\\(\\.[0-9]+\\)?" math-pd-str)) + (setq second (math-match-substring math-pd-str 0) + math-pd-str (substring math-pd-str (match-end 0)) second (math-read-number second)))) ((eq this 'C) - (if (string-match "\\`:[0-9][0-9]" str) - (setq str (substring str 1)) + (if (string-match "\\`:[0-9][0-9]" math-pd-str) + (setq math-pd-str (substring math-pd-str 1)) t)) ((or (not (if (and (memq this '(ddd MM DD hh HH mm)) (memq next '(YY YYYY MM DD ddd hh HH mm ss SS))) (if (eq this 'ddd) - (string-match "\\` *[0-9][0-9][0-9]" str) - (string-match "\\` *[0-9][0-9]" str)) - (string-match "\\` *[0-9]+" str))) + (string-match "\\` *[0-9][0-9][0-9]" math-pd-str) + (string-match "\\` *[0-9][0-9]" math-pd-str)) + (string-match "\\` *[0-9]+" math-pd-str))) (and (setq num (string-to-int - (math-match-substring str 0)) - str (substring str (match-end 0))) + (math-match-substring math-pd-str 0)) + math-pd-str (substring math-pd-str (match-end 0))) nil)) nil) ((eq this 'W) @@ -1022,7 +1042,7 @@ (if (and month day) (setq yearday nil) (setq month 1 day 1))) - (if (and okay (equal str "")) + (if (and okay (equal math-pd-str "")) (and month day (or (not (or hour minute second)) (and hour minute)) (progn @@ -1148,6 +1168,30 @@ (calcFunc-tzone zone date)) (math-reject-arg date 'datep)))) + +;;; Note: Longer names must appear before shorter names which are +;;; substrings of them. +(defvar math-tzone-names + '(( "UTC" 0 0) + ( "MEGT" -1 "MET" "METDST" ) ; Middle Europe + ( "METDST" -1 -1 ) ( "MET" -1 0 ) + ( "MEGZ" -1 "MEZ" "MESZ" ) ( "MEZ" -1 0 ) ( "MESZ" -1 -1 ) + ( "WEGT" 0 "WET" "WETDST" ) ; Western Europe + ( "WETDST" 0 -1 ) ( "WET" 0 0 ) + ( "BGT" 0 "GMT" "BST" ) ( "GMT" 0 0 ) ( "BST" 0 -1 ) ; Britain + ( "NGT" (float 35 -1) "NST" "NDT" ) ; Newfoundland + ( "NST" (float 35 -1) 0 ) ( "NDT" (float 35 -1) -1 ) + ( "AGT" 4 "AST" "ADT" ) ( "AST" 4 0 ) ( "ADT" 4 -1 ) ; Atlantic + ( "EGT" 5 "EST" "EDT" ) ( "EST" 5 0 ) ( "EDT" 5 -1 ) ; Eastern + ( "CGT" 6 "CST" "CDT" ) ( "CST" 6 0 ) ( "CDT" 6 -1 ) ; Central + ( "MGT" 7 "MST" "MDT" ) ( "MST" 7 0 ) ( "MDT" 7 -1 ) ; Mountain + ( "PGT" 8 "PST" "PDT" ) ( "PST" 8 0 ) ( "PDT" 8 -1 ) ; Pacific + ( "YGT" 9 "YST" "YDT" ) ( "YST" 9 0 ) ( "YDT" 9 -1 ) ; Yukon + ) + "No doc yet. See calc manual for now. ") + +(defvar var-TimeZone) + (defun calcFunc-tzone (&optional zone date) (if zone (cond ((math-realp zone) @@ -1226,27 +1270,7 @@ (calc-refresh-evaltos 'var-TimeZone) (calcFunc-tzone tz date))))) -;;; Note: Longer names must appear before shorter names which are -;;; substrings of them. -(defvar math-tzone-names - '(( "UTC" 0 0) - ( "MEGT" -1 "MET" "METDST" ) ; Middle Europe - ( "METDST" -1 -1 ) ( "MET" -1 0 ) - ( "MEGZ" -1 "MEZ" "MESZ" ) ( "MEZ" -1 0 ) ( "MESZ" -1 -1 ) - ( "WEGT" 0 "WET" "WETDST" ) ; Western Europe - ( "WETDST" 0 -1 ) ( "WET" 0 0 ) - ( "BGT" 0 "GMT" "BST" ) ( "GMT" 0 0 ) ( "BST" 0 -1 ) ; Britain - ( "NGT" (float 35 -1) "NST" "NDT" ) ; Newfoundland - ( "NST" (float 35 -1) 0 ) ( "NDT" (float 35 -1) -1 ) - ( "AGT" 4 "AST" "ADT" ) ( "AST" 4 0 ) ( "ADT" 4 -1 ) ; Atlantic - ( "EGT" 5 "EST" "EDT" ) ( "EST" 5 0 ) ( "EDT" 5 -1 ) ; Eastern - ( "CGT" 6 "CST" "CDT" ) ( "CST" 6 0 ) ( "CDT" 6 -1 ) ; Central - ( "MGT" 7 "MST" "MDT" ) ( "MST" 7 0 ) ( "MDT" 7 -1 ) ; Mountain - ( "PGT" 8 "PST" "PDT" ) ( "PST" 8 0 ) ( "PDT" 8 -1 ) ; Pacific - ( "YGT" 9 "YST" "YDT" ) ( "YST" 9 0 ) ( "YDT" 9 -1 ) ; Yukon - ) - "No doc yet. See calc manual for now. ") - +(defvar math-daylight-savings-hook 'math-std-daylight-savings) (defun math-daylight-savings-adjust (date zone &optional dt) (or date (setq date (nth 1 (calcFunc-now)))) @@ -1286,8 +1310,6 @@ (nth 1 (calcFunc-tzconv (list 'date date) z1 z2)) (calcFunc-unixtime (calcFunc-unixtime date z1) z2))) -(defvar math-daylight-savings-hook 'math-std-daylight-savings) - (defun math-std-daylight-savings (date dt zone bump) "Standard North American daylight savings algorithm. This implements the rules for the U.S. and Canada as of 1987. @@ -1507,6 +1529,10 @@ and ends on the last Sunday of October at 2 a.m." (and (not (math-setup-holidays day)) (list 'date (math-add day time)))))) +;; The variable math-sh-year is local to math-setup-holidays +;; and math-setup-year-holiday, but is used by math-setup-add-holidays, +;; which is called by math-setup-holidays and math-setup-year-holiday. +(defvar math-sh-year) (defun math-setup-holidays (&optional date) (or (eq (calc-var-value 'var-Holidays) math-holidays-cache-tag) @@ -1581,7 +1607,7 @@ and ends on the last Sunday of October at 2 a.m." (unwind-protect (let ((days (nth 6 math-holidays-cache))) (if days - (let ((year nil)) ; see below + (let ((math-sh-year nil)) ; see below (setcar (nthcdr 6 math-holidays-cache) nil) (math-setup-add-holidays (cons 'vec (cdr days))) (setcar (nthcdr 2 math-holidays-cache) (car days)))) @@ -1613,10 +1639,10 @@ and ends on the last Sunday of October at 2 a.m." nil))) (or done (setq math-holidays-cache-tag t)))))) -(defun math-setup-year-holidays (year) +(defun math-setup-year-holidays (math-sh-year) (let ((exprs (nth 2 math-holidays-cache))) (while exprs - (let* ((var-y year) + (let* ((var-y math-sh-year) (var-m nil) (expr (math-evaluate-expr (car exprs)))) (if (math-expr-contains expr '(var m var-m)) @@ -1626,7 +1652,7 @@ and ends on the last Sunday of October at 2 a.m." (math-setup-add-holidays expr))) (setq exprs (cdr exprs))))) -(defun math-setup-add-holidays (days) ; uses "year" +(defun math-setup-add-holidays (days) ; uses "math-sh-year" (cond ((eq (car-safe days) 'vec) (while (setq days (cdr days)) (math-setup-add-holidays (car days)))) @@ -1641,7 +1667,7 @@ and ends on the last Sunday of October at 2 a.m." (math-setup-add-holidays (nth 1 days))) ((eq days 0)) ((integerp days) - (let ((b (math-to-business-day days year))) + (let ((b (math-to-business-day days math-sh-year))) (or (cdr b) ; don't register holidays twice! (let ((prev (car math-holidays-cache)) (iprev (nth 1 math-holidays-cache))) @@ -1789,6 +1815,12 @@ and ends on the last Sunday of October at 2 a.m." (t (math-make-intv 2 0 b))))) +;; The variables math-exp-str and math-exp-pos are local to +;; math-read-exprs in math-aent.el, but are used by +;; math-read-angle-brackets, which is called (indirectly) by +;; math-read-exprs. +(defvar math-exp-str) +(defvar math-exp-pos) (defun math-read-angle-brackets () (let* ((last (or (math-check-for-commas t) (length math-exp-str))) @@ -1822,5 +1854,7 @@ and ends on the last Sunday of October at 2 a.m." (math-read-token) res)) +(provide 'calc-forms) + ;;; arch-tag: a3d8f33b-9508-4043-8060-d02b8c9c750c ;;; calc-forms.el ends here diff --git a/lisp/calc/calc-frac.el b/lisp/calc/calc-frac.el index 48201a7dc8a..cdb8ac9beb6 100644 --- a/lisp/calc/calc-frac.el +++ b/lisp/calc/calc-frac.el @@ -3,8 +3,7 @@ ;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> -;; Maintainers: D. Goel <deego@gnufans.org> -;; Colin Walters <walters@debian.org> +;; Maintainer: Jay Belanger <belanger@truman.edu> ;; This file is part of GNU Emacs. @@ -28,12 +27,10 @@ ;;; Code: ;; This file is autoloaded from calc-ext.el. -(require 'calc-ext) +(require 'calc-ext) (require 'calc-macs) -(defun calc-Need-calc-frac () nil) - (defun calc-fdiv (arg) (interactive "P") (calc-slow-wrapper @@ -220,5 +217,7 @@ (math-reject-arg b 'integerp)) (math-reject-arg a 'integerp))) +(provide 'calc-frac) + ;;; arch-tag: 89d65274-0b3b-42d8-aacd-eaf86da5b4ea ;;; calc-frac.el ends here diff --git a/lisp/calc/calc-funcs.el b/lisp/calc/calc-funcs.el index fcf11bd65e9..9a0802f0a2b 100644 --- a/lisp/calc/calc-funcs.el +++ b/lisp/calc/calc-funcs.el @@ -3,8 +3,7 @@ ;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> -;; Maintainers: D. Goel <deego@gnufans.org> -;; Colin Walters <walters@debian.org> +;; Maintainer: Jay Belanger <belanger@truman.edu> ;; This file is part of GNU Emacs. @@ -28,13 +27,10 @@ ;;; Code: ;; This file is autoloaded from calc-ext.el. -(require 'calc-ext) +(require 'calc-ext) (require 'calc-macs) -(defun calc-Need-calc-funcs () nil) - - (defun calc-inc-gamma (arg) (interactive "P") (calc-slow-wrapper @@ -972,6 +968,7 @@ (math-sub 1 (calcFunc-utpt tt v))) (put 'calcFunc-ltpt 'math-expandable t) +(provide 'calc-funcs) ;;; arch-tag: 421ddb7a-550f-4dda-a31c-06638ebfc43a ;;; calc-funcs.el ends here diff --git a/lisp/calc/calc-graph.el b/lisp/calc/calc-graph.el index ff537109816..b645b8692dd 100644 --- a/lisp/calc/calc-graph.el +++ b/lisp/calc/calc-graph.el @@ -3,8 +3,7 @@ ;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> -;; Maintainers: D. Goel <deego@gnufans.org> -;; Colin Walters <walters@debian.org> +;; Maintainer: Jay Belanger <belanger@truman.edu> ;; This file is part of GNU Emacs. @@ -28,30 +27,35 @@ ;;; Code: ;; This file is autoloaded from calc-ext.el. -(require 'calc-ext) +(require 'calc-ext) (require 'calc-macs) -(defun calc-Need-calc-graph () nil) +;;; Graphics + +(defvar calc-gnuplot-name "gnuplot" + "*Name of GNUPLOT program, for calc-graph features.") +(defvar calc-gnuplot-plot-command nil + "*Name of command for displaying GNUPLOT output; %s = file name to print.") -;;; Graphics +(defvar calc-gnuplot-print-command "lp %s" + "*Name of command for printing GNUPLOT output; %s = file name to print.") -;;; Note that some of the following initial values also occur in calc.el. (defvar calc-gnuplot-tempfile "calc") -(defvar calc-gnuplot-default-device "default") -(defvar calc-gnuplot-default-output "STDOUT") -(defvar calc-gnuplot-print-device "postscript") -(defvar calc-gnuplot-print-output "auto") +(defvar calc-gnuplot-default-device) +(defvar calc-gnuplot-default-output) +(defvar calc-gnuplot-print-device) +(defvar calc-gnuplot-print-output) (defvar calc-gnuplot-keep-outfile nil) (defvar calc-gnuplot-version nil) (defvar calc-gnuplot-display (getenv "DISPLAY")) -(defvar calc-gnuplot-geometry nil) +(defvar calc-gnuplot-geometry) -(defvar calc-graph-default-resolution 15) -(defvar calc-graph-default-resolution-3d 5) +(defvar calc-graph-default-resolution) +(defvar calc-graph-default-resolution-3d) (defvar calc-graph-default-precision 5) (defvar calc-gnuplot-buffer nil) @@ -1473,5 +1477,7 @@ This \"dumb\" driver will be present in Gnuplot 3.0." (goto-char (point-max)) (insert "\n")))))) +(provide 'calc-graph) + ;;; arch-tag: e4b06a52-c386-4d54-a2bb-7c0a0ef533c2 ;;; calc-graph.el ends here diff --git a/lisp/calc/calc-help.el b/lisp/calc/calc-help.el index 99df2292f25..087c42d295c 100644 --- a/lisp/calc/calc-help.el +++ b/lisp/calc/calc-help.el @@ -4,8 +4,7 @@ ;; Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> -;; Maintainers: D. Goel <deego@gnufans.org> -;; Colin Walters <walters@debian.org> +;; Maintainer: Jay Belanger <belanger@truman.edu> ;; This file is part of GNU Emacs. @@ -29,13 +28,10 @@ ;;; Code: ;; This file is autoloaded from calc-ext.el. -(require 'calc-ext) +(require 'calc-ext) (require 'calc-macs) -(defun calc-Need-calc-help () nil) - - (defun calc-help-prefix (arg) "This key is the prefix for Calc help functions. See calc-help-for-help." (interactive "P") @@ -139,6 +135,8 @@ C-w Describe how there is no warranty for Calc." (interactive "kDescribe key briefly: ") (calc-describe-key key t)) +(defvar Info-history) + (defun calc-describe-key (key &optional briefly) (interactive "kDescribe key: ") (let ((defn (if (eq (key-binding key) 'calc-dispatch) @@ -157,7 +155,8 @@ C-w Describe how there is no warranty for Calc." (lookup-key calc-help-map key2)) (key-binding key)))) (inv nil) - (hyp nil)) + (hyp nil) + calc-summary-indentation) (while (or (equal key "I") (equal key "H")) (if (equal key "I") (setq inv (not inv)) @@ -187,11 +186,12 @@ C-w Describe how there is no warranty for Calc." (copy-to-buffer "*Calc Summary*" (point) (point-max)) (if Info-history - (Info-last)))) - (setq case-fold-search nil) - (re-search-forward "^\\(.*\\)\\[\\.\\. a b") - (setq calc-summary-indentation - (- (match-end 1) (match-beginning 1))))) + (Info-last)))))) + (goto-char (point-min)) + (setq case-fold-search nil) + (re-search-forward "^\\(.*\\)\\[\\.\\. a b") + (setq calc-summary-indentation + (- (match-end 1) (match-beginning 1))) (goto-char (point-min)) (setq target (if (and (string-match "[0-9]\\'" desc) (not (string-match "[d#]" desc))) @@ -400,6 +400,12 @@ C-w Describe how there is no warranty for Calc." (delete-region (point-min) (point)) (goto-char (point-min)))) +(defvar calc-help-long-names '((?b . "binary/business") + (?g . "graphics") + (?j . "selection") + (?k . "combinatorics/statistics") + (?u . "units/statistics"))) + (defun calc-full-help () (interactive) (with-output-to-temp-buffer "*Help*" @@ -456,12 +462,6 @@ C-w Describe how there is no warranty for Calc." calc-z-prefix-help))) (print-help-return-message))) -(defvar calc-help-long-names '((?b . "binary/business") - (?g . "graphics") - (?j . "selection") - (?k . "combinatorics/statistics") - (?u . "units/statistics"))) - (defun calc-h-prefix-help () (interactive) (calc-do-prefix-help @@ -674,5 +674,7 @@ C-w Describe how there is no warranty for Calc." "} (matrix brackets); . (abbreviate); / (multi-lines)") "vec/mat" ?v)) +(provide 'calc-help) + ;; arch-tag: 2d347593-7591-449e-a64a-93dab5f2f686 ;;; calc-help.el ends here diff --git a/lisp/calc/calc-incom.el b/lisp/calc/calc-incom.el index 7dc7f08b4bd..691380e18fe 100644 --- a/lisp/calc/calc-incom.el +++ b/lisp/calc/calc-incom.el @@ -3,8 +3,7 @@ ;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> -;; Maintainers: D. Goel <deego@gnufans.org> -;; Colin Walters <walters@debian.org> +;; Maintainer: Jay Belanger <belanger@truman.edu> ;; This file is part of GNU Emacs. @@ -28,13 +27,10 @@ ;;; Code: ;; This file is autoloaded from calc-ext.el. -(require 'calc-ext) +(require 'calc-ext) (require 'calc-macs) -(defun calc-Need-calc-incom () nil) - - ;;; Incomplete forms. (defun calc-begin-complex () @@ -172,6 +168,12 @@ (cons 'vec (append (cdr (cdr inc)) stuff))) (list 'incomplete 'vec)))))))) +;; The following variables are initially declared in calc.el, +;; but are used by calc-digit-dots. +(defvar calc-prev-char) +(defvar calc-prev-prev-char) +(defvar calc-digit-value) + (defun calc-digit-dots () (if (eq calc-prev-char ?.) (progn @@ -227,5 +229,7 @@ (error "Interval form is incomplete")) (t (error "Object is incomplete")))) +(provide 'calc-incom) + ;;; arch-tag: b8001270-4dc7-481b-a3e3-a952e19b390d ;;; calc-incom.el ends here diff --git a/lisp/calc/calc-keypd.el b/lisp/calc/calc-keypd.el index 1ad703eb9cf..e517ac1942b 100644 --- a/lisp/calc/calc-keypd.el +++ b/lisp/calc/calc-keypd.el @@ -3,8 +3,7 @@ ;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> -;; Maintainers: D. Goel <deego@gnufans.org> -;; Colin Walters <walters@debian.org> +;; Maintainer: Jay Belanger <belanger@truman.edu> ;; This file is part of GNU Emacs. @@ -27,15 +26,11 @@ ;;; Code: - ;; This file is autoloaded from calc-ext.el. -(require 'calc-ext) +(require 'calc-ext) (require 'calc-macs) -(defun calc-Need-calc-keypd () nil) - - (defvar calc-keypad-buffer nil) (defvar calc-keypad-menu 0) (defvar calc-keypad-full-layout nil) @@ -612,6 +607,7 @@ (command-execute cmd) (error "Not a Calc command: %s" (key-description keys))))) +(provide 'calc-keypd) ;;; arch-tag: 4ba0d360-2bb6-40b8-adfa-eb373765b3f9 ;;; calc-keypd.el ends here diff --git a/lisp/calc/calc-lang.el b/lisp/calc/calc-lang.el index ee00e022553..cfbe3313d8e 100644 --- a/lisp/calc/calc-lang.el +++ b/lisp/calc/calc-lang.el @@ -3,8 +3,7 @@ ;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> -;; Maintainers: D. Goel <deego@gnufans.org> -;; Colin Walters <walters@debian.org> +;; Maintainer: Jay Belanger <belanger@truman.edu> ;; This file is part of GNU Emacs. @@ -27,15 +26,11 @@ ;;; Code: - ;; This file is autoloaded from calc-ext.el. -(require 'calc-ext) +(require 'calc-ext) (require 'calc-macs) -(defun calc-Need-calc-lang () nil) - - ;;; Alternate entry/display languages. (defun calc-set-language (lang &optional option no-refresh) @@ -258,6 +253,13 @@ (put 'fortran 'math-input-filter 'calc-input-case-filter) (put 'fortran 'math-output-filter 'calc-output-case-filter) +;; The next few variables are local to math-read-exprs in calc-aent.el +;; and math-read-expr in calc-ext.el, but are set in functions they call. + +(defvar math-exp-token) +(defvar math-expr-data) +(defvar math-exp-old-pos) + (defvar math-parsing-fortran-vector nil) (defun math-parse-fortran-vector (op) (let ((math-parsing-fortran-vector '(end . "\000"))) @@ -708,134 +710,168 @@ (list 'intv 3 x (math-read-expr-level (nth 3 op)))) - - - -(defun math-read-big-rec (h1 v1 h2 v2 &optional baseline prec short) +;; The variable math-read-big-lines is local to math-read-big-expr in +;; calc-ext.el, but is used by math-read-big-rec, math-read-big-char, +;; math-read-big-emptyp, math-read-big-error and math-read-big-balance, +;; which are called (directly and indirectly) by math-read-big-expr. +;; It is also local to math-read-big-bigp in calc-ext.el, which calls +;; math-read-big-balance. +(defvar math-read-big-lines) + +;; The variables math-read-big-baseline and math-read-big-h2 are +;; local to math-read-big-expr in calc-ext.el, but used by +;; math-read-big-rec. +(defvar math-read-big-baseline) +(defvar math-read-big-h2) + +;; The variables math-rb-h1, math-rb-h2, math-rb-v1 and math-rb-v2 +;; are local to math-read-big-rec, but are used by math-read-big-char, +;; math-read-big-emptyp and math-read-big-balance which are called by +;; math-read-big-rec. +;; math-rb-h2 is also local to math-read-big-bigp in calc-ext.el, +;; which calls math-read-big-balance. +(defvar math-rb-h1) +(defvar math-rb-h2) +(defvar math-rb-v1) +(defvar math-rb-v2) + +(defun math-read-big-rec (math-rb-h1 math-rb-v1 math-rb-h2 math-rb-v2 + &optional baseline prec short) (or prec (setq prec 0)) ;; Clip whitespace above or below. - (while (and (< v1 v2) (math-read-big-emptyp h1 v1 h2 (1+ v1))) - (setq v1 (1+ v1))) - (while (and (< v1 v2) (math-read-big-emptyp h1 (1- v2) h2 v2)) - (setq v2 (1- v2))) + (while (and (< math-rb-v1 math-rb-v2) + (math-read-big-emptyp math-rb-h1 math-rb-v1 math-rb-h2 (1+ math-rb-v1))) + (setq math-rb-v1 (1+ math-rb-v1))) + (while (and (< math-rb-v1 math-rb-v2) + (math-read-big-emptyp math-rb-h1 (1- math-rb-v2) math-rb-h2 math-rb-v2)) + (setq math-rb-v2 (1- math-rb-v2))) ;; If formula is a single line high, normal parser can handle it. - (if (<= v2 (1+ v1)) - (if (or (<= v2 v1) - (> h1 (length (setq v2 (nth v1 lines))))) - (math-read-big-error h1 v1) - (setq the-baseline v1 - the-h2 h2 - v2 (nth v1 lines) - h2 (math-read-expr (substring v2 h1 (min h2 (length v2))))) - (if (eq (car-safe h2) 'error) - (math-read-big-error (+ h1 (nth 1 h2)) v1 (nth 2 h2)) - h2)) + (if (<= math-rb-v2 (1+ math-rb-v1)) + (if (or (<= math-rb-v2 math-rb-v1) + (> math-rb-h1 (length (setq math-rb-v2 + (nth math-rb-v1 math-read-big-lines))))) + (math-read-big-error math-rb-h1 math-rb-v1) + (setq math-read-big-baseline math-rb-v1 + math-read-big-h2 math-rb-h2 + math-rb-v2 (nth math-rb-v1 math-read-big-lines) + math-rb-h2 (math-read-expr + (substring math-rb-v2 math-rb-h1 + (min math-rb-h2 (length math-rb-v2))))) + (if (eq (car-safe math-rb-h2) 'error) + (math-read-big-error (+ math-rb-h1 (nth 1 math-rb-h2)) + math-rb-v1 (nth 2 math-rb-h2)) + math-rb-h2)) ;; Clip whitespace at left or right. - (while (and (< h1 h2) (math-read-big-emptyp h1 v1 (1+ h1) v2)) - (setq h1 (1+ h1))) - (while (and (< h1 h2) (math-read-big-emptyp (1- h2) v1 h2 v2)) - (setq h2 (1- h2))) + (while (and (< math-rb-h1 math-rb-h2) + (math-read-big-emptyp math-rb-h1 math-rb-v1 (1+ math-rb-h1) math-rb-v2)) + (setq math-rb-h1 (1+ math-rb-h1))) + (while (and (< math-rb-h1 math-rb-h2) + (math-read-big-emptyp (1- math-rb-h2) math-rb-v1 math-rb-h2 math-rb-v2)) + (setq math-rb-h2 (1- math-rb-h2))) ;; Scan to find widest left-justified "----" in the region. (let* ((widest nil) (widest-h2 0) - (lines-v1 (nthcdr v1 lines)) + (lines-v1 (nthcdr math-rb-v1 math-read-big-lines)) (p lines-v1) - (v v1) + (v math-rb-v1) (other-v nil) other-char line len h) - (while (< v v2) + (while (< v math-rb-v2) (setq line (car p) - len (min h2 (length line))) - (and (< h1 len) - (/= (aref line h1) ?\ ) - (if (and (= (aref line h1) ?\-) + len (min math-rb-h2 (length line))) + (and (< math-rb-h1 len) + (/= (aref line math-rb-h1) ?\ ) + (if (and (= (aref line math-rb-h1) ?\-) ;; Make sure it's not a minus sign. - (or (and (< (1+ h1) len) (= (aref line (1+ h1)) ?\-)) - (/= (math-read-big-char h1 (1- v)) ?\ ) - (/= (math-read-big-char h1 (1+ v)) ?\ ))) + (or (and (< (1+ math-rb-h1) len) + (= (aref line (1+ math-rb-h1)) ?\-)) + (/= (math-read-big-char math-rb-h1 (1- v)) ?\ ) + (/= (math-read-big-char math-rb-h1 (1+ v)) ?\ ))) (progn - (setq h h1) + (setq h math-rb-h1) (while (and (< (setq h (1+ h)) len) (= (aref line h) ?\-))) (if (> h widest-h2) (setq widest v widest-h2 h))) - (or other-v (setq other-v v other-char (aref line h1))))) + (or other-v (setq other-v v other-char (aref line math-rb-h1))))) (setq v (1+ v) p (cdr p))) (cond ((not (setq v other-v)) - (math-read-big-error h1 v1)) ; Should never happen! + (math-read-big-error math-rb-h1 math-rb-v1)) ; Should never happen! ;; Quotient. (widest (setq h widest-h2 v widest) - (let ((num (math-read-big-rec h1 v1 h v)) - (den (math-read-big-rec h1 (1+ v) h v2))) + (let ((num (math-read-big-rec math-rb-h1 math-rb-v1 h v)) + (den (math-read-big-rec math-rb-h1 (1+ v) h math-rb-v2))) (setq p (if (and (math-integerp num) (math-integerp den)) (math-make-frac num den) (list '/ num den))))) ;; Big radical sign. ((= other-char ?\\) - (or (= (math-read-big-char (1+ h1) v) ?\|) - (math-read-big-error (1+ h1) v "Malformed root sign")) - (math-read-big-emptyp h1 v1 (1+ h1) v nil t) - (while (= (math-read-big-char (1+ h1) (setq v (1- v))) ?\|)) - (or (= (math-read-big-char (setq h (+ h1 2)) v) ?\_) + (or (= (math-read-big-char (1+ math-rb-h1) v) ?\|) + (math-read-big-error (1+ math-rb-h1) v "Malformed root sign")) + (math-read-big-emptyp math-rb-h1 math-rb-v1 (1+ math-rb-h1) v nil t) + (while (= (math-read-big-char (1+ math-rb-h1) (setq v (1- v))) ?\|)) + (or (= (math-read-big-char (setq h (+ math-rb-h1 2)) v) ?\_) (math-read-big-error h v "Malformed root sign")) (while (= (math-read-big-char (setq h (1+ h)) v) ?\_)) - (math-read-big-emptyp h1 v1 (1+ h1) v nil t) - (math-read-big-emptyp h1 (1+ other-v) h v2 nil t) + (math-read-big-emptyp math-rb-h1 math-rb-v1 (1+ math-rb-h1) v nil t) + (math-read-big-emptyp math-rb-h1 (1+ other-v) h math-rb-v2 nil t) (setq p (list 'calcFunc-sqrt (math-read-big-rec - (+ h1 2) (1+ v) + (+ math-rb-h1 2) (1+ v) h (1+ other-v) baseline)) - v the-baseline)) + v math-read-big-baseline)) ;; Small radical sign. ((and (= other-char ?V) - (= (math-read-big-char (1+ h1) (1- v)) ?\_)) - (setq h (1+ h1)) - (math-read-big-emptyp h1 v1 h (1- v) nil t) - (math-read-big-emptyp h1 (1+ v) h v2 nil t) - (math-read-big-emptyp h1 v1 (1+ h1) v nil t) + (= (math-read-big-char (1+ math-rb-h1) (1- v)) ?\_)) + (setq h (1+ math-rb-h1)) + (math-read-big-emptyp math-rb-h1 math-rb-v1 h (1- v) nil t) + (math-read-big-emptyp math-rb-h1 (1+ v) h math-rb-v2 nil t) + (math-read-big-emptyp math-rb-h1 math-rb-v1 (1+ math-rb-h1) v nil t) (while (= (math-read-big-char (setq h (1+ h)) (1- v)) ?\_)) (setq p (list 'calcFunc-sqrt (math-read-big-rec - (1+ h1) v h (1+ v) t)) - v the-baseline)) + (1+ math-rb-h1) v h (1+ v) t)) + v math-read-big-baseline)) ;; Binomial coefficient. ((and (= other-char ?\() - (= (math-read-big-char (1+ h1) v) ?\ ) - (= (string-match "( *)" (nth v lines) h1) h1)) + (= (math-read-big-char (1+ math-rb-h1) v) ?\ ) + (= (string-match "( *)" (nth v math-read-big-lines) + math-rb-h1) math-rb-h1)) (setq h (match-end 0)) - (math-read-big-emptyp h1 v1 (1+ h1) v nil t) - (math-read-big-emptyp h1 (1+ v) (1+ h1) v2 nil t) - (math-read-big-emptyp (1- h) v1 h v nil t) - (math-read-big-emptyp (1- h) (1+ v) h v2 nil t) + (math-read-big-emptyp math-rb-h1 math-rb-v1 (1+ math-rb-h1) v nil t) + (math-read-big-emptyp math-rb-h1 (1+ v) (1+ math-rb-h1) math-rb-v2 nil t) + (math-read-big-emptyp (1- h) math-rb-v1 h v nil t) + (math-read-big-emptyp (1- h) (1+ v) h math-rb-v2 nil t) (setq p (list 'calcFunc-choose - (math-read-big-rec (1+ h1) v1 (1- h) v) - (math-read-big-rec (1+ h1) (1+ v) - (1- h) v2)))) + (math-read-big-rec (1+ math-rb-h1) math-rb-v1 (1- h) v) + (math-read-big-rec (1+ math-rb-h1) (1+ v) + (1- h) math-rb-v2)))) ;; Minus sign. ((= other-char ?\-) - (setq p (list 'neg (math-read-big-rec (1+ h1) v1 h2 v2 v 250 t)) - v the-baseline - h the-h2)) + (setq p (list 'neg (math-read-big-rec (1+ math-rb-h1) math-rb-v1 + math-rb-h2 math-rb-v2 v 250 t)) + v math-read-big-baseline + h math-read-big-h2)) ;; Parentheses. ((= other-char ?\() - (math-read-big-emptyp h1 v1 (1+ h1) v nil t) - (math-read-big-emptyp h1 (1+ v) (1+ h1) v2 nil t) - (setq h (math-read-big-balance (1+ h1) v "(" t)) - (math-read-big-emptyp (1- h) v1 h v nil t) - (math-read-big-emptyp (1- h) (1+ v) h v2 nil t) + (math-read-big-emptyp math-rb-h1 math-rb-v1 (1+ math-rb-h1) v nil t) + (math-read-big-emptyp math-rb-h1 (1+ v) (1+ math-rb-h1) math-rb-v2 nil t) + (setq h (math-read-big-balance (1+ math-rb-h1) v "(" t)) + (math-read-big-emptyp (1- h) math-rb-v1 h v nil t) + (math-read-big-emptyp (1- h) (1+ v) h math-rb-v2 nil t) (let ((sep (math-read-big-char (1- h) v)) hmid) (if (= sep ?\.) @@ -843,9 +879,11 @@ (if (= sep ?\]) (math-read-big-error (1- h) v "Expected `)'")) (if (= sep ?\)) - (setq p (math-read-big-rec (1+ h1) v1 (1- h) v2 v)) + (setq p (math-read-big-rec + (1+ math-rb-h1) math-rb-v1 (1- h) math-rb-v2 v)) (setq hmid (math-read-big-balance h v "(") - p (list p (math-read-big-rec h v1 (1- hmid) v2 v)) + p (list p + (math-read-big-rec h math-rb-v1 (1- hmid) math-rb-v2 v)) h hmid) (cond ((= sep ?\.) (setq p (cons 'intv (cons (if (= (math-read-big-char @@ -858,22 +896,22 @@ ((= sep ?\,) (or (and (math-realp (car p)) (math-realp (nth 1 p))) (math-read-big-error - h1 v "Complex components must be real")) + math-rb-h1 v "Complex components must be real")) (setq p (cons 'cplx p))) ((= sep ?\;) (or (and (math-realp (car p)) (math-anglep (nth 1 p))) (math-read-big-error - h1 v "Complex components must be real")) + math-rb-h1 v "Complex components must be real")) (setq p (cons 'polar p))))))) ;; Matrix. ((and (= other-char ?\[) - (or (= (math-read-big-char (setq h h1) (1+ v)) ?\[) + (or (= (math-read-big-char (setq h math-rb-h1) (1+ v)) ?\[) (= (math-read-big-char (setq h (1+ h)) v) ?\[) (and (= (math-read-big-char h v) ?\ ) (= (math-read-big-char (setq h (1+ h)) v) ?\[))) (= (math-read-big-char h (1+ v)) ?\[)) - (math-read-big-emptyp h1 v1 h v nil t) + (math-read-big-emptyp math-rb-h1 math-rb-v1 h v nil t) (let ((vtop v) (hleft h) (hright nil)) @@ -889,7 +927,7 @@ (and (memq (math-read-big-char h v) '(?\ ?\,)) (= (math-read-big-char hleft (1+ v)) ?\[))) (setq v (1+ v))) - (or (= hleft h1) + (or (= hleft math-rb-h1) (progn (if (= (math-read-big-char h v) ?\ ) (setq h (1+ h))) @@ -898,22 +936,22 @@ (math-read-big-error (1- h) v "Expected `]'")) (if (= (math-read-big-char h vtop) ?\,) (setq h (1+ h))) - (math-read-big-emptyp h1 (1+ v) (1- h) v2 nil t) + (math-read-big-emptyp math-rb-h1 (1+ v) (1- h) math-rb-v2 nil t) (setq v (+ vtop (/ (- v vtop) 2)) p (cons 'vec (nreverse p))))) ;; Square brackets. ((= other-char ?\[) - (math-read-big-emptyp h1 v1 (1+ h1) v nil t) - (math-read-big-emptyp h1 (1+ v) (1+ h1) v2 nil t) + (math-read-big-emptyp math-rb-h1 math-rb-v1 (1+ math-rb-h1) v nil t) + (math-read-big-emptyp math-rb-h1 (1+ v) (1+ math-rb-h1) math-rb-v2 nil t) (setq p nil - h (1+ h1)) + h (1+ math-rb-h1)) (while (progn (setq widest (math-read-big-balance h v "[" t)) - (math-read-big-emptyp (1- h) v1 h v nil t) - (math-read-big-emptyp (1- h) (1+ v) h v2 nil t) + (math-read-big-emptyp (1- h) math-rb-v1 h v nil t) + (math-read-big-emptyp (1- h) (1+ v) h math-rb-v2 nil t) (setq p (cons (math-read-big-rec - h v1 (1- widest) v2 v) p) + h math-rb-v1 (1- widest) math-rb-v2 v) p) h widest) (= (math-read-big-char (1- h) v) ?\,))) (setq widest (math-read-big-char (1- h) v)) @@ -923,8 +961,8 @@ (if (= widest ?\.) (setq h (1+ h) widest (math-read-big-balance h v "[") - p (nconc p (list (math-read-big-big-rec - h v1 (1- widest) v2 v))) + p (nconc p (list (math-read-big-rec + h math-rb-v1 (1- widest) math-rb-v2 v))) h widest p (cons 'intv (cons (if (= (math-read-big-char (1- h) v) ?\]) @@ -934,23 +972,23 @@ ;; Date form. ((= other-char ?\<) - (setq line (nth v lines)) - (string-match ">" line h1) + (setq line (nth v math-read-big-lines)) + (string-match ">" line math-rb-h1) (setq h (match-end 0)) - (math-read-big-emptyp h1 v1 h v nil t) - (math-read-big-emptyp h1 (1+ v) h v2 nil t) - (setq p (math-read-big-rec h1 v h (1+ v) v))) + (math-read-big-emptyp math-rb-h1 math-rb-v1 h v nil t) + (math-read-big-emptyp math-rb-h1 (1+ v) h math-rb-v2 nil t) + (setq p (math-read-big-rec math-rb-h1 v h (1+ v) v))) ;; Variable name or function call. ((or (and (>= other-char ?a) (<= other-char ?z)) (and (>= other-char ?A) (<= other-char ?Z))) - (setq line (nth v lines)) - (string-match "\\([a-zA-Z'_]+\\) *" line h1) + (setq line (nth v math-read-big-lines)) + (string-match "\\([a-zA-Z'_]+\\) *" line math-rb-h1) (setq h (match-end 1) widest (match-end 0) p (math-match-substring line 1)) - (math-read-big-emptyp h1 v1 h v nil t) - (math-read-big-emptyp h1 (1+ v) h v2 nil t) + (math-read-big-emptyp math-rb-h1 math-rb-v1 h v nil t) + (math-read-big-emptyp math-rb-h1 (1+ v) h math-rb-v2 nil t) (if (= (math-read-big-char widest v) ?\() (progn (setq line (if (string-match "-" p) @@ -958,14 +996,14 @@ (intern (concat "calcFunc-" p))) h (1+ widest) p nil) - (math-read-big-emptyp widest v1 h v nil t) - (math-read-big-emptyp widest (1+ v) h v2 nil t) + (math-read-big-emptyp widest math-rb-v1 h v nil t) + (math-read-big-emptyp widest (1+ v) h math-rb-v2 nil t) (while (progn (setq widest (math-read-big-balance h v "(" t)) - (math-read-big-emptyp (1- h) v1 h v nil t) - (math-read-big-emptyp (1- h) (1+ v) h v2 nil t) + (math-read-big-emptyp (1- h) math-rb-v1 h v nil t) + (math-read-big-emptyp (1- h) (1+ v) h math-rb-v2 nil t) (setq p (cons (math-read-big-rec - h v1 (1- widest) v2 v) p) + h math-rb-v1 (1- widest) math-rb-v2 v) p) h widest) (= (math-read-big-char (1- h) v) ?\,))) (or (= (math-read-big-char (1- h) v) ?\)) @@ -979,44 +1017,45 @@ ;; Number. (t - (setq line (nth v lines)) - (or (= (string-match "_?\\([0-9]+.?0*@ *\\)?\\([0-9]+.?0*' *\\)?\\([0-9]+\\(#\\|\\^\\^\\)[0-9a-zA-Z:]+\\|[0-9]+:[0-9:]+\\|[0-9.]+\\([eE][-+_]?[0-9]+\\)?\"?\\)?" line h1) h1) + (setq line (nth v math-read-big-lines)) + (or (= (string-match "_?\\([0-9]+.?0*@ *\\)?\\([0-9]+.?0*' *\\)?\\([0-9]+\\(#\\|\\^\\^\\)[0-9a-zA-Z:]+\\|[0-9]+:[0-9:]+\\|[0-9.]+\\([eE][-+_]?[0-9]+\\)?\"?\\)?" line math-rb-h1) math-rb-h1) (math-read-big-error h v "Expected a number")) (setq h (match-end 0) p (math-read-number (math-match-substring line 0))) - (math-read-big-emptyp h1 v1 h v nil t) - (math-read-big-emptyp h1 (1+ v) h v2 nil t))) + (math-read-big-emptyp math-rb-h1 math-rb-v1 h v nil t) + (math-read-big-emptyp math-rb-h1 (1+ v) h math-rb-v2 nil t))) - ;; Now left term is bounded by h1, v1, h, v2; baseline = v. + ;; Now left term is bounded by math-rb-h1, math-rb-v1, h, math-rb-v2; + ;; baseline = v. (if baseline (or (= v baseline) - (math-read-big-error h1 v "Inconsistent baseline in formula")) + (math-read-big-error math-rb-h1 v "Inconsistent baseline in formula")) (setq baseline v)) ;; Look for superscripts or subscripts. - (setq line (nth baseline lines) - len (min h2 (length line)) + (setq line (nth baseline math-read-big-lines) + len (min math-rb-h2 (length line)) widest h) (while (and (< widest len) (= (aref line widest) ?\ )) (setq widest (1+ widest))) - (and (>= widest len) (setq widest h2)) - (if (math-read-big-emptyp h v widest v2) - (if (math-read-big-emptyp h v1 widest v) + (and (>= widest len) (setq widest math-rb-h2)) + (if (math-read-big-emptyp h v widest math-rb-v2) + (if (math-read-big-emptyp h math-rb-v1 widest v) (setq h widest) - (setq p (list '^ p (math-read-big-rec h v1 widest v)) + (setq p (list '^ p (math-read-big-rec h math-rb-v1 widest v)) h widest)) - (if (math-read-big-emptyp h v1 widest v) + (if (math-read-big-emptyp h math-rb-v1 widest v) (setq p (list 'calcFunc-subscr p - (math-read-big-rec h v widest v2)) + (math-read-big-rec h v widest math-rb-v2)) h widest))) ;; Look for an operator name and grab additional terms. (while (and (< h len) (if (setq widest (and (math-read-big-emptyp - h v1 (1+ h) v) + h math-rb-v1 (1+ h) v) (math-read-big-emptyp - h (1+ v) (1+ h) v2) + h (1+ v) (1+ h) math-rb-v2) (string-match "<=\\|>=\\|\\+/-\\|!=\\|&&\\|||\\|:=\\|=>\\|." line h) (assoc (math-match-substring line 0) math-standard-opers))) @@ -1028,44 +1067,46 @@ (cond ((eq (nth 3 widest) -1) (setq p (list (nth 1 widest) p))) ((equal (car widest) "?") - (let ((y (math-read-big-rec h v1 h2 v2 baseline nil t))) - (or (= (math-read-big-char the-h2 baseline) ?\:) - (math-read-big-error the-h2 baseline "Expected `:'")) + (let ((y (math-read-big-rec h math-rb-v1 math-rb-h2 + math-rb-v2 baseline nil t))) + (or (= (math-read-big-char math-read-big-h2 baseline) ?\:) + (math-read-big-error math-read-big-h2 baseline "Expected `:'")) (setq p (list (nth 1 widest) p y - (math-read-big-rec (1+ the-h2) v1 h2 v2 - baseline (nth 3 widest) t)) - h the-h2))) + (math-read-big-rec + (1+ math-read-big-h2) math-rb-v1 math-rb-h2 math-rb-v2 + baseline (nth 3 widest) t)) + h math-read-big-h2))) (t (setq p (list (nth 1 widest) p - (math-read-big-rec h v1 h2 v2 + (math-read-big-rec h math-rb-v1 math-rb-h2 math-rb-v2 baseline (nth 3 widest) t)) - h the-h2)))) + h math-read-big-h2)))) ;; Return all relevant information to caller. - (setq the-baseline baseline - the-h2 h) - (or short (= the-h2 h2) + (setq math-read-big-baseline baseline + math-read-big-h2 h) + (or short (= math-read-big-h2 math-rb-h2) (math-read-big-error h baseline)) p))) (defun math-read-big-char (h v) - (or (and (>= h h1) - (< h h2) - (>= v v1) - (< v v2) - (let ((line (nth v lines))) + (or (and (>= h math-rb-h1) + (< h math-rb-h2) + (>= v math-rb-v1) + (< v math-rb-v2) + (let ((line (nth v math-read-big-lines))) (and line (< h (length line)) (aref line h)))) ?\ )) (defun math-read-big-emptyp (eh1 ev1 eh2 ev2 &optional what error) - (and (< ev1 v1) (setq ev1 v1)) - (and (< eh1 h1) (setq eh1 h1)) - (and (> ev2 v2) (setq ev2 v2)) - (and (> eh2 h2) (setq eh2 h2)) + (and (< ev1 math-rb-v1) (setq ev1 math-rb-v1)) + (and (< eh1 math-rb-h1) (setq eh1 math-rb-h1)) + (and (> ev2 math-rb-v2) (setq ev2 math-rb-v2)) + (and (> eh2 math-rb-h2) (setq eh2 math-rb-h2)) (or what (setq what ?\ )) - (let ((p (nthcdr ev1 lines)) + (let ((p (nthcdr ev1 math-read-big-lines)) h) (while (and (< ev1 ev2) (progn @@ -1081,25 +1122,30 @@ p (cdr p))) (>= ev1 ev2))) +;; math-read-big-err-msg is local to math-read-big-expr in calc-ext.el, +;; but is used by math-read-big-error which is called (indirectly) by +;; math-read-big-expr. +(defvar math-read-big-err-msg) + (defun math-read-big-error (h v &optional msg) (let ((pos 0) - (p lines)) + (p math-read-big-lines)) (while (> v 0) (setq pos (+ pos 1 (length (car p))) p (cdr p) v (1- v))) (setq h (+ pos (min h (length (car p)))) - err-msg (list 'error h (or msg "Syntax error"))) + math-read-big-err-msg (list 'error h (or msg "Syntax error"))) (throw 'syntax nil))) (defun math-read-big-balance (h v what &optional commas) - (let* ((line (nth v lines)) - (len (min h2 (length line))) + (let* ((line (nth v math-read-big-lines)) + (len (min math-rb-h2 (length line))) (count 1)) (while (> count 0) (if (>= h len) (if what - (math-read-big-error h1 v (format "Unmatched `%s'" what)) + (math-read-big-error nil v (format "Unmatched `%s'" what)) (setq count 0)) (if (memq (aref line h) '(?\( ?\[)) (setq count (1+ count)) @@ -1113,5 +1159,7 @@ (setq h (1+ h)))) h)) +(provide 'calc-lang) + ;;; arch-tag: 483bfe15-f290-4fef-bb7d-ce65be687f2e ;;; calc-lang.el ends here diff --git a/lisp/calc/calc-macs.el b/lisp/calc/calc-macs.el index 68a92159d05..8b532a49e98 100644 --- a/lisp/calc/calc-macs.el +++ b/lisp/calc/calc-macs.el @@ -3,8 +3,7 @@ ;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> -;; Maintainers: D. Goel <deego@gnufans.org> -;; Colin Walters <walters@debian.org> +;; Maintainer: Jay Belanger <belanger@truman.edu> ;; This file is part of GNU Emacs. @@ -27,10 +26,6 @@ ;;; Code: -(provide 'calc-macs) - -(defun calc-need-macros () nil) - (defmacro calc-wrapper (&rest body) `(calc-do (function (lambda () ,@body)))) @@ -201,5 +196,7 @@ (or (consp b) (< a b)))) +(provide 'calc-macs) + ;;; arch-tag: 08ba8ec2-fcff-4b80-a079-ec661bdb057e ;;; calc-macs.el ends here diff --git a/lisp/calc/calc-maint.el b/lisp/calc/calc-maint.el deleted file mode 100644 index 9e73b85381f..00000000000 --- a/lisp/calc/calc-maint.el +++ /dev/null @@ -1,392 +0,0 @@ -;;; calc-maint.el --- maintenance routines for Calc - -;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. - -;; Author: David Gillespie <daveg@synaptics.com> -;; Maintainers: D. Goel <deego@gnufans.org> -;; Colin Walters <walters@debian.org> - -;; This file is part of GNU Emacs. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY. No author or distributor -;; accepts responsibility to anyone for the consequences of using it -;; or for whether it serves any particular purpose or works at all, -;; unless he says so in writing. Refer to the GNU Emacs General Public -;; License for full details. - -;; Everyone is granted permission to copy, modify and redistribute -;; GNU Emacs, but only under the conditions described in the -;; GNU Emacs General Public License. A copy of this license is -;; supposed to have been given to you along with GNU Emacs so you -;; can know your rights and responsibilities. It should be in a -;; 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. -Unix usage: - emacs -batch -l calc-maint -f calc-compile" - (interactive) - (if (equal (user-full-name) "David Gillespie") - (load "~/lisp/newbytecomp")) - (setq byte-compile-verbose t) - (if noninteractive - (let ((old-message (symbol-function 'message)) - (old-write-region (symbol-function 'write-region)) - (comp-was-func nil) - (comp-len 0)) - (unwind-protect - (progn - (fset 'message (symbol-function 'calc-compile-message)) - (fset 'write-region (symbol-function 'calc-compile-write-region)) - (calc-do-compile)) - (fset 'message old-message) - (fset 'write-region old-write-region))) - (calc-do-compile))) - -(defun calc-do-compile () - (let ((make-backup-files nil) - (changed-rules nil) - (changed-units nil) - (message-bug (string-match "^18.\\([0-4][0-9]\\|5[0-6]\\)" - emacs-version))) - (setq max-lisp-eval-depth (max 400 max-lisp-eval-depth)) - ;; Enable some irrelevant warnings to avoid compiler bug in 19.29: - (setq byte-compile-warnings (and (string-match "^19.29" emacs-version) - '(obsolete))) - - ;; 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")) - - ;; Make sure current directory is in load-path. - (setq load-path (cons default-directory load-path)) - (load "calc-macs.el" nil t t) - (provide 'calc) - (provide 'calc-ext) - - ;; Compile all the source files. - (let ((files (append - '("calc.el" "calc-ext.el") - (sort (directory-files - default-directory nil - "\\`calc-.[^x].*\\.el\\'") - 'string<)))) - (while files - (if (file-newer-than-file-p (car files) (concat (car files) "c")) - (progn - (if (string-match "calc-rules" (car files)) - (setq changed-rules t)) - (if (string-match "calc-units" (car files)) - (setq changed-units t)) - (or message-bug (message "")) - (byte-compile-file (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)))) - - (if (or changed-units changed-rules) - (condition-case err - (progn - - ;; Pre-build the units table. - (if (and changed-units - (not (string-match "Lucid" emacs-version))) - (progn - (or message-bug (message "")) - (save-excursion - (calc-create-buffer) - (math-build-units-table)) - (find-file "calc-units.elc") - (goto-char (point-max)) - (insert "\n(setq math-units-table '" - (prin1-to-string math-units-table) - ")\n") - (save-buffer))) - - ;; Pre-build rewrite rules for j D, j M, etc. - (if (and changed-rules (not (string-match "^19" emacs-version))) - (let ((rules nil)) - (or message-bug (message "")) - (find-file "calc-rules.elc") - (goto-char (point-min)) - (while (re-search-forward "defun calc-\\([A-Za-z]*Rules\\)" - nil t) - (setq rules (cons (buffer-substring (match-beginning 1) - (match-end 1)) - rules))) - (goto-char (point-min)) - (re-search-forward "\n(defun calc-[A-Za-z]*Rules") - (beginning-of-line) - (delete-region (point) (point-max)) - (mapcar (function - (lambda (v) - (let* ((vv (intern (concat "var-" v))) - (val (save-excursion - (calc-create-buffer) - (calc-var-value vv)))) - (insert "\n(defun calc-" v " () '" - (prin1-to-string val) ")\n")))) - (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\""))) - -(defun calc-compile-message (fmt &rest args) - (cond ((and (= (length args) 2) - (stringp (car args)) - (string-match ".elc?\\'" (car args)) - (symbolp (nth 1 args))) - (let ((name (symbol-name (nth 1 args)))) - (princ (if comp-was-func ", " " ")) - (if (and comp-was-func (eq (string-match comp-was-func name) 0)) - (setq name (substring name (1- (length comp-was-func)))) - (setq comp-was-func (if (string-match "\\`[a-zA-Z]+-" name) - (substring name 0 (match-end 0)) - " "))) - (if (> (+ comp-len (length name)) 75) - (progn - (princ "\n ") - (setq comp-len 0))) - (princ name) - (send-string-to-terminal "") ; cause an fflush(stdout) - (setq comp-len (+ comp-len 2 (length name))))) - ((and (setq comp-was-func nil - comp-len 0) - (= (length args) 1) - (stringp (car args)) - (string-match ".elc?\\'" (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) - (send-string-to-terminal "done\n")) - (t (apply old-message fmt args)))) - -(defun calc-compile-write-region (start end filename &optional append visit &rest rest) - (if (eq visit t) - (set-buffer-auto-saved)) - (if (and (string-match "\\.elc" filename) - (= start (point-min)) - (= end (point-max))) - (save-excursion - (goto-char (point-min)) - (if (search-forward "\n(require (quote calc-macs))\n" nil t) - (replace-match "")) - (setq end (point-max)))) - (apply old-write-region start end filename append 'quietly rest) - (message "Wrote %s" filename) - nil) - -(defun calc-split-tutorial (&optional force) - (interactive "P") - (calc-split-manual force 1)) - -(defun calc-split-reference (&optional force) - (interactive "P") - (calc-split-manual force 2)) - -(defun calc-split-manual (&optional force part) - "Split the Calc manual into separate Tutorial and Reference manuals. -Use this if your TeX installation is too small-minded to handle -calc.texinfo all at once. -Usage: C-x C-f calc.texinfo RET - M-x calc-split-manual RET" - (interactive "P") - (or (let ((case-fold-search t)) - (string-match "calc\\.texi" (buffer-name))) - force - (error "This command should be used in the calc.texi buffer")) - (let ((srcbuf (current-buffer)) - tutpos refpos endpos (maxpos (point-max))) - (goto-char 1) - (search-forward "@c [tutorial]") - (beginning-of-line) - (setq tutpos (point)) - (search-forward "@c [reference]") - (beginning-of-line) - (setq refpos (point)) - (search-forward "@c [end]") - (beginning-of-line) - (setq endpos (point)) - (or (eq part 2) - (progn - (find-file "calctut.tex") - (erase-buffer) - (insert-buffer-substring srcbuf 1 refpos) - (insert-buffer-substring srcbuf endpos maxpos) - (calc-split-volume "I" "ref" "Tutorial" "Reference") - (save-buffer))) - (or (eq part 1) - (progn - (find-file "calcref.tex") - (erase-buffer) - (insert-buffer-substring srcbuf 1 tutpos) - (insert "\n@tex\n\\global\\advance\\chapno by 1\n@end tex\n") - (insert-buffer-substring srcbuf refpos maxpos) - (calc-split-volume "II" "tut" "Reference" "Tutorial") - (save-buffer))) - (switch-to-buffer srcbuf) - (goto-char 1)) - (message (cond ((eq part 1) "Wrote file calctut.tex") - ((eq part 2) "Wrote file calcref.tex") - (t "Wrote files calctut.tex and calcref.tex")))) - -(defun calc-split-volume (number fix name other-name) - (goto-char 1) - (search-forward "@c [title]\n") - (search-forward "Manual") - (delete-backward-char 6) - (insert name) - (search-forward "@c [volume]\n") - (insert "@sp 1\n@center Volume " number ": " name "\n") - (let ((pat (format "@c \\[fix-%s \\(.*\\)\\]\n" fix))) - (while (re-search-forward pat nil t) - (let ((topic (buffer-substring (match-beginning 1) (match-end 1)))) - (re-search-forward "@\\(p?xref\\){[^}]*}") - (let ((cmd (buffer-substring (match-beginning 1) (match-end 1)))) - (delete-region (match-beginning 0) (match-end 0)) - (insert (if (equal cmd "pxref") "see" "See") - " ``" topic "'' in @emph{the Calc " - other-name "}"))))) - (goto-char 1) - (while (search-forward "@c [when-split]\n" nil t) - (while (looking-at "@c ") - (delete-char 3) - (forward-line 1))) - (goto-char 1) - (while (search-forward "@c [not-split]\n" nil t) - (while (not (looking-at "@c")) - (insert "@c ") - (forward-line 1)))) - - -(defun calc-inline-summary () - "Make a special \"calcsum.tex\" file to be used with main manual." - (calc-split-summary nil t)) - -(defun calc-split-summary (&optional force in-line) - "Make a special \"calcsum.tex\" file with just the Calc summary." - (interactive "P") - (or (let ((case-fold-search t)) - (string-match "calc\\.texinfo" (buffer-name))) - force - (error "This command should be used in the calc.texinfo buffer")) - (let ((srcbuf (current-buffer)) - begpos sumpos endpos midpos) - (goto-char 1) - (search-forward "{Calc Manual}") - (backward-char 1) - (delete-backward-char 6) - (insert "Summary") - (search-forward "@c [begin]") - (beginning-of-line) - (setq begpos (point)) - (search-forward "@c [summary]") - (beginning-of-line) - (setq sumpos (point)) - (search-forward "@c [end-summary]") - (beginning-of-line) - (setq endpos (point)) - (find-file "calcsum.tex") - (erase-buffer) - (insert-buffer-substring srcbuf 1 begpos) - (insert "@tex\n" - "\\global\\advance\\appendixno2\n" - "\\gdef\\xref#1.{See ``#1.''}\n") - (setq midpos (point)) - (insert "@end tex\n") - (insert-buffer-substring srcbuf sumpos endpos) - (insert "@bye\n") - (goto-char 1) - (if (search-forward "{. a b c" nil t) - (replace-match "{... a b c")) - (goto-char 1) - (if in-line - (let ((buf (current-buffer)) - (page nil)) - (find-file "calc.aux") - (if (> (buffer-size) 0) - (progn - (goto-char 1) - (re-search-forward "{Summary-pg}{\\([0-9]+\\)}") - (setq page (string-to-int (buffer-substring (match-beginning 1) - (match-end 1)))))) - (switch-to-buffer buf) - (if page - (progn - (message "Adjusting starting page number to %d" page) - (goto-char midpos) - (insert (format "\\global\\pageno=%d\n" page))) - (message "Unable to find page number from calc.aux"))) - (if (search-forward "@c smallbook" nil t) - (progn ; activate "smallbook" format for compactness - (beginning-of-line) - (forward-char 1) - (delete-char 2)))) - (let ((buf (current-buffer))) - (find-file "calc.ky") - (if (> (buffer-size) 0) - (let ((ibuf (current-buffer))) - (message "Mixing in page numbers from Key Index (calc.ky)") - (switch-to-buffer buf) - (goto-char 1) - (search-forward "notes at the end") - (insert "; the number in italics is\n" - "the page number where the command is described") - (while (re-search-forward - "@r{.*@: *\\([^ ]\\(.*[^ ]\\)?\\) *@:.*@:.*@:\\(.*\\)@:.*}" - nil t) - (let ((key (buffer-substring (match-beginning 1) (match-end 1))) - (pos (match-beginning 3)) - num) - (set-buffer ibuf) - (goto-char 1) - (let ((p '( ( "I H " . "H I " ) ; oops! - ( "@@ ' \"" . "@@" ) ( "h m s" . "@@" ) - ( "\\\\" . "{\\tt\\indexbackslash }" ) - ( "_" . "{\\_}" ) - ( "\\^" . "{\\tt\\hat}" ) - ( "<" . "{\\tt\\less}" ) - ( ">" . "{\\tt\\gtr}" ) - ( "\"" ) ( "@{" ) ( "@}" ) - ( "~" ) ( "|" ) ( "@@" ) - ( "\\+" . "{\\tt\\char43}" ) - ( "# l" . "# L" ) - ( "I f I" . "f I" ) ( "I f Q" . "f Q" ) - ( "V &" . "&" ) ( "C-u " . "" ) )) - (case-fold-search nil)) - (while p - (if (string-match (car (car p)) key) - (setq key (concat (substring key 0 (match-beginning 0)) - (or (cdr (car p)) - (format "{\\tt\\char'%03o}" - (aref key (1- (match-end - 0))))) - (substring key (match-end 0))))) - (setq p (cdr p))) - (setq num (and (search-forward (format "\\entry {%s}{" key) - nil t) - (looking-at "[0-9]+") - (buffer-substring (point) (match-end 0))))) - (set-buffer buf) - (goto-char pos) - (insert "@pgref{" (or num "") "}"))) - (goto-char midpos) - (insert "\\gdef\\pgref#1{\\hbox to 2em{\\indsl\\hss#1}\\ \\ }\n")) - (message - "Unable to find Key Index (calc.ky); no page numbers inserted")) - (switch-to-buffer buf)) - (save-buffer)) - (message "Wrote file calcsum.tex")) - -;;; arch-tag: 46cf3de8-6248-4a11-9034-d9850195761d -;;; calc-maint.el ends here diff --git a/lisp/calc/calc-map.el b/lisp/calc/calc-map.el index a6a5777df7e..726a500c10a 100644 --- a/lisp/calc/calc-map.el +++ b/lisp/calc/calc-map.el @@ -3,8 +3,7 @@ ;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2004 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> -;; Maintainers: D. Goel <deego@gnufans.org> -;; Colin Walters <walters@debian.org> +;; Maintainer: Jay Belanger <belanger@truman.edu> ;; This file is part of GNU Emacs. @@ -28,13 +27,10 @@ ;;; Code: ;; This file is autoloaded from calc-ext.el. -(require 'calc-ext) +(require 'calc-ext) (require 'calc-macs) -(defun calc-Need-calc-map () nil) - - (defun calc-apply (&optional oper) (interactive) (calc-wrapper @@ -802,25 +798,34 @@ (cons f args)))))) ;;; Do substitutions in parallel to avoid crosstalk. + +;; The variables math-ms-temp and math-ms-args are local to +;; math-multi-subst, but are used by math-multi-subst-rec, which +;; is called by math-multi-subst. +(defvar math-ms-temp) +(defvar math-ms-args) + (defun math-multi-subst (expr olds news) - (let ((args nil) - temp) + (let ((math-ms-args nil) + math-ms-temp) (while (and olds news) - (setq args (cons (cons (car olds) (car news)) args) + (setq math-ms-args (cons (cons (car olds) (car news)) math-ms-args) olds (cdr olds) news (cdr news))) (math-multi-subst-rec expr))) (defun math-multi-subst-rec (expr) - (cond ((setq temp (assoc expr args)) (cdr temp)) + (cond ((setq math-ms-temp (assoc expr math-ms-args)) + (cdr math-ms-temp)) ((Math-primp expr) expr) ((and (eq (car expr) 'calcFunc-lambda) (> (length expr) 2)) (let ((new (list (car expr))) - (args args)) + (math-ms-args math-ms-args)) (while (cdr (setq expr (cdr expr))) (setq new (cons (car expr) new)) - (if (assoc (car expr) args) - (setq args (cons (cons (car expr) (car expr)) args)))) + (if (assoc (car expr) math-ms-args) + (setq math-ms-args (cons (cons (car expr) (car expr)) + math-ms-args)))) (nreverse (cons (math-multi-subst-rec (car expr)) new)))) (t (cons (car expr) @@ -1033,7 +1038,7 @@ (calcFunc-mod . math-mod) (calcFunc-vconcat . math-concat) ))) - lfunc))) + func))) (while (cdr vec) (setq expr (funcall lfunc expr (nth 1 vec)) vec (cdr vec))))) @@ -1222,7 +1227,13 @@ (math-normalize (cons 'vec (nreverse mat))))) -(defun calcFunc-inner (mul-func add-func a b) +;; The variables math-inner-mul-func and math-inner-add-func are +;; local to calcFunc-inner, but are used by math-inner-mats, +;; which is called by math-inner-mats. +(defvar math-inner-mul-func) +(defvar math-inner-add-func) + +(defun calcFunc-inner (math-inner-mul-func math-inner-add-func a b) (or (math-vectorp a) (math-reject-arg a 'vectorp)) (or (math-vectorp b) (math-reject-arg b 'vectorp)) (if (math-matrixp a) @@ -1240,7 +1251,7 @@ (math-dimension-error)))) (if (math-matrixp b) (nth 1 (math-inner-mats (list 'vec a) b)) - (calcFunc-reduce add-func (calcFunc-map mul-func a b))))) + (calcFunc-reduce math-inner-add-func (calcFunc-map math-inner-mul-func a b))))) (defun math-inner-mats (a b) (let ((mat nil) @@ -1250,13 +1261,15 @@ (setq col cols row nil) (while (> (setq col (1- col)) 0) - (setq row (cons (calcFunc-reduce add-func - (calcFunc-map mul-func + (setq row (cons (calcFunc-reduce math-inner-add-func + (calcFunc-map math-inner-mul-func (car a) (math-mat-col b col))) row))) (setq mat (cons (cons 'vec row) mat))) (cons 'vec (nreverse mat)))) +(provide 'calc-map) + ;;; arch-tag: 980eac49-00e0-4870-b72a-e726b74c7990 ;;; calc-map.el ends here diff --git a/lisp/calc/calc-math.el b/lisp/calc/calc-math.el index 1456a8e2b57..02c65ac22ea 100644 --- a/lisp/calc/calc-math.el +++ b/lisp/calc/calc-math.el @@ -3,8 +3,7 @@ ;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> -;; Maintainers: D. Goel <deego@gnufans.org> -;; Colin Walters <walters@debian.org> +;; Maintainer: Jay Belanger <belanger@truman.edu> ;; This file is part of GNU Emacs. @@ -28,13 +27,10 @@ ;;; Code: ;; This file is autoloaded from calc-ext.el. -(require 'calc-ext) +(require 'calc-ext) (require 'calc-macs) -(defun calc-Need-calc-math () nil) - - (defun calc-sqrt (arg) (interactive "P") (calc-slow-wrapper @@ -574,39 +570,51 @@ (and root (list 'polar root (math-div (nth 2 a) n))))) (t nil))) -(defun math-nth-root-float (a n &optional guess) +;; The variables math-nrf-n, math-nrf-nf and math-nrf-nfm1 are local +;; to math-nth-root-float, but are used by math-nth-root-float-iter, +;; which is called by math-nth-root-float. +(defvar math-nrf-n) +(defvar math-nrf-nf) +(defvar math-nrf-nfm1) + +(defun math-nth-root-float (a math-nrf-n &optional guess) (math-inexact-result) (math-with-extra-prec 1 - (let ((nf (math-float n)) - (nfm1 (math-float (1- n)))) + (let ((math-nrf-nf (math-float math-nrf-n)) + (math-nrf-nfm1 (math-float (1- math-nrf-n)))) (math-nth-root-float-iter a (or guess (math-make-float 1 (/ (+ (math-numdigs (nth 1 a)) (nth 2 a) - (/ n 2)) - n))))))) + (/ math-nrf-n 2)) + math-nrf-n))))))) -(defun math-nth-root-float-iter (a guess) ; uses "n", "nf", "nfm1" +(defun math-nth-root-float-iter (a guess) (math-working "root" guess) - (let ((g2 (math-div-float (math-add-float (math-mul nfm1 guess) + (let ((g2 (math-div-float (math-add-float (math-mul math-nrf-nfm1 guess) (math-div-float - a (math-ipow guess (1- n)))) - nf))) + a (math-ipow guess (1- math-nrf-n)))) + math-nrf-nf))) (if (math-nearly-equal-float g2 guess) g2 (math-nth-root-float-iter a g2)))) -(defun math-nth-root-integer (a n &optional guess) ; [I I S] +;; The variable math-nri-n is local to math-nth-root-integer, but +;; is used by math-nth-root-int-iter, which is called by +;; math-nth-root-int. +(defvar math-nri-n) + +(defun math-nth-root-integer (a math-nri-n &optional guess) ; [I I S] (math-nth-root-int-iter a (or guess (math-scale-int 1 (/ (+ (math-numdigs a) - (1- n)) - n))))) + (1- math-nri-n)) + math-nri-n))))) -(defun math-nth-root-int-iter (a guess) ; uses "n" +(defun math-nth-root-int-iter (a guess) (math-working "root" guess) - (let* ((q (math-idivmod a (math-ipow guess (1- n)))) - (s (math-add (car q) (math-mul (1- n) guess))) - (g2 (math-idivmod s n))) + (let* ((q (math-idivmod a (math-ipow guess (1- math-nri-n)))) + (s (math-add (car q) (math-mul (1- math-nri-n) guess))) + (g2 (math-idivmod s math-nri-n))) (if (Math-natnum-lessp (car g2) guess) (math-nth-root-int-iter a (car g2)) (cons (and (equal (car g2) guess) @@ -1247,7 +1255,7 @@ (math-div (calcFunc-ln x) 0) (math-reject-arg b "*Logarithm base one"))) ((math-equal-int x 1) - (if (or (math-floatp a) (math-floatp b)) '(float 0 0) 0)) + (if (math-floatp b) '(float 0 0) 0)) ((and (Math-ratp x) (Math-ratp b) (math-posp x) (math-posp b) (let* ((sign 1) (inv nil) @@ -1676,5 +1684,7 @@ (t (list 'calcFunc-deg a)))) (put 'calcFunc-deg 'math-expandable t) +(provide 'calc-math) + ;;; arch-tag: c7367e8e-d0b8-4f70-8577-2fb3f31dbb4c ;;; calc-math.el ends here diff --git a/lisp/calc/calc-misc.el b/lisp/calc/calc-misc.el index 159b1ee3178..8040d28d083 100644 --- a/lisp/calc/calc-misc.el +++ b/lisp/calc/calc-misc.el @@ -3,8 +3,7 @@ ;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> -;; Maintainers: D. Goel <deego@gnufans.org> -;; Colin Walters <walters@debian.org> +;; Maintainer: Jay Belanger <belanger@truman.edu> ;; This file is part of GNU Emacs. @@ -28,13 +27,10 @@ ;;; Code: ;; This file is autoloaded from calc.el. -(require 'calc) +(require 'calc) (require 'calc-macs) -(defun calc-Need-calc-misc () nil) - - (defun calc-dispatch-help (arg) "M-# is a prefix key; follow it with one of these letters: @@ -232,6 +228,9 @@ Calc user interface as before (either M-# C or M-# K; initially M-# C)." ;;;; Stack and buffer management. +;; The variable calc-last-why-command is set in calc-do-handly-whys +;; and used in calc-why (in calc-stuff.el). +(defvar calc-last-why-command) (defun calc-do-handle-whys () (setq calc-why (sort calc-next-why @@ -243,7 +242,7 @@ Calc user interface as before (either M-# C or M-# K; initially M-# C)." (and (eq (car (car calc-why)) '*) calc-auto-why))) (progn - (calc-extensions) + (require 'calc-ext) (calc-explain-why (car calc-why) (if (eq calc-auto-why t) (cdr calc-why) @@ -329,14 +328,14 @@ Calc user interface as before (either M-# C or M-# K; initially M-# C)." (defun calc-last-args-stub (arg) (interactive "p") - (calc-extensions) + (require 'calc-ext) (calc-last-args arg)) (defun calc-power (arg) (interactive "P") (calc-slow-wrapper - (if (and calc-extensions-loaded + (if (and (featurep 'calc-ext) (calc-is-inverse)) (calc-binary-op "root" 'calcFunc-nroot arg nil nil) (calc-binary-op "^" 'calcFunc-pow arg nil nil '^)))) @@ -418,7 +417,7 @@ Calc user interface as before (either M-# C or M-# K; initially M-# C)." When this key is used, calc-ext (the Calculator extensions module) will be loaded and the keystroke automatically re-typed." (interactive "P") - (calc-extensions) + (require 'calc-ext) (if (keymapp (key-binding (char-to-string last-command-char))) (message "%s%c-" (calc-num-prefix-name n) last-command-char)) (calc-unread-command) @@ -426,7 +425,7 @@ loaded and the keystroke automatically re-typed." (defun calc-shift-Y-prefix-help () (interactive) - (calc-extensions) + (require 'calc-ext) (calc-do-prefix-help calc-Y-help-msgs "other" ?Y)) @@ -465,7 +464,7 @@ loaded and the keystroke automatically re-typed." (defun math-concat (v1 v2) (if (stringp v1) (concat v1 v2) - (calc-extensions) + (require 'calc-ext) (if (and (or (math-objvecp v1) (math-known-scalarp v1)) (or (math-objvecp v2) (math-known-scalarp v2))) (append (if (and (math-vectorp v1) @@ -593,31 +592,39 @@ loaded and the keystroke automatically re-typed." ;;; Coerce A to be an integer (by truncation toward zero). [I N] [Public] -(defun math-trunc (a &optional prec) - (cond (prec - (calc-extensions) - (math-trunc-special a prec)) + +;; The variable math-trunc-prec is local to math-trunc, but used by +;; math-trunc-fancy in calc-arith.el, which is called by math-trunc. + +(defun math-trunc (a &optional math-trunc-prec) + (cond (math-trunc-prec + (require 'calc-ext) + (math-trunc-special a math-trunc-prec)) ((Math-integerp a) a) ((Math-looks-negp a) (math-neg (math-trunc (math-neg a)))) ((eq (car a) 'float) (math-scale-int (nth 1 a) (nth 2 a))) - (t (calc-extensions) + (t (require 'calc-ext) (math-trunc-fancy a)))) (defalias 'calcFunc-trunc 'math-trunc) ;;; Coerce A to be an integer (by truncation toward minus infinity). [I N] -(defun math-floor (a &optional prec) ; [Public] - (cond (prec - (calc-extensions) - (math-floor-special a prec)) + +;; The variable math-floor-prec is local to math-floor, but used by +;; math-floor-fancy in calc-arith.el, which is called by math-floor. + +(defun math-floor (a &optional math-floor-prec) ; [Public] + (cond (math-floor-prec + (require 'calc-ext) + (math-floor-special a math-floor-prec)) ((Math-integerp a) a) ((Math-messy-integerp a) (math-trunc a)) ((Math-realp a) (if (Math-negp a) (math-add (math-trunc a) -1) (math-trunc a))) - (t (calc-extensions) + (t (require 'calc-ext) (math-floor-fancy a)))) (defalias 'calcFunc-floor 'math-floor) @@ -633,7 +640,7 @@ loaded and the keystroke automatically re-typed." (defun calcFunc-inv (m) (if (Math-vectorp m) (progn - (calc-extensions) + (require 'calc-ext) (if (math-square-matrixp m) (or (math-with-extra-prec 2 (math-matrix-inv-raw m)) (math-reject-arg m "*Singular matrix")) @@ -663,7 +670,7 @@ loaded and the keystroke automatically re-typed." (math-imod a b)) ((and (Math-anglep a) (Math-anglep b)) (math-sub a (math-mul (math-floor (math-div a b)) b))) - (t (calc-extensions) + (t (require 'calc-ext) (math-mod-fancy a b)))) @@ -676,7 +683,7 @@ loaded and the keystroke automatically re-typed." ((Math-zerop a) (if (and (Math-scalarp b) (Math-posp b)) (if (math-floatp b) (math-float a) a) - (calc-extensions) + (require 'calc-ext) (math-pow-of-zero a b))) ((or (eq a 1) (eq b 1)) a) ((or (equal a '(float 1 0)) (equal b '(float 1 0))) a) @@ -684,7 +691,7 @@ loaded and the keystroke automatically re-typed." (if (Math-scalarp a) (if (or (math-floatp a) (math-floatp b)) '(float 1 0) 1) - (calc-extensions) + (require 'calc-ext) (math-pow-zero a b))) ((and (Math-integerp b) (or (Math-numberp a) (Math-vectorp a))) (if (and (equal a '(float 1 1)) (integerp b)) @@ -692,7 +699,7 @@ loaded and the keystroke automatically re-typed." (math-with-extra-prec 2 (math-ipow a b)))) (t - (calc-extensions) + (require 'calc-ext) (math-pow-fancy a b)))) (defun math-ipow (a n) ; [O O I] [Public] @@ -750,5 +757,7 @@ doing 'M-x toggle-debug-on-error', then reproducing the bug. " ))) (defalias 'calc-report-bug 'report-calc-bug) +(provide 'calc-misc) + ;;; arch-tag: 7984d9d0-62e5-41dc-afb8-e904b975f250 ;;; calc-misc.el ends here diff --git a/lisp/calc/calc-mode.el b/lisp/calc/calc-mode.el index ff4445450f1..dfc488d49dd 100644 --- a/lisp/calc/calc-mode.el +++ b/lisp/calc/calc-mode.el @@ -3,8 +3,7 @@ ;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> -;; Maintainers: D. Goel <deego@gnufans.org> -;; Colin Walters <walters@debian.org> +;; Maintainer: Jay Belanger <belanger@truman.edu> ;; This file is part of GNU Emacs. @@ -27,15 +26,11 @@ ;;; Code: - ;; This file is autoloaded from calc-ext.el. -(require 'calc-ext) +(require 'calc-ext) (require 'calc-macs) -(defun calc-Need-calc-mode () nil) - - (defun calc-line-numbering (n) (interactive "P") (calc-wrapper @@ -672,5 +667,7 @@ (error "Unrecognized character: %c" (aref arg bad))) (calc-change-mode 'calc-matrix-brackets code t)))) +(provide 'calc-mode) + ;;; arch-tag: ecc70eea-c712-43f2-9085-4205e58d6ddf ;;; calc-mode.el ends here diff --git a/lisp/calc/calc-mtx.el b/lisp/calc/calc-mtx.el index 99442d4d33d..6cac30a3bb7 100644 --- a/lisp/calc/calc-mtx.el +++ b/lisp/calc/calc-mtx.el @@ -3,8 +3,7 @@ ;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> -;; Maintainers: D. Goel <deego@gnufans.org> -;; Colin Walters <walters@debian.org> +;; Maintainer: Jay Belanger <belanger@truman.edu> ;; This file is part of GNU Emacs. @@ -27,15 +26,11 @@ ;;; Code: - ;; This file is autoloaded from calc-ext.el. -(require 'calc-ext) +(require 'calc-ext) (require 'calc-macs) -(defun calc-Need-calc-mat () nil) - - (defun calc-mdet (arg) (interactive "P") (calc-slow-wrapper @@ -176,6 +171,10 @@ (nth 1 m) (math-reject-arg m 'square-matrixp)))) +;; The variable math-det-lu is local to math-det-raw, but is +;; used by math-det-step, which is called by math-det-raw. +(defvar math-det-lu) + (defun math-det-raw (m) (let ((n (1- (length m)))) (cond ((= n 1) @@ -211,13 +210,13 @@ (nth 3 (nth 3 m)))))) (t (let ((lud (math-matrix-lud m))) (if lud - (let ((lu (car lud))) + (let ((math-det-lu (car lud))) (math-det-step n (nth 2 lud))) 0)))))) (defun math-det-step (n prod) (if (> n 0) - (math-det-step (1- n) (math-mul prod (nth n (nth n lu)))) + (math-det-step (1- n) (math-mul prod (nth n (nth n math-det-lu)))) prod)) ;;; This returns a list (LU index d), or nil if not possible. @@ -365,5 +364,7 @@ (math-reject-arg m "*Singular matrix")) (math-reject-arg m 'square-matrixp))) +(provide 'calc-mtx) + ;;; arch-tag: fc0947b1-90e1-4a23-8950-d8ead9c3a306 ;;; calc-mtx.el ends here diff --git a/lisp/calc/calc-poly.el b/lisp/calc/calc-poly.el index 8a4b2571d20..95fdba2562c 100644 --- a/lisp/calc/calc-poly.el +++ b/lisp/calc/calc-poly.el @@ -27,13 +27,10 @@ ;;; Code: ;; This file is autoloaded from calc-ext.el. -(require 'calc-ext) +(require 'calc-ext) (require 'calc-macs) -(defun calc-Need-calc-poly () nil) - - (defun calcFunc-pcont (expr &optional var) (cond ((Math-primp expr) (cond ((Math-zerop expr) 1) @@ -516,48 +513,72 @@ ;;; Given an expression find all variables that are polynomial bases. ;;; Return list in the form '( (var1 degree1) (var2 degree2) ... ). -;;; Note dynamic scope of mpb-total-base. + +;; The variable math-poly-base-total-base is local to +;; math-total-polynomial-base, but is used by math-polynomial-p1, +;; which is called by math-total-polynomial-base. +(defvar math-poly-base-total-base) + (defun math-total-polynomial-base (expr) - (let ((mpb-total-base nil)) + (let ((math-poly-base-total-base nil)) (math-polynomial-base expr 'math-polynomial-p1) - (math-sort-poly-base-list mpb-total-base))) + (math-sort-poly-base-list math-poly-base-total-base))) + +;; The variable math-poly-base-top-expr is local to math-polynomial-base +;; in calc-alg.el, but is used by math-polynomial-p1 which is called +;; by math-polynomial-base. +(defvar math-poly-base-top-expr) (defun math-polynomial-p1 (subexpr) - (or (assoc subexpr mpb-total-base) + (or (assoc subexpr math-poly-base-total-base) (memq (car subexpr) '(+ - * / neg)) (and (eq (car subexpr) '^) (natnump (nth 2 subexpr))) (let* ((math-poly-base-variable subexpr) - (exponent (math-polynomial-p mpb-top-expr subexpr))) + (exponent (math-polynomial-p math-poly-base-top-expr subexpr))) (if exponent - (setq mpb-total-base (cons (list subexpr exponent) - mpb-total-base))))) + (setq math-poly-base-total-base (cons (list subexpr exponent) + math-poly-base-total-base))))) nil) +;; The variable math-factored-vars is local to calcFunc-factors and +;; calcFunc-factor, but is used by math-factor-expr and +;; math-factor-expr-part, which are called (directly and indirectly) by +;; calcFunc-factor and calcFunc-factors. +(defvar math-factored-vars) +;; The variable math-fact-expr is local to calcFunc-factors, +;; calcFunc-factor and math-factor-expr, but is used by math-factor-expr-try +;; and math-factor-expr-part, which are called (directly and indirectly) by +;; calcFunc-factor, calcFunc-factors and math-factor-expr. +(defvar math-fact-expr) +;; The variable math-to-list is local to calcFunc-factors and +;; calcFunc-factor, but is used by math-accum-factors, which is +;; called (indirectly) by calcFunc-factors and calcFunc-factor. +(defvar math-to-list) -(defun calcFunc-factors (expr &optional var) +(defun calcFunc-factors (math-fact-expr &optional var) (let ((math-factored-vars (if var t nil)) (math-to-list t) (calc-prefer-frac t)) (or var - (setq var (math-polynomial-base expr))) + (setq var (math-polynomial-base math-fact-expr))) (let ((res (math-factor-finish (or (catch 'factor (math-factor-expr-try var)) - expr)))) + math-fact-expr)))) (math-simplify (if (math-vectorp res) res (list 'vec (list 'vec res 1))))))) -(defun calcFunc-factor (expr &optional var) +(defun calcFunc-factor (math-fact-expr &optional var) (let ((math-factored-vars nil) (math-to-list nil) (calc-prefer-frac t)) (math-simplify (math-factor-finish (if var (let ((math-factored-vars t)) - (or (catch 'factor (math-factor-expr-try var)) expr)) - (math-factor-expr expr)))))) + (or (catch 'factor (math-factor-expr-try var)) math-fact-expr)) + (math-factor-expr math-fact-expr)))))) (defun math-factor-finish (x) (if (Math-primp x) @@ -571,18 +592,18 @@ (list 'calcFunc-Fac-Prot x) x)) -(defun math-factor-expr (expr) - (cond ((eq math-factored-vars t) expr) - ((or (memq (car-safe expr) '(* / ^ neg)) - (assq (car-safe expr) calc-tweak-eqn-table)) - (cons (car expr) (mapcar 'math-factor-expr (cdr expr)))) - ((memq (car-safe expr) '(+ -)) +(defun math-factor-expr (math-fact-expr) + (cond ((eq math-factored-vars t) math-fact-expr) + ((or (memq (car-safe math-fact-expr) '(* / ^ neg)) + (assq (car-safe math-fact-expr) calc-tweak-eqn-table)) + (cons (car math-fact-expr) (mapcar 'math-factor-expr (cdr math-fact-expr)))) + ((memq (car-safe math-fact-expr) '(+ -)) (let* ((math-factored-vars math-factored-vars) - (y (catch 'factor (math-factor-expr-part expr)))) + (y (catch 'factor (math-factor-expr-part math-fact-expr)))) (if y (math-factor-expr y) - expr))) - (t expr))) + math-fact-expr))) + (t math-fact-expr))) (defun math-factor-expr-part (x) ; uses "expr" (if (memq (car-safe x) '(+ - * / ^ neg)) @@ -590,21 +611,25 @@ (math-factor-expr-part (car x))) (and (not (Math-objvecp x)) (not (assoc x math-factored-vars)) - (> (math-factor-contains expr x) 1) + (> (math-factor-contains math-fact-expr x) 1) (setq math-factored-vars (cons (list x) math-factored-vars)) (math-factor-expr-try x)))) -(defun math-factor-expr-try (x) - (if (eq (car-safe expr) '*) - (let ((res1 (catch 'factor (let ((expr (nth 1 expr))) - (math-factor-expr-try x)))) - (res2 (catch 'factor (let ((expr (nth 2 expr))) - (math-factor-expr-try x))))) +;; The variable math-fet-x is local to math-factor-expr-try, but is +;; used by math-factor-poly-coefs, which is called by math-factor-expr-try. +(defvar math-fet-x) + +(defun math-factor-expr-try (math-fet-x) + (if (eq (car-safe math-fact-expr) '*) + (let ((res1 (catch 'factor (let ((math-fact-expr (nth 1 math-fact-expr))) + (math-factor-expr-try math-fet-x)))) + (res2 (catch 'factor (let ((math-fact-expr (nth 2 math-fact-expr))) + (math-factor-expr-try math-fet-x))))) (and (or res1 res2) - (throw 'factor (math-accum-factors (or res1 (nth 1 expr)) 1 - (or res2 (nth 2 expr)))))) - (let* ((p (math-is-polynomial expr x 30 'gen)) - (math-poly-modulus (math-poly-modulus expr)) + (throw 'factor (math-accum-factors (or res1 (nth 1 math-fact-expr)) 1 + (or res2 (nth 2 math-fact-expr)))))) + (let* ((p (math-is-polynomial math-fact-expr math-fet-x 30 'gen)) + (math-poly-modulus (math-poly-modulus math-fact-expr)) res) (and (cdr p) (setq res (math-factor-poly-coefs p)) @@ -642,11 +667,11 @@ (math-mul (math-pow fac pow) facs))) (defun math-factor-poly-coefs (p &optional square-free) ; uses "x" - (let (t1 t2) + (let (t1 t2 temp) (cond ((not (cdr p)) (or (car p) 0)) - ;; Strip off multiples of x. + ;; Strip off multiples of math-fet-x. ((Math-zerop (car p)) (let ((z 0)) (while (and p (Math-zerop (car p))) @@ -654,7 +679,7 @@ (if (cdr p) (setq p (math-factor-poly-coefs p square-free)) (setq p (math-sort-terms (math-factor-expr (car p))))) - (math-accum-factors x z (math-factor-protect p)))) + (math-accum-factors math-fet-x z (math-factor-protect p)))) ;; Factor out content. ((and (not square-free) @@ -665,12 +690,12 @@ (math-accum-factors t1 1 (math-factor-poly-coefs (math-poly-div-list p t1) 'cont))) - ;; Check if linear in x. + ;; Check if linear in math-fet-x. ((not (cdr (cdr p))) (math-add (math-factor-protect (math-sort-terms (math-factor-expr (car p)))) - (math-mul x (math-factor-protect + (math-mul math-fet-x (math-factor-protect (math-sort-terms (math-factor-expr (nth 1 p))))))) @@ -683,7 +708,7 @@ (setq pp (cdr pp))) pp) (let ((res (math-rewrite - (list 'calcFunc-thecoefs x (cons 'vec p)) + (list 'calcFunc-thecoefs math-fet-x (cons 'vec p)) '(var FactorRules var-FactorRules)))) (or (and (eq (car-safe res) 'calcFunc-thefactors) (= (length res) 3) @@ -693,7 +718,7 @@ (while (setq vec (cdr vec)) (setq facs (math-accum-factors (car vec) 1 facs))) facs)) - (math-build-polynomial-expr p x)))) + (math-build-polynomial-expr p math-fet-x)))) ;; Check if rational coefficients (i.e., not modulo a prime). ((eq math-poly-modulus 1) @@ -724,12 +749,13 @@ (setq scale (math-div scale den)) (math-add (math-add - (math-mul den (math-pow x 2)) - (math-mul (math-mul coef1 den) x)) + (math-mul den (math-pow math-fet-x 2)) + (math-mul (math-mul coef1 den) + math-fet-x)) (math-mul coef0 den))) (let ((den (math-lcm-denoms coef0))) (setq scale (math-div scale den)) - (math-add (math-mul den x) + (math-add (math-mul den math-fet-x) (math-mul coef0 den)))) 1 expr) roots (cdr roots)))) @@ -738,8 +764,8 @@ (math-mul csign (math-build-polynomial-expr (math-mul-list (nth 1 t1) scale) - x))))) - (math-build-polynomial-expr p x)) ; can't factor it. + math-fet-x))))) + (math-build-polynomial-expr p math-fet-x)) ; can't factor it. ;; Separate out the squared terms (Knuth exercise 4.6.2-34). ;; This step also divides out the content of the polynomial. @@ -1144,5 +1170,7 @@ (defun calcFunc-expandpow (x n) (math-normalize (math-expand-power x n))) +(provide 'calc-poly) + ;;; arch-tag: d2566c51-2ccc-45f1-8c50-f3462c2953ff ;;; calc-poly.el ends here diff --git a/lisp/calc/calc-prog.el b/lisp/calc/calc-prog.el index 93250299f73..f0a86b6f07a 100644 --- a/lisp/calc/calc-prog.el +++ b/lisp/calc/calc-prog.el @@ -26,14 +26,11 @@ ;;; Code: - ;; This file is autoloaded from calc-ext.el. -(require 'calc-ext) +(require 'calc-ext) (require 'calc-macs) -(defun calc-Need-calc-prog () nil) - (defun calc-equal-to (arg) (interactive "P") @@ -271,7 +268,7 @@ x))) calc-user-formula-alist)) (if cmd (progn - (calc-need-macros) + (require 'calc-macs) (fset cmd (list 'lambda '() @@ -1711,7 +1708,7 @@ ;;; Compiling Lisp-like forms to use the math library. (defun math-do-defmath (func args body) - (calc-need-macros) + (require 'calc-macs) (let* ((fname (intern (concat "calcFunc-" (symbol-name func)))) (doc (if (stringp (car body)) (list (car body)))) (clargs (mapcar 'math-clean-arg args)) @@ -2283,5 +2280,7 @@ (math-read-expr-level (nth 3 op)) (nth 1 x)) (throw 'syntax "Syntax error")))))) +(provide 'calc-prog) + ;;; arch-tag: 4c5a183b-c9e5-4632-bb3f-e41a764518b0 ;;; calc-prog.el ends here diff --git a/lisp/calc/calc-rewr.el b/lisp/calc/calc-rewr.el index 85e4700ef10..f5788fa6e84 100644 --- a/lisp/calc/calc-rewr.el +++ b/lisp/calc/calc-rewr.el @@ -27,13 +27,10 @@ ;;; Code: ;; This file is autoloaded from calc-ext.el. -(require 'calc-ext) +(require 'calc-ext) (require 'calc-macs) -(defun calc-Need-calc-rewr () nil) - - (defvar math-rewrite-default-iters 100) ;; The variable calc-rewr-sel is local to calc-rewrite-selection and @@ -2116,5 +2113,7 @@ nil nil) (cdr rules))))))) +(provide 'calc-rewr) + ;;; arch-tag: ca8d7b7d-bff1-4535-90f3-e2241f5e786b ;;; calc-rewr.el ends here diff --git a/lisp/calc/calc-rules.el b/lisp/calc/calc-rules.el index f11df8e1f56..1ccbf3fffac 100644 --- a/lisp/calc/calc-rules.el +++ b/lisp/calc/calc-rules.el @@ -3,8 +3,7 @@ ;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> -;; Maintainers: D. Goel <deego@gnufans.org> -;; Colin Walters <walters@debian.org> +;; Maintainer: Jay Belanger <belanger@truman.edu> ;; This file is part of GNU Emacs. @@ -28,13 +27,10 @@ ;;; Code: ;; This file is autoloaded from calc-ext.el. -(require 'calc-ext) +(require 'calc-ext) (require 'calc-macs) -(defun calc-Need-calc-rules () nil) - - (defun calc-compile-rule-set (name rules) (prog2 (message "Preparing rule set %s..." name) @@ -438,5 +434,7 @@ fitsystem(y, xv, pv, 0) := fitsystem(y, xv, cons(fvh,fvt)) hasfitparams(pv)))), fitparam(n) = x := x ]")) +(provide 'calc-rules) + ;;; arch-tag: 0ed54a52-38f3-4ed7-9ca7-b8ecf8f2febe ;;; calc-rules.el ends here diff --git a/lisp/calc/calc-sel.el b/lisp/calc/calc-sel.el index 05ea6b82993..7b45814f1e7 100644 --- a/lisp/calc/calc-sel.el +++ b/lisp/calc/calc-sel.el @@ -3,8 +3,7 @@ ;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> -;; Maintainers: D. Goel <deego@gnufans.org> -;; Colin Walters <walters@debian.org> +;; Maintainer: Jay Belanger <belanger@truman.edu> ;; This file is part of GNU Emacs. @@ -28,13 +27,10 @@ ;;; Code: ;; This file is autoloaded from calc-ext.el. -(require 'calc-ext) +(require 'calc-ext) (require 'calc-macs) -(defun calc-Need-calc-sel () nil) - - ;;; Selection commands. (defvar calc-keep-selection t) @@ -416,6 +412,10 @@ (setcar x (list 'cplx (car x) 0)) (calc-encase-atoms-rec (car x))))))) +;; The variable math-comp-sel-tag is local to calc-find-selected-part, +;; but is used by math-comp-sel-flat-term and math-comp-add-string-sel +;; in calccomp.el, which are called (indirectly) by calc-find-selected-part. + (defun calc-find-selected-part () (let* ((math-comp-sel-hpos (- (current-column) calc-selection-cache-offset)) toppt @@ -857,5 +857,7 @@ (interactive "P") (calc-sel-add-both-sides no-simp t)) +(provide 'calc-sel) + ;;; arch-tag: e5169792-777d-428f-bff5-acca66813fa2 ;;; calc-sel.el ends here diff --git a/lisp/calc/calc-stat.el b/lisp/calc/calc-stat.el index 42d58776a47..9fdd634027e 100644 --- a/lisp/calc/calc-stat.el +++ b/lisp/calc/calc-stat.el @@ -3,8 +3,7 @@ ;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> -;; Maintainers: D. Goel <deego@gnufans.org> -;; Colin Walters <walters@debian.org> +;; Maintainer: Jay Belanger <belanger@truman.edu> ;; This file is part of GNU Emacs. @@ -28,13 +27,10 @@ ;;; Code: ;; This file is autoloaded from calc-ext.el. -(require 'calc-ext) +(require 'calc-ext) (require 'calc-macs) -(defun calc-Need-calc-stat () nil) - - ;;; Statistical operations on vectors. (defun calc-vector-count (arg) @@ -586,5 +582,7 @@ (math-div (math-mul suminvsqrwts (1- len)) len)) (if pop len (1- len))))))))) +(provide 'calc-stat) + ;;; arch-tag: 423858e9-8513-489c-9f35-710cd9d9c307 ;;; calc-stat.el ends here diff --git a/lisp/calc/calc-store.el b/lisp/calc/calc-store.el index cb7156bfc78..2dca53b46bb 100644 --- a/lisp/calc/calc-store.el +++ b/lisp/calc/calc-store.el @@ -3,8 +3,7 @@ ;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> -;; Maintainers: D. Goel <deego@gnufans.org> -;; Colin Walters <walters@debian.org> +;; Maintainer: Jay Belanger <belanger@truman.edu> ;; This file is part of GNU Emacs. @@ -28,13 +27,10 @@ ;;; Code: ;; This file is autoloaded from calc-ext.el. -(require 'calc-ext) +(require 'calc-ext) (require 'calc-macs) -(defun calc-Need-calc-store () nil) - - ;;; Memory commands. (defvar calc-store-keep nil) @@ -44,6 +40,8 @@ (calc-store-into var))) (defvar calc-given-value-flag nil) +(defvar calc-given-value) + (defun calc-store-into (&optional var) (interactive) (calc-wrapper @@ -155,6 +153,24 @@ tag (and (not val) 1)) (message "Stored to variable \"%s\"" (calc-var-name var))))))) +(defvar calc-var-name-map nil "Keymap for reading Calc variable names.") +(if calc-var-name-map + () + (setq calc-var-name-map (copy-keymap minibuffer-local-completion-map)) + (define-key calc-var-name-map " " 'self-insert-command) + (mapcar (function + (lambda (x) + (define-key calc-var-name-map (char-to-string x) + 'calcVar-digit))) + "0123456789") + (mapcar (function + (lambda (x) + (define-key calc-var-name-map (char-to-string x) + 'calcVar-oper))) + "+-*/^|")) + +(defvar calc-store-opers) + (defun calc-read-var-name (prompt &optional calc-store-opers) (setq calc-given-value nil calc-aborted-prefix nil) @@ -178,22 +194,6 @@ svar)) (intern var))))) -(defvar calc-var-name-map nil "Keymap for reading Calc variable names.") -(if calc-var-name-map - () - (setq calc-var-name-map (copy-keymap minibuffer-local-completion-map)) - (define-key calc-var-name-map " " 'self-insert-command) - (mapcar (function - (lambda (x) - (define-key calc-var-name-map (char-to-string x) - 'calcVar-digit))) - "0123456789") - (mapcar (function - (lambda (x) - (define-key calc-var-name-map (char-to-string x) - 'calcVar-oper))) - "+-*/^|")) - (defun calcVar-digit () (interactive) (if (calc-minibuffer-contains "var-\\'") @@ -530,11 +530,16 @@ var-PlotData5 var-PlotData6 var-DUMMY)) +;; The variable calc-pv-pos is local to calc-permanent-variable, but +;; used by calc-insert-permanent-variable, which is called by +;; calc-permanent-variable. +(defvar calc-pv-pos) + (defun calc-permanent-variable (&optional var) (interactive) (calc-wrapper (or var (setq var (calc-read-var-name "Save variable (default=all): "))) - (let (pos) + (let (calc-pv-pos) (and var (or (and (boundp var) (symbol-value var)) (error "No such variable"))) (set-buffer (find-file-noselect (substitute-in-file-name @@ -556,16 +561,16 @@ (goto-char (point-min)) (if (search-forward (concat "(setq " (symbol-name var) " '") nil t) (progn - (setq pos (point-marker)) + (setq calc-pv-pos (point-marker)) (forward-line -1) (if (looking-at ";;; Variable .* stored by Calc on ") (progn (delete-region (match-end 0) (progn (end-of-line) (point))) (insert (current-time-string)))) - (goto-char (- pos 8 (length (symbol-name var)))) + (goto-char (- calc-pv-pos 8 (length (symbol-name var)))) (forward-sexp 1) (backward-char 1) - (delete-region pos (point))) + (delete-region calc-pv-pos (point))) (goto-char (point-max)) (insert "\n;;; Variable \"" (symbol-name var) @@ -619,5 +624,7 @@ (calc-slow-wrapper (calc-binary-op "sub" 'calcFunc-subscr arg))) +(provide 'calc-store) + ;;; arch-tag: 2fbfec82-a521-42ca-bcd8-4f254ae6313e ;;; calc-store.el ends here diff --git a/lisp/calc/calc-stuff.el b/lisp/calc/calc-stuff.el index 6b261398842..8d2180c9c47 100644 --- a/lisp/calc/calc-stuff.el +++ b/lisp/calc/calc-stuff.el @@ -3,8 +3,7 @@ ;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> -;; Maintainers: D. Goel <deego@gnufans.org> -;; Colin Walters <walters@debian.org> +;; Maintainer: Jay Belanger <belanger@truman.edu> ;; This file is part of GNU Emacs. @@ -28,13 +27,10 @@ ;;; Code: ;; This file is autoloaded from calc-ext.el. -(require 'calc-ext) +(require 'calc-ext) (require 'calc-macs) -(defun calc-Need-calc-stuff () nil) - - (defun calc-num-prefix (n) "Use the number at the top of stack as the numeric prefix for the next command. With a prefix, push that prefix as a number onto the stack." @@ -165,6 +161,18 @@ With a prefix, push that prefix as a number onto the stack." (interactive) (message "Calc %s" calc-version)) +;; The following caches are declared in other files, but are +;; reset here. +(defvar math-lud-cache) ; calc-mtx.el +(defvar math-log2-cache) ; calc-bin.el +(defvar math-radix-digits-cache) ; calc-bin.el +(defvar math-radix-float-cache-tag) ; calc-bin.el +(defvar math-random-cache) ; calc-comb.el +(defvar math-max-digits-cache) ; calc-bin.el +(defvar math-integral-cache) ; calcalg2.el +(defvar math-units-table) ; calc-units.el +(defvar math-format-date-cache) ; calc-forms.el +(defvar math-holidays-cache-tag) ; calc-forms.el (defun calc-flush-caches (&optional inhibit-msg) (interactive "P") @@ -175,13 +183,10 @@ With a prefix, push that prefix as a number onto the stack." math-radix-float-cache-tag nil math-random-cache nil math-max-digits-cache nil - math-checked-rewrites nil math-integral-cache nil math-units-table nil math-decls-cache-tag nil math-eval-rules-cache-tag t - math-graph-var-cache nil - math-graph-data-cache nil math-format-date-cache nil math-holidays-cache-tag t) (mapcar (function (lambda (x) (set x -100))) math-cache-list) @@ -270,17 +275,22 @@ With a prefix, push that prefix as a number onto the stack." (math-map-over-constants (function (lambda (x) (calcFunc-frac x tol))) a)) -(defun math-map-over-constants (func expr) +;; The variable math-moc-func is local to math-map-over-constants, +;; but is used by math-map-over-constants-rec, which is called by +;; math-map-over-constants. +(defvar math-moc-func) + +(defun math-map-over-constants (math-moc-func expr) (math-map-over-constants-rec expr)) (defun math-map-over-constants-rec (expr) (cond ((or (Math-primp expr) (memq (car expr) '(intv sdev))) (or (and (Math-objectp expr) - (funcall func expr)) + (funcall math-moc-func expr)) expr)) ((and (memq (car expr) '(^ calcFunc-subscr)) - (eq func 'math-float) + (eq math-moc-func 'math-float) (= (length expr) 3) (Math-integerp (nth 2 expr))) (list (car expr) @@ -288,5 +298,7 @@ With a prefix, push that prefix as a number onto the stack." (nth 2 expr))) (t (cons (car expr) (mapcar 'math-map-over-constants-rec (cdr expr)))))) +(provide 'calc-stuff) + ;;; arch-tag: 789332ef-a178-49d3-8fb7-5d7ed7e21f56 ;;; calc-stuff.el ends here diff --git a/lisp/calc/calc-trail.el b/lisp/calc/calc-trail.el index cee2b4fc461..4ecc9a06651 100644 --- a/lisp/calc/calc-trail.el +++ b/lisp/calc/calc-trail.el @@ -3,8 +3,7 @@ ;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> -;; Maintainers: D. Goel <deego@gnufans.org> -;; Colin Walters <walters@debian.org> +;; Maintainer: Jay Belanger <belanger@truman.edu> ;; This file is part of GNU Emacs. @@ -28,13 +27,10 @@ ;;; Code: ;; This file is autoloaded from calc-ext.el. -(require 'calc-ext) +(require 'calc-ext) (require 'calc-macs) -(defun calc-Need-calc-trail () nil) - - ;;; Trail commands. (defun calc-trail-in () @@ -177,5 +173,7 @@ (kill-line n))) (calc-trail-here))) +(provide 'calc-trail) + ;;; arch-tag: 59b76655-d882-4aab-a3ee-b83870e530d0 ;;; calc-trail.el ends here diff --git a/lisp/calc/calc-undo.el b/lisp/calc/calc-undo.el index 4e9a14f4aa5..a49c34010ab 100644 --- a/lisp/calc/calc-undo.el +++ b/lisp/calc/calc-undo.el @@ -3,8 +3,7 @@ ;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> -;; Maintainers: D. Goel <deego@gnufans.org> -;; Colin Walters <walters@debian.org> +;; Maintainer: Jay Belanger <belanger@truman.edu> ;; This file is part of GNU Emacs. @@ -28,13 +27,10 @@ ;;; Code: ;; This file is autoloaded from calc-ext.el. -(require 'calc-ext) +(require 'calc-ext) (require 'calc-macs) -(defun calc-Need-calc-undo () nil) - - ;;; Undo. (defun calc-undo (n) @@ -150,5 +146,7 @@ (or (eq (car (car list)) 'pop) (calc-undo-does-pushes (cdr list))))) +(provide 'calc-undo) + ;;; arch-tag: eeb485d2-fb3d-454a-9d79-450af1f50d6c ;;; calc-undo.el ends here diff --git a/lisp/calc/calc-units.el b/lisp/calc/calc-units.el index f0c29134799..d473b02c0a6 100644 --- a/lisp/calc/calc-units.el +++ b/lisp/calc/calc-units.el @@ -27,12 +27,10 @@ ;;; Code: ;; This file is autoloaded from calc-ext.el. -(require 'calc-ext) +(require 'calc-ext) (require 'calc-macs) -(defun calc-Need-calc-units () nil) - ;;; Units operations. ;;; Units table last updated 9-Jan-91 by Ulrich Mueller (ulm@vsnhd1.cern.ch) @@ -313,7 +311,8 @@ Entries are (SYMBOL EXPR DOC-STRING TEMP-TYPE BASE-UNITS).") (calc-slow-wrapper (let ((expr (calc-top-n 1)) (uoldname nil) - unew) + unew + units) (unless (math-units-in-expr-p expr t) (let ((uold (or old-units (progn @@ -409,20 +408,26 @@ Entries are (SYMBOL EXPR DOC-STRING TEMP-TYPE BASE-UNITS).") (calc-enter-result 1 "rmun" (math-simplify-units (math-extract-units (calc-top-n 1)))))) +;; The variables calc-num-units and calc-den-units are local to +;; calc-explain-units, but are used by calc-explain-units-rec, +;; which is called by calc-explain-units. +(defvar calc-num-units) +(defvar calc-den-units) + (defun calc-explain-units () (interactive) (calc-wrapper - (let ((num-units nil) - (den-units nil)) + (let ((calc-num-units nil) + (calc-den-units nil)) (calc-explain-units-rec (calc-top-n 1) 1) - (and den-units (string-match "^[^(].* .*[^)]$" den-units) - (setq den-units (concat "(" den-units ")"))) - (if num-units - (if den-units - (message "%s per %s" num-units den-units) - (message "%s" num-units)) - (if den-units - (message "1 per %s" den-units) + (and calc-den-units (string-match "^[^(].* .*[^)]$" calc-den-units) + (setq calc-den-units (concat "(" calc-den-units ")"))) + (if calc-num-units + (if calc-den-units + (message "%s per %s" calc-num-units calc-den-units) + (message "%s" calc-num-units)) + (if calc-den-units + (message "1 per %s" calc-den-units) (message "No units in expression")))))) (defun calc-explain-units-rec (expr pow) @@ -463,11 +468,11 @@ Entries are (SYMBOL EXPR DOC-STRING TEMP-TYPE BASE-UNITS).") (setq name (concat name "^" (math-format-number (math-abs pow)))))) (if (math-posp pow) - (setq num-units (if num-units - (concat num-units " " name) + (setq calc-num-units (if calc-num-units + (concat calc-num-units " " name) name)) - (setq den-units (if den-units - (concat den-units " " name) + (setq calc-den-units (if calc-den-units + (concat calc-den-units " " name) name)))) (cond ((eq (car-safe expr) '*) (calc-explain-units-rec (nth 1 expr) pow) @@ -615,12 +620,18 @@ Entries are (SYMBOL EXPR DOC-STRING TEMP-TYPE BASE-UNITS).") (save-buffer)))) +;; The variable math-cu-unit-list is local to math-build-units-table, +;; but is used by math-compare-unit-names, which is called (indirectly) +;; by math-build-units-table. +;; math-cu-unit-list is also local to math-convert-units, but is used +;; by math-convert-units-rec, which is called by math-convert-units. +(defvar math-cu-unit-list) (defun math-build-units-table () (or math-units-table (let* ((combined-units (append math-additional-units math-standard-units)) - (unit-list (mapcar 'car combined-units)) + (math-cu-unit-list (mapcar 'car combined-units)) tab) (message "Building units table...") (setq math-units-table-buffer-valid nil) @@ -646,28 +657,34 @@ Entries are (SYMBOL EXPR DOC-STRING TEMP-TYPE BASE-UNITS).") (message "Building units table...done") (setq math-units-table tab)))) -(defun math-find-base-units (entry) - (if (eq (nth 4 entry) 'boom) - (error "Circular definition involving unit %s" (car entry))) - (or (nth 4 entry) - (let (base) - (setcar (nthcdr 4 entry) 'boom) - (math-find-base-units-rec (nth 1 entry) 1) - '(or base - (error "Dimensionless definition for unit %s" (car entry))) - (while (eq (cdr (car base)) 0) - (setq base (cdr base))) - (let ((b base)) +;; The variables math-fbu-base and math-fbu-entry are local to +;; math-find-base-units, but are used by math-find-base-units-rec, +;; which is called by math-find-base-units. +(defvar math-fbu-base) +(defvar math-fbu-entry) + +(defun math-find-base-units (math-fbu-entry) + (if (eq (nth 4 math-fbu-entry) 'boom) + (error "Circular definition involving unit %s" (car math-fbu-entry))) + (or (nth 4 math-fbu-entry) + (let (math-fbu-base) + (setcar (nthcdr 4 math-fbu-entry) 'boom) + (math-find-base-units-rec (nth 1 math-fbu-entry) 1) + '(or math-fbu-base + (error "Dimensionless definition for unit %s" (car math-fbu-entry))) + (while (eq (cdr (car math-fbu-base)) 0) + (setq math-fbu-base (cdr math-fbu-base))) + (let ((b math-fbu-base)) (while (cdr b) (if (eq (cdr (car (cdr b))) 0) (setcdr b (cdr (cdr b))) (setq b (cdr b))))) - (setq base (sort base 'math-compare-unit-names)) - (setcar (nthcdr 4 entry) base) - base))) + (setq math-fbu-base (sort math-fbu-base 'math-compare-unit-names)) + (setcar (nthcdr 4 math-fbu-entry) math-fbu-base) + math-fbu-base))) (defun math-compare-unit-names (a b) - (memq (car b) (cdr (memq (car a) unit-list)))) + (memq (car b) (cdr (memq (car a) math-cu-unit-list)))) (defun math-find-base-units-rec (expr pow) (let ((u (math-check-unit-name expr))) @@ -675,10 +692,11 @@ Entries are (SYMBOL EXPR DOC-STRING TEMP-TYPE BASE-UNITS).") (let ((ulist (math-find-base-units u))) (while ulist (let ((p (* (cdr (car ulist)) pow)) - (old (assq (car (car ulist)) base))) + (old (assq (car (car ulist)) math-fbu-base))) (if old (setcdr old (+ (cdr old) p)) - (setq base (cons (cons (car (car ulist)) p) base)))) + (setq math-fbu-base + (cons (cons (car (car ulist)) p) math-fbu-base)))) (setq ulist (cdr ulist))))) ((math-scalarp expr)) ((and (eq (car expr) '^) @@ -697,8 +715,8 @@ Entries are (SYMBOL EXPR DOC-STRING TEMP-TYPE BASE-UNITS).") ((eq (car expr) 'var) (or (eq (nth 1 expr) 'pi) (error "Unknown name %s in defining expression for unit %s" - (nth 1 expr) (car entry)))) - (t (error "Malformed defining expression for unit %s" (car entry)))))) + (nth 1 expr) (car math-fbu-entry)))) + (t (error "Malformed defining expression for unit %s" (car math-fbu-entry)))))) (defun math-units-in-expr-p (expr sub-exprs) @@ -751,8 +769,12 @@ Entries are (SYMBOL EXPR DOC-STRING TEMP-TYPE BASE-UNITS).") (assq (intern (substring name 3)) math-units-table)))))))) +;; The variable math-which-standard is local to math-to-standard-units, +;; but is used by math-to-standard-rec, which is called by +;; math-to-standard-units. +(defvar math-which-standard) -(defun math-to-standard-units (expr which-standard) +(defun math-to-standard-units (expr math-which-standard) (math-to-standard-rec expr)) (defun math-to-standard-rec (expr) @@ -763,7 +785,7 @@ Entries are (SYMBOL EXPR DOC-STRING TEMP-TYPE BASE-UNITS).") (progn (if (nth 1 u) (setq expr (math-to-standard-rec (nth 1 u))) - (let ((st (assq (car u) which-standard))) + (let ((st (assq (car u) math-which-standard))) (if st (setq expr (nth 1 st)) (setq expr (list 'var (car u) @@ -842,9 +864,14 @@ Entries are (SYMBOL EXPR DOC-STRING TEMP-TYPE BASE-UNITS).") unit nil)) t))) +;; The variable math-fcu-u is local to math-find-compatible-unit, +;; but is used by math-find-compatible-rec which is called by +;; math-find-compatible-unit. +(defvar math-fcu-u) + (defun math-find-compatible-unit (expr unit) - (let ((u (math-check-unit-name unit))) - (if u + (let ((math-fcu-u (math-check-unit-name unit))) + (if math-fcu-u (math-find-compatible-unit-rec expr 1)))) (defun math-find-compatible-unit-rec (expr pow) @@ -859,39 +886,47 @@ Entries are (SYMBOL EXPR DOC-STRING TEMP-TYPE BASE-UNITS).") (math-find-compatible-unit-rec (nth 1 expr) (* pow (nth 2 expr)))) (t (let ((u2 (math-check-unit-name expr))) - (if (equal (nth 4 u) (nth 4 u2)) + (if (equal (nth 4 math-fcu-u) (nth 4 u2)) (cons expr pow)))))) -(defun math-convert-units (expr new-units &optional pure) +;; The variables math-cu-new-units and math-cu-pure are local to +;; math-convert-units, but are used by math-convert-units-rec, +;; which is called by math-convert-units. +(defvar math-cu-new-units) +(defvar math-cu-pure) + +(defun math-convert-units (expr math-cu-new-units &optional math-cu-pure) (math-with-extra-prec 2 - (let ((compat (and (not pure) (math-find-compatible-unit expr new-units))) - (unit-list nil) + (let ((compat (and (not math-cu-pure) + (math-find-compatible-unit expr math-cu-new-units))) + (math-cu-unit-list nil) (math-combining-units nil)) (if compat (math-simplify-units (math-mul (math-mul (math-simplify-units (math-div expr (math-pow (car compat) (cdr compat)))) - (math-pow new-units (cdr compat))) + (math-pow math-cu-new-units (cdr compat))) (math-simplify-units (math-to-standard-units - (math-pow (math-div (car compat) new-units) + (math-pow (math-div (car compat) math-cu-new-units) (cdr compat)) nil)))) - (when (setq unit-list (math-decompose-units new-units)) - (setq new-units (nth 2 (car unit-list)))) + (when (setq math-cu-unit-list (math-decompose-units math-cu-new-units)) + (setq math-cu-new-units (nth 2 (car math-cu-unit-list)))) (when (eq (car-safe expr) '+) (setq expr (math-simplify-units expr))) (if (math-units-in-expr-p expr t) (math-convert-units-rec expr) (math-apply-units (math-to-standard-units - (list '/ expr new-units) nil) - new-units unit-list pure)))))) + (list '/ expr math-cu-new-units) nil) + math-cu-new-units math-cu-unit-list math-cu-pure)))))) (defun math-convert-units-rec (expr) (if (math-units-in-expr-p expr nil) - (math-apply-units (math-to-standard-units (list '/ expr new-units) nil) - new-units unit-list pure) + (math-apply-units (math-to-standard-units + (list '/ expr math-cu-new-units) nil) + math-cu-new-units math-cu-unit-list math-cu-pure) (if (Math-primp expr) expr (cons (car expr) @@ -1026,10 +1061,12 @@ Entries are (SYMBOL EXPR DOC-STRING TEMP-TYPE BASE-UNITS).") (setcar unitp pname) math-simplify-expr))))))) +(defvar math-try-cancel-units) + (math-defsimplify / (and math-simplifying-units (let ((np (cdr math-simplify-expr)) - (try-cancel-units 0) + (math-try-cancel-units 0) n nn) (setq n (if (eq (car-safe (nth 2 math-simplify-expr)) '*) (cdr (nth 2 math-simplify-expr)) @@ -1044,7 +1081,7 @@ Entries are (SYMBOL EXPR DOC-STRING TEMP-TYPE BASE-UNITS).") (math-simplify-units-divisor (cdr n) (cdr (cdr math-simplify-expr))) (setq np (cdr (cdr n)))) (math-simplify-units-divisor np (cdr (cdr math-simplify-expr))) - (if (eq try-cancel-units 0) + (if (eq math-try-cancel-units 0) (let* ((math-simplifying-units nil) (base (math-simplify (math-to-standard-units math-simplify-expr nil)))) @@ -1089,8 +1126,8 @@ Entries are (SYMBOL EXPR DOC-STRING TEMP-TYPE BASE-UNITS).") (setq ud1 ud) (while ud1 (and (eq (car (car un)) (car (car ud1))) - (setq try-cancel-units - (+ try-cancel-units + (setq math-try-cancel-units + (+ math-try-cancel-units (- (* (cdr (car un)) pow1) (* (cdr (car ud)) pow2))))) (setq ud1 (cdr ud1))) @@ -1304,6 +1341,8 @@ Entries are (SYMBOL EXPR DOC-STRING TEMP-TYPE BASE-UNITS).") (pop-to-buffer (get-buffer "*Units Table*")) (display-buffer (get-buffer "*Units Table*"))))) +(provide 'calc-units) + ;; Local Variables: ;; coding: iso-latin-1 ;; End: diff --git a/lisp/calc/calc-vec.el b/lisp/calc/calc-vec.el index a78f98ec3cc..2ae327b36bf 100644 --- a/lisp/calc/calc-vec.el +++ b/lisp/calc/calc-vec.el @@ -3,8 +3,7 @@ ;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> -;; Maintainers: D. Goel <deego@gnufans.org> -;; Colin Walters <walters@debian.org> +;; Maintainer: Jay Belanger <belanger@truman.edu> ;; This file is part of GNU Emacs. @@ -28,13 +27,10 @@ ;;; Code: ;; This file is autoloaded from calc-ext.el. -(require 'calc-ext) +(require 'calc-ext) (require 'calc-macs) -(defun calc-Need-calc-vec () nil) - - (defun calc-display-strings (n) (interactive "P") (calc-wrapper @@ -1101,21 +1097,26 @@ (cons 'vec (nreverse (sort (copy-sequence (cdr vec)) 'math-beforep))) (math-reject-arg vec 'vectorp))) -(defun calcFunc-grade (grade-vec) - (if (math-vectorp grade-vec) - (let* ((len (1- (length grade-vec)))) +;; The variable math-grade-vec is local to calcFunc-grade and +;; calcFunc-rgrade, but is used by math-grade-beforep, which is called +;; by calcFunc-grade and calcFunc-rgrade. +(defvar math-grade-vec) + +(defun calcFunc-grade (math-grade-vec) + (if (math-vectorp math-grade-vec) + (let* ((len (1- (length math-grade-vec)))) (cons 'vec (sort (cdr (calcFunc-index len)) 'math-grade-beforep))) - (math-reject-arg grade-vec 'vectorp))) + (math-reject-arg math-grade-vec 'vectorp))) -(defun calcFunc-rgrade (grade-vec) - (if (math-vectorp grade-vec) - (let* ((len (1- (length grade-vec)))) +(defun calcFunc-rgrade (math-grade-vec) + (if (math-vectorp math-grade-vec) + (let* ((len (1- (length math-grade-vec)))) (cons 'vec (nreverse (sort (cdr (calcFunc-index len)) 'math-grade-beforep)))) - (math-reject-arg grade-vec 'vectorp))) + (math-reject-arg math-grade-vec 'vectorp))) (defun math-grade-beforep (i j) - (math-beforep (nth i grade-vec) (nth j grade-vec))) + (math-beforep (nth i math-grade-vec) (nth j math-grade-vec))) ;;; Compile a histogram of data from a vector. @@ -1461,14 +1462,26 @@ +;; The variable math-rb-close is local to math-read-brackets, but +;; is used by math-read-vector, which is called (directly and +;; indirectly) by math-read-brackets. +(defvar math-rb-close) +;; The next few variables are local to math-read-exprs in calc-aent.el +;; and math-read-expr in calc-ext.el, but are set in functions they call. +(defvar math-exp-pos) +(defvar math-exp-str) +(defvar math-exp-old-pos) +(defvar math-exp-token) +(defvar math-exp-keep-spaces) +(defvar math-expr-data) -(defun math-read-brackets (space-sep close) +(defun math-read-brackets (space-sep math-rb-close) (and space-sep (setq space-sep (not (math-check-for-commas)))) (math-read-token) (while (eq math-exp-token 'space) (math-read-token)) - (if (or (equal math-expr-data close) + (if (or (equal math-expr-data math-rb-close) (eq math-exp-token 'end)) (progn (math-read-token) @@ -1495,7 +1508,7 @@ (setq vals2 (catch 'syntax (math-read-vector)))) (if (and (not (stringp vals2)) (or (assoc math-expr-data '(("\\ldots") ("\\dots") (";"))) - (equal math-expr-data close) + (equal math-expr-data math-rb-close) (eq math-exp-token 'end))) (setq space-sep nil vals vals2) @@ -1509,7 +1522,7 @@ (math-read-token) (setq vals (if (> (length vals) 2) (cons 'calcFunc-mul (cdr vals)) (nth 1 vals))) - (let ((exp2 (if (or (equal math-expr-data close) + (let ((exp2 (if (or (equal math-expr-data math-rb-close) (equal math-expr-data ")") (eq math-exp-token 'end)) '(var inf var-inf) @@ -1519,14 +1532,14 @@ (if (equal math-expr-data ")") 2 3) vals exp2))) - (if (not (or (equal math-expr-data close) + (if (not (or (equal math-expr-data math-rb-close) (equal math-expr-data ")") (eq math-exp-token 'end))) (throw 'syntax "Expected `]'"))) (if (equal math-expr-data ";") (let ((math-exp-keep-spaces space-sep)) (setq vals (cons 'vec (math-read-matrix (list vals)))))) - (if (not (or (equal math-expr-data close) + (if (not (or (equal math-expr-data math-rb-close) (eq math-exp-token 'end))) (throw 'syntax "Expected `]'"))) (or (eq math-exp-token 'end) @@ -1557,7 +1570,7 @@ (math-read-token)) (and (not (eq math-exp-token 'end)) (not (equal math-expr-data ";")) - (not (equal math-expr-data close)) + (not (equal math-expr-data math-rb-close)) (not (equal math-expr-data "\\dots")) (not (equal math-expr-data "\\ldots")))) (if (equal math-expr-data ",") @@ -1577,5 +1590,7 @@ (setq mat (nconc mat (list (math-read-vector))))) mat) +(provide 'calc-vec) + ;;; arch-tag: 7902a7af-ec69-440a-8635-ebb4db263402 ;;; calc-vec.el ends here diff --git a/lisp/calc/calc-yank.el b/lisp/calc/calc-yank.el index eff391e81b8..0470abca536 100644 --- a/lisp/calc/calc-yank.el +++ b/lisp/calc/calc-yank.el @@ -3,8 +3,7 @@ ;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> -;; Maintainers: D. Goel <deego@gnufans.org> -;; Colin Walters <walters@debian.org> +;; Maintainer: Jay Belanger <belanger@truman.edu> ;; This file is part of GNU Emacs. @@ -28,13 +27,10 @@ ;;; Code: ;; This file is autoloaded from calc-ext.el. -(require 'calc-ext) +(require 'calc-ext) (require 'calc-macs) -(defun calc-Need-calc-yank () nil) - - ;;; Kill ring commands. (defun calc-kill (nn &optional no-delete) @@ -428,6 +424,13 @@ (define-key calc-edit-mode-map "\r" 'calc-edit-return) (define-key calc-edit-mode-map "\C-c\C-c" 'calc-edit-finish)) +(defvar calc-original-buffer) +(defvar calc-return-buffer) +(defvar calc-one-window) +(defvar calc-edit-handler) +(defvar calc-restore-trail) +(defvar calc-allow-ret) + (defun calc-edit-mode (&optional handler allow-ret title) "Calculator editing mode. Press RET, LFD, or C-c C-c to finish. To cancel the edit, simply kill the *Calc Edit* buffer." @@ -575,5 +578,7 @@ To cancel the edit, simply kill the *Calc Edit* buffer." (calc-enter-result num "edit" vals) (calc-enter-result 1 "edit" vals (- num)))))))))) +(provide 'calc-yank) + ;;; arch-tag: ca61019e-caca-4daa-b32c-b6afe372d5b5 ;;; calc-yank.el ends here diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index 6480b1960a5..a7e840594ec 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el @@ -203,39 +203,12 @@ ;;; Code: -(provide 'calc) (require 'calc-macs) -;;; The "###autoload" comment will be used by Emacs version 19 for -;;; maintaining the loaddefs.el file automatically. - -;;;###autoload -(defvar calc-info-filename "calc.info" - "*File name in which to look for the Calculator's Info documentation.") - ;;;###autoload (defvar calc-settings-file user-init-file "*File in which to record permanent settings; default is `user-init-file'.") -;;;###autoload -(defvar calc-autoload-directory nil - "Name of directory from which additional \".elc\" files for Calc should be -loaded. Should include a trailing \"/\". -If nil, use original installation directory. -This can safely be nil as long as the Calc files are on the load-path.") - -;;;###autoload -(defvar calc-gnuplot-name "gnuplot" - "*Name of GNUPLOT program, for calc-graph features.") - -;;;###autoload -(defvar calc-gnuplot-plot-command nil - "*Name of command for displaying GNUPLOT output; %s = file name to print.") - -;;;###autoload -(defvar calc-gnuplot-print-command "lp %s" - "*Name of command for printing GNUPLOT output; %s = file name to print.") - (defvar calc-bug-address "belanger@truman.edu" "Address of the author of Calc, for use by `report-calc-bug'.") @@ -243,15 +216,10 @@ This can safely be nil as long as the Calc files are on the load-path.") "If t, scan keymaps to find all DEL-like keys. if nil, only DEL itself is mapped to calc-pop.") -(defvar calc-extensions-loaded nil) - (defvar calc-stack '((top-of-stack 1 nil)) "Calculator stack. Entries are 3-lists: Formula, Height (in lines), Selection (or nil).") -(defvar calc-show-banner t - "*If non-nil, show a friendly greeting above the stack.") - (defvar calc-stack-top 1 "Index into `calc-stack' of \"top\" of stack. This is 1 unless `calc-truncate-stack' has been used.") @@ -589,7 +557,8 @@ If nil, selections displayed but ignored.") (calc-invocation-macro nil) - (calc-show-banner t)) + (calc-show-banner t + "*If non-nil, show a friendly greeting above the stack.")) "List of variables (and default values) used in customizing GNU Calc.") (mapcar (function (lambda (v) @@ -704,14 +673,7 @@ If nil, selections displayed but ignored.") (directory-file-name (file-name-directory (expand-file-name - name (car p2)))))))))) - - ;; If calc-autoload-directory is given, use that (and hope it works!). - (and calc-autoload-directory - (not (equal calc-autoload-directory "")) - (setq load-path (nconc load-path - (list (directory-file-name - calc-autoload-directory))))))) + name (car p2)))))))))))) ;; The following modes use specially-formatted data. (put 'calc-mode 'mode-class 'special) @@ -919,21 +881,20 @@ If nil, selections displayed but ignored.") ( ?? . calc-dispatch-help ) )) map)) -(autoload 'calc-extensions "calc-ext") -(autoload 'calc-need-macros "calc-macs") - ;;;; (Autoloads here) (mapcar (lambda (x) (dolist (func (cdr x)) (autoload func (car x)))) '( - ("calc-aent" calc-Need-calc-aent calc-alg-digit-entry calc-alg-entry + ("calc-aent" calc-alg-digit-entry calc-alg-entry calc-check-user-syntax calc-do-alg-entry calc-do-calc-eval calc-do-quick-calc calc-match-user-syntax math-build-parse-table math-find-user-tokens math-read-expr-list math-read-exprs math-read-if math-read-token math-remove-dashes) - ("calc-misc" calc-Need-calc-misc + ("calc-embed" calc-do-embedded-activate) + + ("calc-misc" calc-do-handle-whys calc-do-refresh calc-num-prefix-name calc-record-list calc-record-why calc-report-bug calc-roll-down-stack calc-roll-up-stack calc-temp-minibuffer-message calcFunc-floor @@ -991,7 +952,7 @@ If nil, selections displayed but ignored.") (message "") (if key (progn - (or (commandp key) (calc-extensions)) + (or (commandp key) (require 'calc-ext)) (call-interactively key)) (beep)))) @@ -1006,9 +967,7 @@ If nil, selections displayed but ignored.") (progn (use-global-map map) (use-local-map nil) - (read-key-sequence - (if (commandp (key-binding (vector (cdr key)))) - "" prompt2))) + (read-key-sequence nil)) (use-global-map glob) (use-local-map loc))))) @@ -1050,7 +1009,7 @@ Notations: 3.14e6 3.14 * 10^6 (lambda (v) (set-default v (symbol-value v)))) calc-local-var-list) (kill-all-local-variables) (use-local-map (if (eq calc-algebraic-mode 'total) - (progn (calc-extensions) calc-alg-map) calc-mode-map)) + (progn (require 'calc-ext) calc-alg-map) calc-mode-map)) (mapcar (function (lambda (v) (make-local-variable v))) calc-local-var-list) (make-local-variable 'overlay-arrow-position) (make-local-variable 'overlay-arrow-string) @@ -1090,8 +1049,8 @@ Notations: 3.14e6 3.14 * 10^6 (setq plist (cdr (cdr plist)))) (if plist (save-excursion - (calc-extensions) - (calc-need-macros) + (require 'calc-ext) + (require 'calc-macs) (set-buffer "*Calculator*") (while plist (put 'calc-define (car plist) nil) @@ -1137,9 +1096,9 @@ commands given here will actually operate on the *Calculator* stack." (calc-mode)) (setq max-lisp-eval-depth (max max-lisp-eval-depth 1000)) (when calc-always-load-extensions - (calc-extensions)) + (require 'calc-ext)) (when calc-language - (calc-extensions) + (require 'calc-ext) (calc-set-language calc-language calc-language-option t))) ;;;###autoload @@ -1148,7 +1107,7 @@ commands given here will actually operate on the *Calculator* stack." (interactive "P\ni\np") (if arg (unless (eq arg 0) - (calc-extensions) + (require 'calc-ext) (if (= (prefix-numeric-value arg) -1) (calc-grab-region (region-beginning) (region-end) nil) (when (= (prefix-numeric-value arg) -2) @@ -1272,7 +1231,7 @@ This is most useful in the X window system. In this mode, click on the Calc \"buttons\" using the left mouse button. Or, position the cursor manually and do M-x calc-keypad-press." (interactive "p") - (calc-extensions) + (require 'calc-ext) (calc-do-keypad calc-full-mode interactive)) ;;;###autoload @@ -1280,7 +1239,7 @@ Or, position the cursor manually and do M-x calc-keypad-press." "Invoke the Calculator in full-screen \"visual keypad\" mode. See calc-keypad for details." (interactive "p") - (calc-extensions) + (require 'calc-ext) (calc-do-keypad t interactive)) @@ -1294,7 +1253,7 @@ See calc-keypad for details." (calc-check-defines) (let* ((calc-command-flags nil) (calc-start-time (and calc-timing (not calc-start-time) - (calc-extensions) + (require 'calc-ext) (current-time-string))) (gc-cons-threshold (max gc-cons-threshold (if calc-timing 2000000 100000))) @@ -1307,7 +1266,7 @@ See calc-keypad for details." (calc-embedded-select-buffer) (calc-select-buffer)) (and (eq calc-algebraic-mode 'total) - (calc-extensions) + (require 'calc-ext) (use-local-map calc-alg-map)) (when (and do-slow calc-display-working-message) (message "Working...") @@ -1582,7 +1541,7 @@ See calc-keypad for details." (defun calc-normalize (val) (if (memq calc-simplify-mode '(nil none num)) (math-normalize val) - (calc-extensions) + (require 'calc-ext) (calc-normalize-fancy val))) (defun calc-handle-whys () @@ -1862,7 +1821,7 @@ See calc-keypad for details." (calc-enter-result 2 name (cons (or func2 func) (mapcar 'math-check-complete (calc-top-list 2)))) - (calc-extensions) + (require 'calc-ext) (calc-binary-op-fancy name func arg ident unary))) (defun calc-unary-op (name func arg &optional func2) @@ -1870,7 +1829,7 @@ See calc-keypad for details." (if (null arg) (calc-enter-result 1 name (list (or func2 func) (math-check-complete (calc-top 1)))) - (calc-extensions) + (require 'calc-ext) (calc-unary-op-fancy name func arg))) @@ -1982,7 +1941,7 @@ See calc-keypad for details." calc-digit-value)))))) (if (eq calc-prev-char 'dots) (progn - (calc-extensions) + (require 'calc-ext) (calc-dots))))))) (defsubst calc-minibuffer-size () @@ -2106,7 +2065,7 @@ See calc-keypad for details." (if (and (eq this-command last-command) (eq last-command-char ?.)) (progn - (calc-extensions) + (require 'calc-ext) (calc-digit-dots)) (delete-backward-char 1) (beep) @@ -2281,11 +2240,11 @@ See calc-keypad for details." (integerp (car math-normalize-a)) (and (consp (car math-normalize-a)) (not (eq (car (car math-normalize-a)) 'lambda)))) - (calc-extensions) + (require 'calc-ext) (math-normalize-fancy math-normalize-a)) (t (or (and calc-simplify-mode - (calc-extensions) + (require 'calc-ext) (math-normalize-nonstandard)) (let ((args (mapcar 'math-normalize (cdr math-normalize-a)))) (or (condition-case err @@ -2302,7 +2261,7 @@ See calc-keypad for details." (progn (or (eq var-EvalRules math-eval-rules-cache-tag) (progn - (calc-extensions) + (require 'calc-ext) (math-recompile-eval-rules))) (and (or math-eval-rules-cache-other (assq (car math-normalize-a) @@ -2315,8 +2274,8 @@ See calc-keypad for details." (apply (cdr func) args) (and (or (consp (car math-normalize-a)) (fboundp (car math-normalize-a)) - (and (not calc-extensions-loaded) - (calc-extensions) + (and (not (featurep 'calc-ext)) + (require 'calc-ext) (fboundp (car math-normalize-a)))) (apply (car math-normalize-a) args))))) (wrong-number-of-arguments @@ -2584,7 +2543,7 @@ See calc-keypad for details." (cons 'bigpos diff)))) (cons 'bigpos (math-add-bignum (cdr a) (cdr b))))))) (and (Math-ratp a) (Math-ratp b) - (calc-extensions) + (require 'calc-ext) (calc-add-fractions a b)) (and (Math-realp a) (Math-realp b) (progn @@ -2593,9 +2552,9 @@ See calc-keypad for details." (or (and (consp b) (eq (car b) 'float)) (setq b (math-float b))) (math-add-float a b))) - (and (calc-extensions) + (and (require 'calc-ext) (math-add-objects-fancy a b)))) - (and (calc-extensions) + (and (require 'calc-ext) (math-add-symb-fancy a b)))) (defun math-add-bignum (a b) ; [L L L; l l l] @@ -2724,12 +2683,12 @@ See calc-keypad for details." (and (Math-zerop a) (not (eq (car-safe b) 'mod)) (if (Math-scalarp b) (if (and (math-floatp b) (Math-ratp a)) (math-float a) a) - (calc-extensions) + (require 'calc-ext) (math-mul-zero a b))) (and (Math-zerop b) (not (eq (car-safe a) 'mod)) (if (Math-scalarp a) (if (and (math-floatp a) (Math-ratp b)) (math-float b) b) - (calc-extensions) + (require 'calc-ext) (math-mul-zero b a))) (and (Math-objvecp a) (Math-objvecp b) (or @@ -2745,7 +2704,7 @@ See calc-keypad for details." (math-mul-bignum-digit (cdr a) (nth 1 b) 0)) (math-mul-bignum-digit (cdr b) (nth 1 a) 0)))))) (and (Math-ratp a) (Math-ratp b) - (calc-extensions) + (require 'calc-ext) (calc-mul-fractions a b)) (and (Math-realp a) (Math-realp b) (progn @@ -2755,9 +2714,9 @@ See calc-keypad for details." (setq b (math-float b))) (math-make-float (math-mul (nth 1 a) (nth 1 b)) (+ (nth 2 a) (nth 2 b))))) - (and (calc-extensions) + (and (require 'calc-ext) (math-mul-objects-fancy a b)))) - (and (calc-extensions) + (and (require 'calc-ext) (math-mul-symb-fancy a b)))) (defun math-infinitep (a &optional undir) @@ -2913,12 +2872,12 @@ See calc-keypad for details." (defun math-div (a b) (or (and (Math-zerop b) - (calc-extensions) + (require 'calc-ext) (math-div-by-zero a b)) (and (Math-zerop a) (not (eq (car-safe b) 'mod)) (if (Math-scalarp b) (if (and (math-floatp b) (Math-ratp a)) (math-float a) a) - (calc-extensions) + (require 'calc-ext) (math-div-zero a b))) (and (Math-objvecp a) (Math-objvecp b) (or @@ -2928,12 +2887,12 @@ See calc-keypad for details." (car q) (if calc-prefer-frac (progn - (calc-extensions) + (require 'calc-ext) (math-make-frac a b)) (math-div-float (math-make-float a 0) (math-make-float b 0)))))) (and (Math-ratp a) (Math-ratp b) - (calc-extensions) + (require 'calc-ext) (calc-div-fractions a b)) (and (Math-realp a) (Math-realp b) (progn @@ -2942,9 +2901,9 @@ See calc-keypad for details." (or (and (consp b) (eq (car b) 'float)) (setq b (math-float b))) (math-div-float a b))) - (and (calc-extensions) + (and (require 'calc-ext) (math-div-objects-fancy a b)))) - (and (calc-extensions) + (and (require 'calc-ext) (math-div-symb-fancy a b)))) (defun math-div-float (a b) ; [F F F] @@ -2973,7 +2932,7 @@ See calc-keypad for details." (memq calc-language '(nil flat unform)) (null math-comp-selected)) (math-format-number a)) - (t (calc-extensions) + (t (require 'calc-ext) (math-compose-expr a 0)))) (off (math-stack-value-offset c)) s w) @@ -2996,7 +2955,7 @@ See calc-keypad for details." c))) (unless (or (equal calc-right-label "") (eq a 'top-of-stack)) - (calc-extensions) + (require 'calc-ext) (setq c (list 'horiz c (make-string (max (- w (math-comp-width c) (length calc-right-label)) 0) ? ) @@ -3016,19 +2975,23 @@ See calc-keypad for details." (setcar (cdr entry) (calc-count-lines s)) s)) -(defun math-stack-value-offset (c) +;; The variables math-svo-c, math-svo-wid and math-svo-off are local +;; to math-stack-value-offset, but are used by math-stack-value-offset-fancy +;; in calccomp.el. + +(defun math-stack-value-offset (math-svo-c) (let* ((num (if calc-line-numbering 4 0)) - (wid (calc-window-width)) - off) + (math-svo-wid (calc-window-width)) + math-svo-off) (if calc-display-just (progn - (calc-extensions) + (require 'calc-ext) (math-stack-value-offset-fancy)) - (setq off (or calc-display-origin 0)) + (setq math-svo-off (or calc-display-origin 0)) (when (integerp calc-line-breaking) - (setq wid calc-line-breaking))) - (cons (max (- off (length calc-left-label)) 0) - (+ wid num)))) + (setq math-svo-wid calc-line-breaking))) + (cons (max (- math-svo-off (length calc-left-label)) 0) + (+ math-svo-wid num)))) (defun calc-count-lines (s) (let ((pos 0) @@ -3042,7 +3005,7 @@ See calc-keypad for details." (if (and (Math-scalarp a) (memq calc-language '(nil flat unform))) (math-format-number a) - (calc-extensions) + (require 'calc-ext) (let ((calc-line-breaking nil)) (math-composition-to-string (math-compose-expr a 0) w)))) @@ -3078,7 +3041,7 @@ See calc-keypad for details." (calc-language nil)) (math-format-number a))) (t - (calc-extensions) + (require 'calc-ext) (math-format-flat-expr-fancy a prec)))) @@ -3088,7 +3051,7 @@ See calc-keypad for details." (cond ((eq calc-display-raw t) (format "%s" a)) ((and (nth 1 calc-frac-format) (Math-integerp a)) - (calc-extensions) + (require 'calc-ext) (math-format-number (math-adjust-fraction a))) ((integerp a) (if (not (or calc-group-digits calc-leading-zeros)) @@ -3096,7 +3059,7 @@ See calc-keypad for details." (int-to-string a) (if (< a 0) (concat "-" (math-format-number (- a))) - (calc-extensions) + (require 'calc-ext) (if math-radix-explicit-format (if calc-radix-formatter (funcall calc-radix-formatter @@ -3191,7 +3154,7 @@ See calc-keypad for details." str (- eadj scale))))))) str))) (t - (calc-extensions) + (require 'calc-ext) (math-format-number-fancy a prec)))) (defun math-format-bignum (a) ; [X L] @@ -3199,7 +3162,7 @@ See calc-keypad for details." (not calc-leading-zeros) (not calc-group-digits)) (math-format-bignum-decimal a) - (calc-extensions) + (require 'calc-ext) (math-format-bignum-fancy a))) (defun math-format-bignum-decimal (a) ; [X L] @@ -3241,7 +3204,7 @@ See calc-keypad for details." ;; Forms that require extensions module ((string-match "[^-+0-9eE.]" s) - (calc-extensions) + (require 'calc-ext) (math-read-number-fancy s)) ;; Decimal point @@ -3350,26 +3313,26 @@ See calc-keypad for details." (defun calc-grab-region (top bot arg) "Parse the region as a vector of numbers and push it on the Calculator stack." (interactive "r\nP") - (calc-extensions) + (require 'calc-ext) (calc-do-grab-region top bot arg)) ;;;###autoload (defun calc-grab-rectangle (top bot arg) "Parse a rectangle as a matrix of numbers and push it on the Calculator stack." (interactive "r\nP") - (calc-extensions) + (require 'calc-ext) (calc-do-grab-rectangle top bot arg)) (defun calc-grab-sum-down (top bot arg) "Parse a rectangle as a matrix of numbers and sum its columns." (interactive "r\nP") - (calc-extensions) + (require 'calc-ext) (calc-do-grab-rectangle top bot arg 'calcFunc-reduced)) (defun calc-grab-sum-across (top bot arg) "Parse a rectangle as a matrix of numbers and sum its rows." (interactive "r\nP") - (calc-extensions) + (require 'calc-ext) (calc-do-grab-rectangle top bot arg 'calcFunc-reducea)) @@ -3377,7 +3340,7 @@ See calc-keypad for details." (defun calc-embedded (arg &optional end obeg oend) "Start Calc Embedded mode on the formula surrounding point." (interactive "P") - (calc-extensions) + (require 'calc-ext) (calc-do-embedded arg end obeg oend)) ;;;###autoload @@ -3397,7 +3360,7 @@ Also looks for the equivalent TeX words, \\gets and \\evalto." ;;;###autoload (defmacro defmath (func args &rest body) ; [Public] - (calc-extensions) + (require 'calc-ext) (math-do-defmath func args body)) ;;; Functions needed for Lucid Emacs support. @@ -3425,11 +3388,13 @@ Also looks for the equivalent TeX words, \\gets and \\evalto." (setq unread-command-events nil))) (when calc-always-load-extensions - (calc-extensions) + (require 'calc-ext) (calc-load-everything)) (run-hooks 'calc-load-hook) +(provide 'calc) + ;;; arch-tag: 0c3b170c-4ce6-4eaf-8d9b-5834d1fe938f ;;; calc.el ends here diff --git a/lisp/calc/calcalg2.el b/lisp/calc/calcalg2.el index b7c837c7b4f..18b6c1328d7 100644 --- a/lisp/calc/calcalg2.el +++ b/lisp/calc/calcalg2.el @@ -3,8 +3,7 @@ ;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> -;; Maintainers: D. Goel <deego@gnufans.org> -;; Colin Walters <walters@debian.org> +;; Maintainer: Jay Belanger <belanger@truman.edu> ;; This file is part of GNU Emacs. @@ -28,13 +27,10 @@ ;;; Code: ;; This file is autoloaded from calc-ext.el. -(require 'calc-ext) +(require 'calc-ext) (require 'calc-macs) -(defun calc-Need-calc-alg-2 () nil) - - (defun calc-derivative (var num) (interactive "sDifferentiate with respect to: \np") (calc-slow-wrapper @@ -1319,6 +1315,7 @@ ;; The variable math-expr-parts is local to math-expr-rational-in, ;; but is used by math-expr-rational-in-rec +(defvar math-expr-parts) (defun math-expr-rational-in (expr) (let ((math-expr-parts nil)) @@ -2279,6 +2276,7 @@ ;; math-decompose-poly, but used by math-solve-poly-funny-powers.) (defvar math-solve-lhs) (defvar math-solve-rhs) +(defvar math-try-solve-sign) (defun math-try-solve-for (math-solve-lhs math-solve-rhs &optional math-try-solve-sign no-poly) @@ -2565,6 +2563,7 @@ ;;; This deals with negative, fractional, and symbolic powers of "x". ;; The variable math-solve-b is local to math-decompose-poly, ;; but is used by math-solve-poly-funny-powers. +(defvar math-solve-b) (defun math-solve-poly-funny-powers (sub-rhs) ; uses "t1", "t2" (setq math-t1 math-solve-lhs) @@ -2798,6 +2797,8 @@ ;; The variables math-int-scale, math-int-factors and math-double-roots ;; are local to math-poly-all-roots, but are used by math-poly-integer-root. (defvar math-int-scale) +(defvar math-int-factors) +(defvar math-double-roots) (defun math-poly-all-roots (var p &optional math-factoring) (catch 'ouch @@ -3136,6 +3137,7 @@ ;; The variable math-solve-simplifying is local to math-solve-system ;; and math-solve-system-rec, but is used by math-solve-system-subst. +(defvar math-solve-simplifying) (defun math-solve-system (exprs math-solve-vars math-solve-full) (setq exprs (mapcar 'list (if (Math-vectorp exprs) @@ -3578,5 +3580,7 @@ (math-normalize accum)))) (list 'calcFunc-taylor expr var num)))) +(provide 'calcalg2) + ;;; arch-tag: f2932ec8-dd63-418b-a542-11a644b9d4c4 ;;; calcalg2.el ends here diff --git a/lisp/calc/calcalg3.el b/lisp/calc/calcalg3.el index fd204e23b2b..90ceaea68db 100644 --- a/lisp/calc/calcalg3.el +++ b/lisp/calc/calcalg3.el @@ -27,13 +27,10 @@ ;;; Code: ;; This file is autoloaded from calc-ext.el. -(require 'calc-ext) +(require 'calc-ext) (require 'calc-macs) -(defun calc-Need-calc-alg-3 () nil) - - (defun calc-find-root (var) (interactive "sVariable(s) to solve for: ") (calc-slow-wrapper @@ -1826,5 +1823,7 @@ (while (setq expr (cdr expr)) (math-all-vars-rec (car expr))))) +(provide 'calcalg3) + ;;; arch-tag: ff9f2920-8111-48b5-b3fa-b0682c3e44a6 ;;; calcalg3.el ends here diff --git a/lisp/calc/calccomp.el b/lisp/calc/calccomp.el index 59bbbebdc0e..e76b3a34e09 100644 --- a/lisp/calc/calccomp.el +++ b/lisp/calc/calccomp.el @@ -3,8 +3,7 @@ ;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> -;; Maintainers: D. Goel <deego@gnufans.org> -;; Colin Walters <walters@debian.org> +;; Maintainer: Jay Belanger <belanger@truman.edu> ;; This file is part of GNU Emacs. @@ -28,12 +27,10 @@ ;;; Code: ;; This file is autoloaded from calc-ext.el. -(require 'calc-ext) +(require 'calc-ext) (require 'calc-macs) -(defun calc-Need-calc-comp () nil) - (defconst math-eqn-special-funcs '( calcFunc-log calcFunc-ln calcFunc-exp @@ -62,6 +59,25 @@ ;;; ;;; (tag X C) Composition C corresponds to sub-expression X +;; math-comp-just and math-comp-comma-spc are local to +;; math-compose-expr, but are used by math-compose-matrix, which is +;; called by math-compose-expr +(defvar math-comp-just) +(defvar math-comp-comma-spc) + +;; math-comp-vector-prec is local to math-compose-expr, but is used by +;; math-compose-matrix and math-compose-rows, which are called by +;; math-compose-expr. +(defvar math-comp-vector-prec) + +;; math-comp-left-bracket, math-comp-right-bracket and math-comp-comma are +;; local to math-compose-expr, but are used by math-compose-rows, which is +;; called by math-compose-expr. +(defvar math-comp-left-bracket) +(defvar math-comp-right-bracket) +(defvar math-comp-comma) + + (defun math-compose-expr (a prec) (let ((math-compose-level (1+ math-compose-level))) (cond @@ -154,21 +170,21 @@ (and (setq temp2 (assq nil (cdr temp))) (funcall (cdr temp2) a)))))))) ((eq (car a) 'vec) - (let* ((left-bracket (if calc-vector-brackets + (let* ((math-comp-left-bracket (if calc-vector-brackets (substring calc-vector-brackets 0 1) "")) - (right-bracket (if calc-vector-brackets + (math-comp-right-bracket (if calc-vector-brackets (substring calc-vector-brackets 1 2) "")) (inner-brackets (memq 'R calc-matrix-brackets)) (outer-brackets (memq 'O calc-matrix-brackets)) (row-commas (memq 'C calc-matrix-brackets)) - (comma-spc (or calc-vector-commas " ")) - (comma (or calc-vector-commas "")) - (vector-prec (if (or (and calc-vector-commas + (math-comp-comma-spc (or calc-vector-commas " ")) + (math-comp-comma (or calc-vector-commas "")) + (math-comp-vector-prec (if (or (and calc-vector-commas (math-vector-no-parens a)) (memq 'P calc-matrix-brackets)) 0 1000)) - (just (cond ((eq calc-matrix-just 'right) 'vright) - ((eq calc-matrix-just 'center) 'vcent) - (t 'vleft))) + (math-comp-just (cond ((eq calc-matrix-just 'right) 'vright) + ((eq calc-matrix-just 'center) 'vcent) + (t 'vleft))) (break calc-break-vectors)) (if (and (memq calc-language '(nil big)) (not calc-break-vectors) @@ -177,17 +193,17 @@ (and (< (length a) 7) (< (length (nth 1 a)) 7)) (progn (setq break t) nil))) (if (progn - (setq vector-prec (if (or (and calc-vector-commas - (math-vector-no-parens - (nth 1 a))) - (memq 'P calc-matrix-brackets)) - 0 1000)) + (setq math-comp-vector-prec (if (or (and calc-vector-commas + (math-vector-no-parens + (nth 1 a))) + (memq 'P calc-matrix-brackets)) + 0 1000)) (= (length a) 2)) (list 'horiz - (concat left-bracket left-bracket " ") - (math-compose-vector (cdr (nth 1 a)) (concat comma " ") - vector-prec) - (concat " " right-bracket right-bracket)) + (concat math-comp-left-bracket math-comp-left-bracket " ") + (math-compose-vector (cdr (nth 1 a)) (concat math-comp-comma " ") + math-comp-vector-prec) + (concat " " math-comp-right-bracket math-comp-right-bracket)) (let* ((rows (1- (length a))) (cols (1- (length (nth 1 a)))) (base (/ (1- rows) 2)) @@ -196,17 +212,17 @@ (list (append '(vleft) (list base) (list (concat (and outer-brackets - (concat left-bracket + (concat math-comp-left-bracket " ")) (and inner-brackets - (concat left-bracket + (concat math-comp-left-bracket " ")))) (make-list (1- rows) (concat (and outer-brackets " ") (and inner-brackets (concat - left-bracket + math-comp-left-bracket " ")))))) (math-compose-matrix (cdr a) 1 cols base) (list (append '(vleft) @@ -214,20 +230,20 @@ (make-list (1- rows) (if inner-brackets (concat " " - right-bracket + math-comp-right-bracket (and row-commas - comma)) + math-comp-comma)) (if (and outer-brackets row-commas) ";" ""))) (list (concat (and inner-brackets (concat " " - right-bracket)) + math-comp-right-bracket)) (and outer-brackets (concat " " - right-bracket))))))))) + math-comp-right-bracket))))))))) (if (and calc-display-strings (cdr a) (math-vector-is-string a)) @@ -237,7 +253,6 @@ (let* ((full (or calc-full-vectors (< (length a) 7))) (rows (if full (1- (length a)) 5)) (base (/ (1- rows) 2)) - (just 'vleft) (calc-break-vectors nil)) (list 'horiz (cons 'vleft (cons base @@ -260,26 +275,29 @@ (math-matrixp a)) (list 'horiz "matrix(" - left-bracket - (math-compose-vector (cdr a) (concat comma " ") - vector-prec) - right-bracket + math-comp-left-bracket + (math-compose-vector (cdr a) + (concat math-comp-comma " ") + math-comp-vector-prec) + math-comp-right-bracket ")") (list 'horiz - left-bracket - (math-compose-vector (cdr a) (concat comma " ") - vector-prec) - right-bracket)))) + math-comp-left-bracket + (math-compose-vector (cdr a) + (concat math-comp-comma " ") + math-comp-vector-prec) + math-comp-right-bracket)))) (list 'horiz - left-bracket + math-comp-left-bracket (math-compose-vector (list (nth 1 a) (nth 2 a) (nth 3 a)) - (concat comma " ") vector-prec) - comma (if (eq calc-language 'tex) " \\ldots" " ...") - comma " " + (concat math-comp-comma " ") + math-comp-vector-prec) + math-comp-comma (if (eq calc-language 'tex) " \\ldots" " ...") + math-comp-comma " " (list 'break math-compose-level) (math-compose-expr (nth (1- (length a)) a) - (if (equal comma "") 1000 0)) - right-bracket))))))) + (if (equal math-comp-comma "") 1000 0)) + math-comp-right-bracket))))))) ((eq (car a) 'incomplete) (if (cdr (cdr a)) (cond ((eq (nth 1 a) 'vec) @@ -929,17 +947,18 @@ (let ((col 0) (res nil)) (while (<= (setq col (1+ col)) cols) - (setq res (cons (cons just + (setq res (cons (cons math-comp-just (cons base (mapcar (function (lambda (r) (list 'horiz (math-compose-expr (nth col r) - vector-prec) + math-comp-vector-prec) (if (= col cols) "" - (concat comma-spc " "))))) + (concat + math-comp-comma-spc " "))))) a))) res))) (nreverse res))) @@ -950,17 +969,17 @@ (if (< count 0) (math-compose-rows (cdr a) -1 nil) (cons (concat (if (eq calc-language 'tex) " \\ldots" " ...") - comma) + math-comp-comma) (math-compose-rows (cdr a) -1 nil))) (cons (list 'horiz - (if first (concat left-bracket " ") " ") - (math-compose-expr (car a) vector-prec) - comma) + (if first (concat math-comp-left-bracket " ") " ") + (math-compose-expr (car a) math-comp-vector-prec) + math-comp-comma) (math-compose-rows (cdr a) (1- count) nil))) (list (list 'horiz - (if first (concat left-bracket " ") " ") - (math-compose-expr (car a) vector-prec) - (concat " " right-bracket))))) + (if first (concat math-comp-left-bracket " ") " ") + (math-compose-expr (car a) math-comp-vector-prec) + (concat " " math-comp-right-bracket))))) (defun math-compose-tex-matrix (a) (if (cdr a) @@ -1202,15 +1221,21 @@ expr (if (memq prec '(196 201)) ")" ""))))) +;; The variables math-svo-c, math-svo-wid and math-svo-off are local +;; to math-stack-value-offset in calc.el, but are used by +;; math-stack-value-offset-fancy, which is called by math-stack-value-offset.. +(defvar math-svo-c) +(defvar math-svo-wid) +(defvar math-svo-off) (defun math-stack-value-offset-fancy () - (let ((cwid (+ (math-comp-width c)))) + (let ((cwid (+ (math-comp-width math-svo-c)))) (cond ((eq calc-display-just 'right) (if calc-display-origin - (setq wid (max calc-display-origin 5)) + (setq math-svo-wid (max calc-display-origin 5)) (if (integerp calc-line-breaking) - (setq wid calc-line-breaking))) - (setq off (- wid cwid + (setq math-svo-wid calc-line-breaking))) + (setq math-svo-off (- math-svo-wid cwid (max (- (length calc-right-label) (if (and (integerp calc-line-breaking) calc-display-origin) @@ -1222,21 +1247,20 @@ (t (if calc-display-origin (progn - (setq off (- calc-display-origin (/ cwid 2))) + (setq math-svo-off (- calc-display-origin (/ cwid 2))) (if (integerp calc-line-breaking) - (setq off (min off (- calc-line-breaking cwid + (setq math-svo-off (min math-svo-off (- calc-line-breaking cwid (length calc-right-label))))) - (if (>= off 0) - (setq wid (max wid (+ off cwid))))) + (if (>= math-svo-off 0) + (setq math-svo-wid (max math-svo-wid (+ math-svo-off cwid))))) (if (integerp calc-line-breaking) - (setq wid calc-line-breaking)) - (setq off (/ (- wid cwid) 2))))) + (setq math-svo-wid calc-line-breaking)) + (setq math-svo-off (/ (- math-svo-wid cwid) 2))))) (and (integerp calc-line-breaking) - (or (< off 0) + (or (< math-svo-off 0) (and calc-display-origin (> calc-line-breaking calc-display-origin))) - (setq wid calc-line-breaking)))) - + (setq math-svo-wid calc-line-breaking)))) ;;; Convert a composition to string form, with embedded \n's if necessary. @@ -1273,40 +1297,59 @@ ;;; lines if necessary, choosing break points according to the structure ;;; of the formula. -(defun math-comp-to-string-flat (c full-width) +;; The variables math-comp-full-width, math-comp-highlight, math-comp-word, +;; math-comp-level, math-comp-margin and math-comp-buf are local to +;; math-comp-to-string-flat, but are used by math-comp-to-string-flat-term, +;; which is called by math-comp-to-string-flat. +;; math-comp-highlight and math-comp-buf are also local to +;; math-comp-simplify-term and math-comp-simplify respectively, but are used +;; by math-comp-add-string. +(defvar math-comp-full-width) +(defvar math-comp-highlight) +(defvar math-comp-word) +(defvar math-comp-level) +(defvar math-comp-margin) +(defvar math-comp-buf) +;; The variable math-comp-pos is local to math-comp-to-string-flat, but +;; is used by math-comp-to-string-flat-term and math-comp-sel-first-term, +;; which are called by math-comp-to-string-flat. +(defvar math-comp-pos) + +(defun math-comp-to-string-flat (c math-comp-full-width) (if math-comp-sel-hpos - (let ((comp-pos 0)) + (let ((math-comp-pos 0)) (math-comp-sel-flat-term c)) - (let ((comp-buf "") - (comp-word "") - (comp-pos 0) - (comp-margin 0) - (comp-highlight (and math-comp-selected calc-show-selections)) - (comp-level -1)) + (let ((math-comp-buf "") + (math-comp-word "") + (math-comp-pos 0) + (math-comp-margin 0) + (math-comp-highlight (and math-comp-selected calc-show-selections)) + (math-comp-level -1)) (math-comp-to-string-flat-term '(set -1 0)) (math-comp-to-string-flat-term c) (math-comp-to-string-flat-term '(break -1)) (let ((str (aref math-comp-buf-string 0)) (prefix "")) (and (> (length str) 0) (= (aref str 0) ? ) - (> (length comp-buf) 0) - (let ((k (length comp-buf))) - (while (not (= (aref comp-buf (setq k (1- k))) ?\n))) - (aset comp-buf k ? ) - (if (and (< (1+ k) (length comp-buf)) - (= (aref comp-buf (1+ k)) ? )) + (> (length math-comp-buf) 0) + (let ((k (length math-comp-buf))) + (while (not (= (aref math-comp-buf (setq k (1- k))) ?\n))) + (aset math-comp-buf k ? ) + (if (and (< (1+ k) (length math-comp-buf)) + (= (aref math-comp-buf (1+ k)) ? )) (progn - (aset comp-buf (1+ k) ?\n) + (aset math-comp-buf (1+ k) ?\n) (setq prefix " ")) (setq prefix "\n")))) - (concat comp-buf prefix str))))) + (concat math-comp-buf prefix str))))) (defun math-comp-to-string-flat-term (c) (cond ((not (consp c)) - (if comp-highlight + (if math-comp-highlight (setq c (math-comp-highlight-string c))) - (setq comp-word (if (= (length comp-word) 0) c (concat comp-word c)) - comp-pos (+ comp-pos (length c)))) + (setq math-comp-word (if (= (length math-comp-word) 0) c + (concat math-comp-word c)) + math-comp-pos (+ math-comp-pos (length c)))) ((eq (car c) 'horiz) (while (setq c (cdr c)) @@ -1315,83 +1358,83 @@ ((eq (car c) 'set) (if (nth 1 c) (progn - (setq comp-level (1+ comp-level)) - (if (>= comp-level (length math-comp-buf-string)) + (setq math-comp-level (1+ math-comp-level)) + (if (>= math-comp-level (length math-comp-buf-string)) (setq math-comp-buf-string (vconcat math-comp-buf-string math-comp-buf-string) math-comp-buf-margin (vconcat math-comp-buf-margin math-comp-buf-margin) math-comp-buf-level (vconcat math-comp-buf-level math-comp-buf-level))) - (aset math-comp-buf-string comp-level "") - (aset math-comp-buf-margin comp-level (+ comp-pos + (aset math-comp-buf-string math-comp-level "") + (aset math-comp-buf-margin math-comp-level (+ math-comp-pos (or (nth 2 c) 0))) - (aset math-comp-buf-level comp-level (nth 1 c))))) + (aset math-comp-buf-level math-comp-level (nth 1 c))))) ((eq (car c) 'break) (if (not calc-line-breaking) - (setq comp-buf (concat comp-buf comp-word) - comp-word "") + (setq math-comp-buf (concat math-comp-buf math-comp-word) + math-comp-word "") (let ((i 0) str) - (if (and (> comp-pos full-width) + (if (and (> math-comp-pos math-comp-full-width) (progn (while (progn (setq str (aref math-comp-buf-string i)) - (and (= (length str) 0) (< i comp-level))) + (and (= (length str) 0) (< i math-comp-level))) (setq i (1+ i))) - (or (> (length str) 0) (> (length comp-buf) 0)))) + (or (> (length str) 0) (> (length math-comp-buf) 0)))) (let ((prefix "") mrg wid) (setq mrg (aref math-comp-buf-margin i)) (if (> mrg 12) ; indenting too far, go back to far left (let ((j i) (new (if calc-line-numbering 5 1))) - '(while (<= j comp-level) + '(while (<= j math-comp-level) (aset math-comp-buf-margin j (+ (aref math-comp-buf-margin j) (- new mrg))) (setq j (1+ j))) (setq mrg new))) - (setq wid (+ (length str) comp-margin)) + (setq wid (+ (length str) math-comp-margin)) (and (> (length str) 0) (= (aref str 0) ? ) - (> (length comp-buf) 0) - (let ((k (length comp-buf))) - (while (not (= (aref comp-buf (setq k (1- k))) ?\n))) - (aset comp-buf k ? ) - (if (and (< (1+ k) (length comp-buf)) - (= (aref comp-buf (1+ k)) ? )) + (> (length math-comp-buf) 0) + (let ((k (length math-comp-buf))) + (while (not (= (aref math-comp-buf (setq k (1- k))) ?\n))) + (aset math-comp-buf k ? ) + (if (and (< (1+ k) (length math-comp-buf)) + (= (aref math-comp-buf (1+ k)) ? )) (progn - (aset comp-buf (1+ k) ?\n) + (aset math-comp-buf (1+ k) ?\n) (setq prefix " ")) (setq prefix "\n")))) - (setq comp-buf (concat comp-buf prefix str "\n" + (setq math-comp-buf (concat math-comp-buf prefix str "\n" (make-string mrg ? )) - comp-pos (+ comp-pos (- mrg wid)) - comp-margin mrg) + math-comp-pos (+ math-comp-pos (- mrg wid)) + math-comp-margin mrg) (aset math-comp-buf-string i "") - (while (<= (setq i (1+ i)) comp-level) + (while (<= (setq i (1+ i)) math-comp-level) (if (> (aref math-comp-buf-margin i) wid) (aset math-comp-buf-margin i (+ (aref math-comp-buf-margin i) (- mrg wid)))))))) - (if (and (= (nth 1 c) (aref math-comp-buf-level comp-level)) - (< comp-pos (+ (aref math-comp-buf-margin comp-level) 2))) + (if (and (= (nth 1 c) (aref math-comp-buf-level math-comp-level)) + (< math-comp-pos (+ (aref math-comp-buf-margin math-comp-level) 2))) () ; avoid stupid breaks, e.g., "1 +\n really_long_expr" - (let ((str (aref math-comp-buf-string comp-level))) + (let ((str (aref math-comp-buf-string math-comp-level))) (setq str (if (= (length str) 0) - comp-word - (concat str comp-word)) - comp-word "") - (while (< (nth 1 c) (aref math-comp-buf-level comp-level)) - (setq comp-level (1- comp-level)) - (or (= (length (aref math-comp-buf-string comp-level)) 0) - (setq str (concat (aref math-comp-buf-string comp-level) + math-comp-word + (concat str math-comp-word)) + math-comp-word "") + (while (< (nth 1 c) (aref math-comp-buf-level math-comp-level)) + (setq math-comp-level (1- math-comp-level)) + (or (= (length (aref math-comp-buf-string math-comp-level)) 0) + (setq str (concat (aref math-comp-buf-string math-comp-level) str)))) - (aset math-comp-buf-string comp-level str))))) + (aset math-comp-buf-string math-comp-level str))))) ((eq (car c) 'tag) (cond ((eq (nth 1 c) math-comp-selected) - (let ((comp-highlight (not calc-show-selections))) + (let ((math-comp-highlight (not calc-show-selections))) (math-comp-to-string-flat-term (nth 2 c)))) ((eq (nth 1 c) t) - (let ((comp-highlight nil)) + (let ((math-comp-highlight nil)) (math-comp-to-string-flat-term (nth 2 c)))) (t (math-comp-to-string-flat-term (nth 2 c))))) @@ -1405,18 +1448,25 @@ (aset s i (if calc-show-selections ?\. ?\#))))) s) + +;; The variable math-comp-sel-tag is local to calc-find-selected-part +;; in calc-sel.el, but is used by math-comp-sel-flat-term and +;; math-comp-add-string-sel, which are called (indirectly) by +;; calc-find-selected-part. +(defvar math-comp-sel-tag) + (defun math-comp-sel-flat-term (c) (cond ((not (consp c)) - (setq comp-pos (+ comp-pos (length c)))) + (setq math-comp-pos (+ math-comp-pos (length c)))) ((memq (car c) '(set break))) ((eq (car c) 'horiz) (while (and (setq c (cdr c)) (< math-comp-sel-cpos 1000000)) (math-comp-sel-flat-term (car c)))) ((eq (car c) 'tag) - (if (<= comp-pos math-comp-sel-cpos) + (if (<= math-comp-pos math-comp-sel-cpos) (progn (math-comp-sel-flat-term (nth 2 c)) - (if (> comp-pos math-comp-sel-cpos) + (if (> math-comp-pos math-comp-sel-cpos) (setq math-comp-sel-tag c math-comp-sel-cpos 1000000))) (math-comp-sel-flat-term (nth 2 c)))) @@ -1427,35 +1477,47 @@ ;;; (vleft n "string" "string" "string" ...) ;;; where 0 <= n < number-of-strings. +;; The variables math-comp-base, math-comp-hgt, math-comp-tag, +;; math-comp-hpos and math-comp-vpos are local to math-comp-simplify, +;; but are used by math-comp-add-string (math-comp-base, math-comp-hgt), +;; math-comp-add-string-sel (math-comp-tag) and math-comp-simplify-term +;; (math-comp-tag, math-comp-vpos, math-comp-hpos), which are called by +;; math-comp-simplify. +(defvar math-comp-base) +(defvar math-comp-hgt) +(defvar math-comp-tag) +(defvar math-comp-hpos) +(defvar math-comp-vpos) + (defun math-comp-simplify (c full-width) - (let ((comp-buf (list "")) - (comp-base 0) - (comp-height 1) - (comp-hpos 0) - (comp-vpos 0) - (comp-highlight (and math-comp-selected calc-show-selections)) - (comp-tag nil)) + (let ((math-comp-buf (list "")) + (math-comp-base 0) + (math-comp-hgt 1) + (math-comp-hpos 0) + (math-comp-vpos 0) + (math-comp-highlight (and math-comp-selected calc-show-selections)) + (math-comp-tag nil)) (math-comp-simplify-term c) - (cons 'vleft (cons comp-base comp-buf)))) + (cons 'vleft (cons math-comp-base math-comp-buf)))) (defun math-comp-add-string (s h v) (and (> (length s) 0) - (let ((vv (+ v comp-base))) + (let ((vv (+ v math-comp-base))) (if math-comp-sel-hpos (math-comp-add-string-sel h vv (length s) 1) (if (< vv 0) - (setq comp-buf (nconc (make-list (- vv) "") comp-buf) - comp-base (- v) - comp-height (- comp-height vv) + (setq math-comp-buf (nconc (make-list (- vv) "") math-comp-buf) + math-comp-base (- v) + math-comp-hgt (- math-comp-hgt vv) vv 0) - (if (>= vv comp-height) - (setq comp-buf (nconc comp-buf - (make-list (1+ (- vv comp-height)) "")) - comp-height (1+ vv)))) - (let ((str (nthcdr vv comp-buf))) + (if (>= vv math-comp-hgt) + (setq math-comp-buf (nconc math-comp-buf + (make-list (1+ (- vv math-comp-hgt)) "")) + math-comp-hgt (1+ vv)))) + (let ((str (nthcdr vv math-comp-buf))) (setcar str (concat (car str) (make-string (- h (length (car str))) 32) - (if comp-highlight + (if math-comp-highlight (math-comp-highlight-string s) s)))))))) @@ -1464,20 +1526,20 @@ (> (+ y h) math-comp-sel-vpos) (<= x math-comp-sel-hpos) (> (+ x w) math-comp-sel-hpos)) - (setq math-comp-sel-tag comp-tag + (setq math-comp-sel-tag math-comp-tag math-comp-sel-vpos 10000))) (defun math-comp-simplify-term (c) (cond ((stringp c) - (math-comp-add-string c comp-hpos comp-vpos) - (setq comp-hpos (+ comp-hpos (length c)))) + (math-comp-add-string c math-comp-hpos math-comp-vpos) + (setq math-comp-hpos (+ math-comp-hpos (length c)))) ((memq (car c) '(set break)) nil) ((eq (car c) 'horiz) (while (setq c (cdr c)) (math-comp-simplify-term (car c)))) ((memq (car c) '(vleft vcent vright)) - (let* ((comp-vpos (+ (- comp-vpos (nth 1 c)) + (let* ((math-comp-vpos (+ (- math-comp-vpos (nth 1 c)) (1- (math-comp-ascent (nth 2 c))))) (widths (mapcar 'math-comp-width (cdr (cdr c)))) (maxwid (apply 'max widths)) @@ -1488,53 +1550,53 @@ (while (setq c (cdr c)) (if (eq (car-safe (car c)) 'rule) (math-comp-add-string (make-string maxwid (nth 1 (car c))) - comp-hpos comp-vpos) - (let ((comp-hpos (+ comp-hpos (/ (* bias (- maxwid + math-comp-hpos math-comp-vpos) + (let ((math-comp-hpos (+ math-comp-hpos (/ (* bias (- maxwid (car widths))) 2)))) (math-comp-simplify-term (car c)))) (and (cdr c) - (setq comp-vpos (+ comp-vpos + (setq math-comp-vpos (+ math-comp-vpos (+ (math-comp-descent (car c)) (math-comp-ascent (nth 1 c)))) widths (cdr widths)))) - (setq comp-hpos (+ comp-hpos maxwid)))) + (setq math-comp-hpos (+ math-comp-hpos maxwid)))) ((eq (car c) 'supscr) (let* ((asc (or 1 (math-comp-ascent (nth 1 c)))) (desc (math-comp-descent (nth 2 c))) (oldh (prog1 - comp-hpos + math-comp-hpos (math-comp-simplify-term (nth 1 c)))) - (comp-vpos (- comp-vpos (+ asc desc)))) + (math-comp-vpos (- math-comp-vpos (+ asc desc)))) (math-comp-simplify-term (nth 2 c)) (if math-comp-sel-hpos (math-comp-add-string-sel oldh - (- comp-vpos + (- math-comp-vpos -1 (math-comp-ascent (nth 2 c))) - (- comp-hpos oldh) + (- math-comp-hpos oldh) (math-comp-height c))))) ((eq (car c) 'subscr) (let* ((asc (math-comp-ascent (nth 2 c))) (desc (math-comp-descent (nth 1 c))) - (oldv comp-vpos) + (oldv math-comp-vpos) (oldh (prog1 - comp-hpos + math-comp-hpos (math-comp-simplify-term (nth 1 c)))) - (comp-vpos (+ comp-vpos (+ asc desc)))) + (math-comp-vpos (+ math-comp-vpos (+ asc desc)))) (math-comp-simplify-term (nth 2 c)) (if math-comp-sel-hpos (math-comp-add-string-sel oldh oldv - (- comp-hpos oldh) + (- math-comp-hpos oldh) (math-comp-height c))))) ((eq (car c) 'tag) (cond ((eq (nth 1 c) math-comp-selected) - (let ((comp-highlight (not calc-show-selections))) + (let ((math-comp-highlight (not calc-show-selections))) (math-comp-simplify-term (nth 2 c)))) ((eq (nth 1 c) t) - (let ((comp-highlight nil)) + (let ((math-comp-highlight nil)) (math-comp-simplify-term (nth 2 c)))) - (t (let ((comp-tag c)) + (t (let ((math-comp-tag c)) (math-comp-simplify-term (nth 2 c)))))))) @@ -1707,5 +1769,7 @@ (math-comp-to-string-raw-step (cdr cl) indent)) "")) +(provide 'calccomp) + ;;; arch-tag: 7c45d10a-a286-4dab-af49-7ae8989fbf78 ;;; calccomp.el ends here diff --git a/lisp/calc/calcsel2.el b/lisp/calc/calcsel2.el index 66f6ce88bc3..28944755a1b 100644 --- a/lisp/calc/calcsel2.el +++ b/lisp/calc/calcsel2.el @@ -3,8 +3,7 @@ ;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> -;; Maintainers: D. Goel <deego@gnufans.org> -;; Colin Walters <walters@debian.org> +;; Maintainer: Jay Belanger <belanger@truman.edu> ;; This file is part of GNU Emacs. @@ -28,12 +27,12 @@ ;;; Code: ;; This file is autoloaded from calc-ext.el. -(require 'calc-ext) +(require 'calc-ext) (require 'calc-macs) -(defun calc-Need-calc-sel-2 () nil) - +;; The variable calc-keep-selection is declared and set in calc-sel.el. +(defvar calc-keep-selection) (defun calc-commute-left (arg) (interactive "p") @@ -296,5 +295,7 @@ (interactive "P") (calc-rewrite-selection "InvertRules" many "jinv")) +(provide 'calcsel2) + ;;; arch-tag: 7c5b8d65-b8f0-45d9-820d-9930f8ee114b ;;; calcsel2.el ends here |