-;; Calculator for GNU Emacs, part II
-;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc.
-;; Written by Dave Gillespie, daveg@synaptics.com.
+;;; calc-ext.el --- various extension functions for Calc
+
+;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004,
+;; 2005 Free Software Foundation, Inc.
+
+;; Author: David Gillespie <daveg@synaptics.com>
+;; Maintainer: Jay Belanger <belanger@truman.edu>
;; This file is part of GNU Emacs.
;; file named COPYING. Among other things, the copyright notice
;; and this notice must be preserved on all copies.
+;;; Commentary:
+;;; Code:
-(provide 'calc-ext)
+(require 'calc)
+(require 'calc-macs)
-(setq calc-extensions-loaded t)
+(defvar math-simplifying nil)
+(defvar math-living-dangerously nil) ; true if unsafe simplifications are okay.
+(defvar math-integrating nil)
-;;; 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
-)
+(defvar math-rewrite-selections nil)
-;;; 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.")))
+(defvar math-compose-level 0)
+(defvar math-comp-selected nil)
+(defvar math-comp-tagged nil)
+(defvar math-comp-sel-hpos nil)
+(defvar math-comp-sel-vpos nil)
+(defvar math-comp-sel-cpos nil)
+(defvar math-compose-hash-args nil)
-(require 'calc-macs)
+(defvar calc-alg-map)
+(defvar calc-alg-esc-map)
;;; The following was made a function so that it could be byte-compiled.
(defun calc-init-extensions ()
- (setq gc-cons-threshold (max gc-cons-threshold 250000))
-
(define-key calc-mode-map ":" 'calc-fdiv)
(define-key calc-mode-map "\\" 'calc-idiv)
(define-key calc-mode-map "|" 'calc-concat)
(define-key calc-mode-map "\C-w" 'calc-kill-region)
(define-key calc-mode-map "\M-w" 'calc-copy-region-as-kill)
(define-key calc-mode-map "\C-y" 'calc-yank)
+ (define-key calc-mode-map [mouse-2] 'calc-yank)
(define-key calc-mode-map "\C-_" 'calc-undo)
(define-key calc-mode-map "\C-xu" 'calc-undo)
(define-key calc-mode-map "\M-\C-m" 'calc-last-args)
(define-key calc-mode-map "dO" 'calc-flat-language)
(define-key calc-mode-map "dP" 'calc-pascal-language)
(define-key calc-mode-map "dT" 'calc-tex-language)
+ (define-key calc-mode-map "dL" 'calc-latex-language)
(define-key calc-mode-map "dU" 'calc-unformatted-language)
(define-key calc-mode-map "dW" 'calc-maple-language)
(define-key calc-mode-map "d[" 'calc-truncate-up)
(define-key calc-mode-map "d'" 'calc-display-raw)
(define-key calc-mode-map "d " 'calc-refresh)
(define-key calc-mode-map "d\r" 'calc-refresh-top)
+ (define-key calc-mode-map "d@" 'calc-toggle-banner)
(define-key calc-mode-map "f" nil)
(define-key calc-mode-map "f?" 'calc-f-prefix-help)
(define-key calc-mode-map "m?" 'calc-m-prefix-help)
(define-key calc-mode-map "ma" 'calc-algebraic-mode)
(define-key calc-mode-map "md" 'calc-degrees-mode)
+ (define-key calc-mode-map "me" 'calc-embedded-preserve-modes)
(define-key calc-mode-map "mf" 'calc-frac-mode)
(define-key calc-mode-map "mg" 'calc-get-modes)
(define-key calc-mode-map "mh" 'calc-hms-mode)
(define-key calc-mode-map "sd" 'calc-declare-variable)
(define-key calc-mode-map "se" 'calc-edit-variable)
(define-key calc-mode-map "si" 'calc-insert-variables)
+ (define-key calc-mode-map "sk" 'calc-copy-special-constant)
(define-key calc-mode-map "sl" 'calc-let)
(define-key calc-mode-map "sm" 'calc-store-map)
(define-key calc-mode-map "sn" 'calc-store-neg)
(define-key calc-mode-map "v}" 'calc-matrix-brackets)
(define-key calc-mode-map "v(" 'calc-vector-parens)
(define-key calc-mode-map "v)" 'calc-matrix-brackets)
+ ;; We can't rely on the automatic upper->lower conversion because
+ ;; in the global map V is explicitly bound, so we need to bind it
+ ;; explicitly as well :-( --stef
(define-key calc-mode-map "V" (lookup-key calc-mode-map "v"))
(define-key calc-mode-map "z" 'nil)
(define-key calc-mode-map (format "u%c" x) 'calc-quick-units)))
"0123456789")
- (or calc-emacs-type-19 (progn
(let ((i ?A))
- (while (and (<= i ?z) (vectorp calc-mode-map))
- (if (eq (car-safe (aref calc-mode-map i)) 'keymap)
- (aset calc-mode-map i
- (cons 'keymap (cons (cons ?\e (aref calc-mode-map i))
- (cdr (aref calc-mode-map i))))))
+ (while (<= i ?z)
+ (if (eq (car-safe (aref (nth 1 calc-mode-map) i)) 'keymap)
+ (aset (nth 1 calc-mode-map) i
+ (cons 'keymap (cons (cons ?\e (aref (nth 1 calc-mode-map) i))
+ (cdr (aref (nth 1 calc-mode-map) i))))))
(setq i (1+ i))))
-
- (setq calc-alg-map (copy-sequence calc-mode-map)
- calc-alg-esc-map (copy-sequence esc-map))
+
+ (setq calc-alg-map (copy-keymap calc-mode-map)
+ calc-alg-esc-map (copy-keymap esc-map))
(let ((i 32))
(while (< i 127)
(or (memq i '(?' ?` ?= ??))
- (aset calc-alg-map i 'calc-auto-algebraic-entry))
+ (aset (nth 1 calc-alg-map) i 'calc-auto-algebraic-entry))
(or (memq i '(?# ?x ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))
- (aset calc-alg-esc-map i (aref calc-mode-map i)))
+ (aset (nth 1 calc-alg-esc-map) i (aref (nth 1 calc-mode-map) i)))
(setq i (1+ i))))
(define-key calc-alg-map "\e" calc-alg-esc-map)
(define-key calc-alg-map "\e\t" 'calc-roll-up)
(define-key calc-alg-map "\e\C-m" 'calc-last-args-stub)
(define-key calc-alg-map "\e\177" 'calc-pop-above)
- ))
-
- ;; The following is a relic for backward compatability only.
- ;; The calc-define property list is now the recommended method.
- (if (and (boundp 'calc-ext-defs)
- calc-ext-defs)
- (progn
- (calc-need-macros)
- (message "Evaluating calc-ext-defs...")
- (eval (cons 'progn calc-ext-defs))
- (setq calc-ext-defs nil)))
;;;; (Autoloads here)
(mapcar (function (lambda (x)
(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
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)
- ("calc-alg-2" 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
math-poly-all-roots math-prod-rec math-reject-solution math-solve-eqn
math-solve-for math-sum-rec math-try-integral)
- ("calc-alg-3" 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
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
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
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
calcFunc-totient math-init-random-base math-member math-prime-test
math-random-base)
- ("calc-comp" 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-embedded-modes-change calc-embedded-var-change
+calc-embedded-preserve-modes)
- ("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
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
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-graph" calc-graph-show-tty)
- ("calc-help" calc-Need-calc-help)
+ ("calc-incom" calc-digit-dots)
- ("calc-incom" calc-Need-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
math-calcFunc-to-var math-multi-subst math-multi-subst-rec
math-var-to-calcFunc)
- ("calc-mat" 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
+calcFunc-arctan calcFunc-arctan2 calcFunc-arctanh calcFunc-csc
+calcFunc-csch calcFunc-cos calcFunc-cosh calcFunc-cot calcFunc-coth
+calcFunc-deg calcFunc-exp calcFunc-exp10 calcFunc-expm1
calcFunc-hypot calcFunc-ilog calcFunc-isqrt calcFunc-ln calcFunc-lnp1
-calcFunc-log calcFunc-log10 calcFunc-nroot calcFunc-rad calcFunc-sin
+calcFunc-log calcFunc-log10 calcFunc-nroot calcFunc-rad calcFunc-sec
+calcFunc-sech calcFunc-sin
calcFunc-sincos calcFunc-sinh calcFunc-sqr calcFunc-sqrt calcFunc-tan
calcFunc-tanh math-arccos-raw math-arcsin-raw math-arctan-raw
-math-arctan2-raw math-cos-raw math-exp-minus-1-raw math-exp-raw
+math-arctan2-raw math-cos-raw math-cot-raw math-csc-raw
+math-exp-minus-1-raw math-exp-raw
math-from-radians math-from-radians-2 math-hypot math-infinite-dir
math-isqrt-small math-ln-raw math-nearly-equal math-nearly-equal-float
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
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
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
("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)
- ("calc-sel-2" 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
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)
calc-poly-div-rem calc-poly-gcd calc-poly-rem calc-simplify
calc-simplify-extended calc-substitute)
- ("calc-alg-2" calc-alt-summation calc-derivative
+ ("calcalg2" calc-alt-summation calc-derivative
calc-dump-integral-cache calc-integral calc-num-integral
calc-poly-roots calc-product calc-solve-for calc-summation
calc-tabulate calc-taylor)
- ("calc-alg-3" calc-curve-fit calc-find-maximum calc-find-minimum
+ ("calcalg3" calc-curve-fit calc-find-maximum calc-find-minimum
calc-find-root calc-poly-interp)
("calc-arith" calc-abs calc-abssqr calc-ceiling calc-decrement
("calc-lang" calc-big-language calc-c-language calc-eqn-language
calc-flat-language calc-fortran-language calc-maple-language
calc-mathematica-language calc-normal-language calc-pascal-language
-calc-tex-language calc-unformatted-language)
+calc-tex-language calc-latex-language calc-unformatted-language)
("calc-map" calc-accumulate calc-apply calc-inner-product calc-map
calc-map-equation calc-map-stack calc-outer-product calc-reduce)
- ("calc-mat" calc-mdet calc-mlud calc-mtrace)
+ ("calc-mtx" calc-mdet calc-mlud calc-mtrace)
("calc-math" calc-arccos calc-arccosh calc-arcsin calc-arcsinh
calc-arctan calc-arctan2 calc-arctanh calc-conj calc-cos calc-cosh
+calc-cot calc-coth calc-csc calc-csch
calc-degrees-mode calc-exp calc-expm1 calc-hypot calc-ilog
calc-imaginary calc-isqrt calc-ln calc-lnp1 calc-log calc-log10
-calc-pi calc-radians-mode calc-sin calc-sincos calc-sinh calc-sqrt
+calc-pi calc-radians-mode calc-sec calc-sech
+calc-sin calc-sincos calc-sinh calc-sqrt
calc-tan calc-tanh calc-to-degrees calc-to-radians)
("calc-mode" calc-alg-simplify-mode calc-algebraic-mode
calc-select-once-maybe calc-select-part calc-select-previous
calc-show-selections calc-unselect)
- ("calc-sel-2" calc-commute-left calc-commute-right calc-sel-commute
+ ("calcsel2" calc-commute-left calc-commute-right calc-sel-commute
calc-sel-distribute calc-sel-invert calc-sel-isolate
calc-sel-jump-equals calc-sel-merge calc-sel-negate calc-sel-unpack)
calc-vector-pop-variance calc-vector-product calc-vector-sdev
calc-vector-sum calc-vector-variance)
- ("calc-store" calc-assign calc-copy-variable calc-declare-variable
+ ("calc-store" calc-assign calc-copy-special-constant
+calc-copy-variable calc-declare-variable
calc-edit-AlgSimpRules calc-edit-Decls calc-edit-EvalRules
calc-edit-ExtSimpRules calc-edit-FitRules calc-edit-GenCount
calc-edit-Holidays calc-edit-IntegLimit calc-edit-LineStyles
("calc-yank" calc-copy-as-kill calc-copy-region-as-kill
calc-copy-to-buffer calc-edit calc-edit-cancel calc-edit-mode
-calc-kill calc-kill-region calc-yank)
-
-))
-
-)
+calc-kill calc-kill-region calc-yank))))
(defun calc-init-prefixes ()
(if calc-shift-prefix
(define-key calc-mode-map "M" 'calc-more-recursion-depth)
(define-key calc-mode-map "S" 'calc-sin)
(define-key calc-mode-map "T" 'calc-tan)
- (define-key calc-mode-map "U" 'calc-undo))
-)
+ (define-key calc-mode-map "U" 'calc-undo)))
(calc-init-extensions)
;;;; 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))
-)
+ (setq calc-command-flags (delq f calc-command-flags)))
(defun calc-record-message (tag &rest args)
(let ((msg (apply 'format args)))
(message "%s" msg)
(calc-record msg tag))
- (calc-clear-command-flag 'clear-message)
-)
+ (calc-clear-command-flag 'clear-message))
(defun calc-normalize-fancy (val)
((eq simp 'units)
(math-simplify-units val))
(t ; nil, none, num
- (math-normalize val))))
-)
+ (math-normalize val)))))
+(defvar calc-help-map nil)
-(if (boundp 'calc-help-map)
+(if calc-help-map
nil
(setq calc-help-map (make-keymap))
(define-key calc-help-map "b" 'calc-describe-bindings)
(define-key calc-help-map "\C-n" 'calc-view-news)
(define-key calc-help-map "\C-w" 'calc-describe-no-warranty)
(define-key calc-help-map "?" 'calc-help-for-help)
- (define-key calc-help-map "\C-h" 'calc-help-for-help)
-)
-
+ (define-key calc-help-map "\C-h" 'calc-help-for-help))
+(defvar calc-prefix-help-phase 0)
(defun calc-do-prefix-help (msgs group key)
(if calc-full-help-flag
(list msgs group key)
(if key
(if msgs
(message "%s: %s: %c-" group (car msgs) key)
- (message "%s: (none) %c-" group (car msgs) key))
+ (message "%s: (none) %c-" group key))
(message "%s: %s" group (car msgs))))
- (and key (calc-unread-command key)))
-)
-(defvar calc-prefix-help-phase 0)
-
-
-
+ (and key (calc-unread-command key))))
;;;; Commands.
(defun calc-reset (arg)
(interactive "P")
- (save-excursion
- (or (eq major-mode 'calc-mode)
- (calc-create-buffer))
- (if calc-embedded-info
- (calc-embedded nil))
- (or arg
- (setq calc-stack nil))
- (setq calc-undo-list nil
- calc-redo-list nil)
- (let (calc-stack calc-user-parse-tables calc-standard-date-formats
- calc-invocation-macro)
- (mapcar (function (lambda (v) (set v nil))) calc-local-var-list)
- (mapcar (function (lambda (v) (set (car v) (nth 1 v))))
- calc-mode-var-list))
- (calc-set-language nil nil t)
- (calc-mode)
- (let ((executing-kbd-macro "")) ; inhibit message
- (calc-flush-caches))
- (run-hooks 'calc-reset-hook))
- (calc-wrapper
- (let ((win (get-buffer-window (current-buffer))))
- (calc-realign 0)
- (if win
- (let ((height (- (window-height win) 2)))
- (set-window-point win (point))
- (or (= height calc-window-height)
- (let ((swin (selected-window)))
- (select-window win)
- (enlarge-window (- calc-window-height height))
- (select-window swin)))))))
- (message "(Calculator reset)")
-)
-
+ (setq arg (if arg (prefix-numeric-value arg) nil))
+ (cond
+ ((and
+ calc-embedded-info
+ (equal (aref calc-embedded-info 0) (current-buffer))
+ (<= (point) (aref calc-embedded-info 5))
+ (>= (point) (aref calc-embedded-info 4)))
+ (let ((cbuf (aref calc-embedded-info 1))
+ (calc-embedded-quiet t))
+ (save-window-excursion
+ (calc-embedded nil)
+ (set-buffer cbuf)
+ (calc-reset arg))
+ (calc-embedded nil)))
+ ((eq major-mode 'calc-mode)
+ (save-excursion
+ (unless (and arg (> (abs arg) 0))
+ (setq calc-stack nil))
+ (setq calc-undo-list nil
+ calc-redo-list nil)
+ (let (calc-stack calc-user-parse-tables calc-standard-date-formats
+ calc-invocation-macro)
+ (mapcar (function (lambda (v) (set v nil))) calc-local-var-list)
+ (if (and arg (<= arg 0))
+ (calc-mode-var-list-restore-default-values)
+ (calc-mode-var-list-restore-saved-values)))
+ (calc-set-language nil nil t)
+ (calc-mode)
+ (calc-flush-caches t)
+ (run-hooks 'calc-reset-hook))
+ (calc-wrapper
+ (let ((win (get-buffer-window (current-buffer))))
+ (calc-realign 0)
+ ;; Adjust the window height if the window is visible, but doesn't
+ ;; take up the whole height of the frame.
+ (if (and
+ win
+ (< (window-height win) (1- (frame-height))))
+ (let ((height (- (window-height win) 2)))
+ (set-window-point win (point))
+ (or (= height calc-window-height)
+ (let ((swin (selected-window)))
+ (select-window win)
+ (enlarge-window (- calc-window-height height))
+ (select-window swin)))))))
+ (message "(Calculator reset)"))
+ (t
+ (message "(Not inside a Calc buffer)"))))
+;; What a pain; scroll-left behaves differently when called non-interactively.
(defun calc-scroll-left (n)
(interactive "P")
- (scroll-left (or n (/ (window-width) 2)))
-)
+ (setq prefix-arg (or n (/ (window-width) 2)))
+ (call-interactively #'scroll-left))
(defun calc-scroll-right (n)
(interactive "P")
- (scroll-right (or n (/ (window-width) 2)))
-)
+ (setq prefix-arg (or n (/ (window-width) 2)))
+ (call-interactively #'scroll-right))
(defun calc-scroll-up (n)
(interactive "P")
(save-excursion
(forward-line (- (1- (window-height))))
(point)))
- (forward-line -1)))
-)
+ (forward-line -1))))
(defun calc-scroll-down (n)
(interactive "P")
(or (pos-visible-in-window-p 1)
- (scroll-down (or n (/ (window-height) 2))))
-)
+ (scroll-down (or n (/ (window-height) 2)))))
(defun calc-precision (n)
(interactive "NPrecision: ")
(calc-wrapper
(if (< (prefix-numeric-value n) 3)
- (error "Precision must be at least 3 digits.")
+ (error "Precision must be at least 3 digits")
(calc-change-mode 'calc-internal-prec (prefix-numeric-value n)
(and (memq (car calc-float-format) '(float sci eng))
(< (nth 1 calc-float-format)
(if (= calc-number-radix 10) 0 1))))
(calc-record calc-internal-prec "prec"))
- (message "Floating-point precision is %d digits." calc-internal-prec))
-)
+ (message "Floating-point precision is %d digits" calc-internal-prec)))
(defun calc-inverse (&optional n)
(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)))
+ (define-key map [t] 'calc-fancy-prefix-other-key)
+ (define-key map (vector meta-prefix-char t) 'calc-fancy-prefix-other-key)
+ (define-key map [switch-frame] nil)
+ (define-key map [?\C-u] 'universal-argument)
+ (define-key map [?0] 'digit-argument)
+ (define-key map [?1] 'digit-argument)
+ (define-key map [?2] 'digit-argument)
+ (define-key map [?3] 'digit-argument)
+ (define-key map [?4] 'digit-argument)
+ (define-key map [?5] 'digit-argument)
+ (define-key map [?6] 'digit-argument)
+ (define-key map [?7] 'digit-argument)
+ (define-key map [?8] 'digit-argument)
+ (define-key map [?9] 'digit-argument)
+ map)
+ "Keymap used while processing calc-fancy-prefix.")
+
+(defvar calc-is-keypad-press nil)
(defun calc-fancy-prefix (flag msg n)
(let (prefix)
(calc-wrapper
prefix-arg n)
(message (if prefix msg "")))
(and prefix
- nil ; Excise broken code we can live without. -- daveg 12/12/96
(not calc-is-keypad-press)
- (let ((event (calc-read-key t)))
- (if (eq (setq last-command-char (car event)) ?\C-u)
- (universal-argument)
- (if (or (not (integerp last-command-char))
- (and (>= last-command-char 0) (< last-command-char ? )
- (not (memq last-command-char '(?\e)))))
- (calc-wrapper)) ; clear flags if not a Calc command.
- (if calc-emacs-type-19
- (setq last-command-event (cdr event)))
- (if (or (not (integerp last-command-char))
- (eq last-command-char ?-))
- (calc-unread-command)
- (digit-argument n))))))
-)
-(setq calc-is-keypad-press nil)
+ (if (boundp 'overriding-terminal-local-map)
+ (setq overriding-terminal-local-map calc-fancy-prefix-map)
+ (let ((event (calc-read-key t)))
+ (if (eq (setq last-command-char (car event)) ?\C-u)
+ (universal-argument)
+ (if (or (not (integerp last-command-char))
+ (and (>= last-command-char 0) (< last-command-char ? )
+ (not (memq last-command-char '(?\e)))))
+ (calc-wrapper)) ; clear flags if not a Calc command.
+ (setq last-command-event (cdr event))
+ (if (or (not (integerp last-command-char))
+ (eq last-command-char ?-))
+ (calc-unread-command)
+ (digit-argument n))))))))
+
+(defun calc-fancy-prefix-other-key (arg)
+ (interactive "P")
+ (if (and
+ (not (eq last-command-char 'tab))
+ (not (eq last-command-char 'M-tab))
+ (or (not (integerp last-command-char))
+ (and (>= last-command-char 0) (< last-command-char ? )
+ (not (eq last-command-char meta-prefix-char)))))
+ (calc-wrapper)) ; clear flags if not a Calc command.
+ (setq prefix-arg arg)
+ (calc-unread-command)
+ (setq overriding-terminal-local-map nil))
(defun calc-invert-func ()
(save-excursion
(calc-select-buffer)
(setq calc-inverse-flag (not (calc-is-inverse))
calc-hyperbolic-flag (calc-is-hyperbolic)
- current-prefix-arg nil))
-)
+ current-prefix-arg nil)))
(defun calc-is-inverse ()
- calc-inverse-flag
-)
+ calc-inverse-flag)
(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
(calc-select-buffer)
(setq calc-inverse-flag (calc-is-inverse)
calc-hyperbolic-flag (not (calc-is-hyperbolic))
- current-prefix-arg nil))
-)
+ current-prefix-arg nil)))
(defun calc-is-hyperbolic ()
- calc-hyperbolic-flag
-)
+ calc-hyperbolic-flag)
(defun calc-keep-args (&optional n)
(interactive "P")
- (calc-fancy-prefix 'calc-keep-args-flag "Keep args..." n)
-)
+ (calc-fancy-prefix 'calc-keep-args-flag "Keep args..." n))
(defun calc-change-mode (var value &optional refresh option)
(calc-refresh-evaltos))
(and (eq calc-mode-save-mode 'save)
(not (equal var '(calc-mode-save-mode)))
- (calc-save-modes t))))
+ (calc-save-modes))))
(if calc-embedded-info (calc-embedded-modes-change var))
- (symbol-value (car var))))
-)
+ (symbol-value (car var)))))
+
+(defun calc-toggle-banner ()
+ "Toggle display of the friendly greeting calc normally shows above the stack."
+ (interactive)
+ (setq calc-show-banner (not calc-show-banner))
+ (calc-refresh))
(defun calc-refresh-top (n)
(interactive "p")
(calc-push-list (mapcar 'car entries)
1
(mapcar (function (lambda (x) (nth 2 x)))
- entries))))))
-)
+ entries)))))))
+(defvar calc-refreshing-evaltos nil)
+(defvar calc-no-refresh-evaltos nil)
(defun calc-refresh-evaltos (&optional which-var)
(and calc-any-evaltos calc-auto-recompute (not calc-no-refresh-evaltos)
(let ((calc-refreshing-evaltos t)
(calc-pop-stack 1 (1+ num) t)))))
(setq num (1- num)))))
(and calc-embedded-active which-var
- (calc-embedded-var-change which-var))
-)
-(setq calc-refreshing-evaltos nil)
-(setq calc-no-refresh-evaltos nil)
-
+ (calc-embedded-var-change which-var)))
(defun calc-push (&rest vals)
- (calc-push-list vals)
-)
+ (calc-push-list vals))
(defun calc-pop-push (n &rest vals)
- (calc-pop-push-list n vals)
-)
+ (calc-pop-push-list n vals))
(defun calc-pop-push-record (n prefix &rest vals)
- (calc-pop-push-record-list n prefix vals)
-)
+ (calc-pop-push-record-list n prefix vals))
(defun calc-evaluate (n)
(- n))
(calc-pop-push-record-list n "eval" (mapcar 'math-evaluate-expr
(calc-top-list n)))))
- (calc-handle-whys))
-)
+ (calc-handle-whys)))
(defun calc-eval-num (n)
(calc-symbolic-mode nil))
(calc-with-default-simplification
(calc-pop-push-record 1 "num" (math-evaluate-expr (calc-top 1)))))
- (calc-handle-whys))
-)
+ (calc-handle-whys)))
(defun calc-execute-extended-command (n)
(let* ((prompt (concat (calc-num-prefix-name n) "M-x "))
(cmd (intern (completing-read prompt obarray 'commandp t "calc-"))))
(setq prefix-arg n)
- (command-execute cmd))
-)
+ (command-execute cmd)))
(defun calc-realign (&optional num)
(forward-line 1)))
(calc-wrapper
(if (get-buffer-window (current-buffer))
- (set-window-hscroll (get-buffer-window (current-buffer)) 0)))))
-)
-
-
-
-(setq math-cache-list nil)
-
-
+ (set-window-hscroll (get-buffer-window (current-buffer)) 0))))))
+(defvar math-cache-list nil)
(defun calc-var-value (v)
(and (symbolp v)
(if (eq (car-safe val) 'error)
(error "Bad format in variable contents: %s" (nth 2 val))
(set v val)))
- (symbol-value v))))
-)
-
-
-
-
+ (symbol-value v)))))
;;; In the following table, ( OP LOPS ROPS ) means that if an OP
;;; term appears as the first argument to any LOPS term, or as the
( * ( * ) ( * ) )
( / ( / ) ( ) )
( | ( | ) ( | ) )
- ( calcFunc-land ( calcFunc-land )
+ ( calcFunc-land ( calcFunc-land )
( calcFunc-land ) )
- ( calcFunc-lor ( calcFunc-lor )
+ ( calcFunc-lor ( calcFunc-lor )
( calcFunc-lor ) ) ))
(calc-slow-wrapper
(calc-unary-op "flt"
(if (calc-is-hyperbolic) 'calcFunc-float 'calcFunc-pfloat)
- arg))
-)
+ arg)))
(defvar calc-gnuplot-process nil)
-
+(defvar calc-gnuplot-input)
+(defvar calc-gnuplot-buffer)
(defun calc-gnuplot-alive ()
(and calc-gnuplot-process
(buffer-name calc-gnuplot-buffer)
calc-gnuplot-input
(buffer-name calc-gnuplot-input)
- (memq (process-status calc-gnuplot-process) '(run stop)))
-)
+ (memq (process-status calc-gnuplot-process) '(run stop))))
(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)
-
- (message "All parts of Calc are now loaded.")
-)
+ (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"))
;;; Vector commands.
(calc-top 1) (calc-top 2))))
(if (calc-is-hyperbolic)
(calc-binary-op "apnd" 'calcFunc-append arg '(vec))
- (calc-binary-op "|" 'calcFunc-vconcat arg '(vec) nil '|))))
-)
+ (calc-binary-op "|" 'calcFunc-vconcat arg '(vec) nil '|)))))
(defun calc-append (arg)
(interactive "P")
(calc-hyperbolic-func)
- (calc-concat arg)
-)
+ (calc-concat arg))
(defconst calc-arg-values '( ( var ArgA var-ArgA ) ( var ArgB var-ArgB )
))
(defun calc-invent-args (n)
- (nreverse (nthcdr (- (length calc-arg-values) n) (reverse calc-arg-values)))
-)
+ (nreverse (nthcdr (- (length calc-arg-values) n) (reverse calc-arg-values))))
(let ((res (cdr (lookup-key calc-mode-map "z"))))
(if (eq (car (car res)) 27)
(cdr res)
- res))
-)
+ res)))
+
+(defvar calc-z-prefix-buf nil)
+(defvar calc-z-prefix-msgs nil)
(defun calc-z-prefix-help ()
(interactive)
- (let* ((msgs nil)
- (buf "")
+ (let* ((calc-z-prefix-msgs nil)
+ (calc-z-prefix-buf "")
(kmap (sort (copy-sequence (calc-user-key-map))
(function (lambda (x y) (< (car x) (car y))))))
(flags (apply 'logior
(if (= (logand flags 8) 0)
(calc-user-function-list kmap 7)
(calc-user-function-list kmap 1)
- (setq msgs (cons buf msgs)
- buf "")
+ (setq calc-z-prefix-msgs (cons calc-z-prefix-buf calc-z-prefix-msgs)
+ calc-z-prefix-buf "")
(calc-user-function-list kmap 6))
(if (/= flags 0)
- (setq msgs (cons buf msgs)))
- (calc-do-prefix-help (nreverse msgs) "user" ?z))
-)
+ (setq calc-z-prefix-msgs (cons calc-z-prefix-buf calc-z-prefix-msgs)))
+ (calc-do-prefix-help (nreverse calc-z-prefix-msgs) "user" ?z)))
(defun calc-user-function-classify (key)
(cond ((/= key (downcase key)) ; upper-case
(if (assq (downcase key) (calc-user-key-map)) 9 1))
((/= key (upcase key)) 2) ; lower-case
((= key ??) 0)
- (t 4)) ; other
-)
+ (t 4))) ; other
(defun calc-user-function-list (map flags)
(and map
(upcase key)
(downcase name))))
(char-to-string (upcase key)))))
- (if (= (length buf) 0)
- (setq buf (concat (if (= flags 1) "SHIFT + " "")
+ (if (= (length calc-z-prefix-buf) 0)
+ (setq calc-z-prefix-buf (concat (if (= flags 1) "SHIFT + " "")
desc))
- (if (> (+ (length buf) (length desc)) 58)
- (setq msgs (cons buf msgs)
- buf (concat (if (= flags 1) "SHIFT + " "")
+ (if (> (+ (length calc-z-prefix-buf) (length desc)) 58)
+ (setq calc-z-prefix-msgs
+ (cons calc-z-prefix-buf calc-z-prefix-msgs)
+ calc-z-prefix-buf (concat (if (= flags 1) "SHIFT + " "")
desc))
- (setq buf (concat buf ", " desc))))))
- (calc-user-function-list (cdr map) flags)))
-)
+ (setq calc-z-prefix-buf (concat calc-z-prefix-buf ", " desc))))))
+ (calc-user-function-list (cdr map) flags))))
"kbd-macros: < > (repeat), ( ) (for), { } (loop)"
"kbd-macros: / (break)"
"kbd-macros: ` (save), ' (restore)")
- "user" ?Z)
-)
+ "user" ?Z))
;;;; Caches.
(last-prec (intern (concat (symbol-name name) "-last-prec")))
(last-val (intern (concat (symbol-name name) "-last"))))
(list 'progn
- (list 'setq cache-prec (if init (math-numdigs (nth 1 init)) -100))
- (list 'setq cache-val (list 'quote init))
- (list 'setq last-prec -100)
- (list 'setq last-val nil)
+ (list 'defvar cache-prec (if init (math-numdigs (nth 1 init)) -100))
+ (list 'defvar cache-val (list 'quote init))
+ (list 'defvar last-prec -100)
+ (list 'defvar last-val nil)
(list 'setq 'math-cache-list
(list 'cons
(list 'quote cache-prec)
'(+ calc-internal-prec 2)))
cache-val))
last-prec 'calc-internal-prec))
- last-val)))
-)
+ last-val))))
(put 'math-defcache 'lisp-indent-hook 2)
;;; Betcha didn't know that pi = 16 atan(1/5) - 4 atan(1/239). [F] [Public]
(if symb
'(var pi var-pi)
(math-pi))
- 180)
-)
+ 180))
(defun math-full-circle (symb)
- (math-mul 2 (math-half-circle symb))
-)
+ (math-mul 2 (math-half-circle symb)))
(defun math-quarter-circle (symb)
- (math-div (math-half-circle symb) 2)
-)
-
-
+ (math-div (math-half-circle symb) 2))
+(defvar math-expand-formulas nil)
;;;; Miscellaneous math routines.
(if (consp a)
(and (memq (car a) '(bigpos bigneg))
(= (% (nth 1 a) 2) 1))
- (/= (% a 2) 0))
-)
+ (/= (% a 2) 0)))
;;; True if A is a small or big integer. [P x] [Public]
(defun math-integerp (a)
(or (integerp a)
- (memq (car-safe a) '(bigpos bigneg)))
-)
+ (memq (car-safe a) '(bigpos bigneg))))
;;; True if A is (numerically) a non-negative integer. [P N] [Public]
(defun math-natnump (a)
(or (natnump a)
- (eq (car-safe a) 'bigpos))
-)
+ (eq (car-safe a) 'bigpos)))
;;; True if A is a rational (or integer). [P x] [Public]
(defun math-ratp (a)
(or (integerp a)
- (memq (car-safe a) '(bigpos bigneg frac)))
-)
+ (memq (car-safe a) '(bigpos bigneg frac))))
;;; True if A is a real (or rational). [P x] [Public]
(defun math-realp (a)
(or (integerp a)
- (memq (car-safe a) '(bigpos bigneg frac float)))
-)
+ (memq (car-safe a) '(bigpos bigneg frac float))))
;;; True if A is a real or HMS form. [P x] [Public]
(defun math-anglep (a)
(or (integerp a)
- (memq (car-safe a) '(bigpos bigneg frac float hms)))
-)
+ (memq (car-safe a) '(bigpos bigneg frac float hms))))
;;; True if A is a number of any kind. [P x] [Public]
(defun math-numberp (a)
(or (integerp a)
- (memq (car-safe a) '(bigpos bigneg frac float cplx polar)))
-)
+ (memq (car-safe a) '(bigpos bigneg frac float cplx polar))))
;;; True if A is a complex number or angle. [P x] [Public]
(defun math-scalarp (a)
(or (integerp a)
- (memq (car-safe a) '(bigpos bigneg frac float cplx polar hms)))
-)
+ (memq (car-safe a) '(bigpos bigneg frac float cplx polar hms))))
;;; True if A is a vector. [P x] [Public]
(defun math-vectorp (a)
- (eq (car-safe a) 'vec)
-)
+ (eq (car-safe a) 'vec))
;;; True if A is any vector or scalar data object. [P x]
(defun math-objvecp (a) ; [Public]
(or (integerp a)
(memq (car-safe a) '(bigpos bigneg frac float cplx polar
- hms date sdev intv mod vec incomplete)))
-)
+ hms date sdev intv mod vec incomplete))))
;;; True if A is an object not composed of sub-formulas . [P x] [Public]
(defun math-primp (a)
(or (integerp a)
(memq (car-safe a) '(bigpos bigneg frac float cplx polar
- hms date mod var)))
-)
+ hms date mod var))))
;;; True if A is numerically (but not literally) an integer. [P x] [Public]
(defun math-messy-integerp (a)
(cond
((eq (car-safe a) 'float) (>= (nth 2 a) 0))
- ((eq (car-safe a) 'frac) (Math-integerp (math-normalize a))))
-)
+ ((eq (car-safe a) 'frac) (Math-integerp (math-normalize a)))))
;;; True if A is numerically an integer. [P x] [Public]
(defun math-num-integerp (a)
(or (Math-integerp a)
- (Math-messy-integerp a))
-)
+ (Math-messy-integerp a)))
;;; True if A is (numerically) a non-negative integer. [P N] [Public]
(defun math-num-natnump (a)
(eq (car-safe a) 'bigpos)
(and (eq (car-safe a) 'float)
(Math-natnump (nth 1 a))
- (>= (nth 2 a) 0)))
-)
+ (>= (nth 2 a) 0))))
;;; True if A is an integer or will evaluate to an integer. [P x] [Public]
(defun math-provably-integerp (a)
calcFunc-roundu
calcFunc-floor
calcFunc-ceil))
- (= (length a) 2)))
-)
+ (= (length a) 2))))
;;; True if A is a real or will evaluate to a real. [P x] [Public]
(defun math-provably-realp (a)
(or (Math-realp a)
(math-provably-integer a)
- (memq (car-safe a) '(abs arg)))
-)
+ (memq (car-safe a) '(abs arg))))
;;; True if A is a non-real, complex number. [P x] [Public]
(defun math-complexp (a)
- (memq (car-safe a) '(cplx polar))
-)
+ (memq (car-safe a) '(cplx polar)))
;;; True if A is a non-real, rectangular complex number. [P x] [Public]
(defun math-rect-complexp (a)
- (eq (car-safe a) 'cplx)
-)
+ (eq (car-safe a) 'cplx))
;;; True if A is a non-real, polar complex number. [P x] [Public]
(defun math-polar-complexp (a)
- (eq (car-safe a) 'polar)
-)
+ (eq (car-safe a) 'polar))
;;; True if A is a matrix. [P x] [Public]
(defun math-matrixp (a)
(while (and (setq a (cdr a))
(Math-vectorp (car a))
(= (length (car a)) len)))
- (null a)))
-)
+ (null a))))
(defun math-matrixp-step (a len) ; [P L]
(or (null a)
(and (Math-vectorp (car a))
(= (length (car a)) len)
- (math-matrixp-step (cdr a) len)))
-)
+ (math-matrixp-step (cdr a) len))))
;;; True if A is a square matrix. [P V] [Public]
(defun math-square-matrixp (a)
(let ((dims (math-mat-dimens a)))
(and (cdr dims)
- (= (car dims) (nth 1 dims))))
-)
+ (= (car dims) (nth 1 dims)))))
;;; True if A is any scalar data object. [P x]
(defun math-objectp (a) ; [Public]
(or (integerp a)
(memq (car-safe a) '(bigpos bigneg frac float cplx
- polar hms date sdev intv mod)))
-)
+ polar hms date sdev intv mod))))
;;; Verify that A is an integer and return A in integer form. [I N; - x]
(defun math-check-integer (a) ; [Public]
((math-integerp a) a)
((math-messy-integerp a)
(math-trunc a))
- (t (math-reject-arg a 'integerp)))
-)
+ (t (math-reject-arg a 'integerp))))
;;; Verify that A is a small integer and return A in integer form. [S N; - x]
(defun math-check-fixnum (a &optional allow-inf) ; [Public]
(lsh -1 -1))
((and allow-inf (equal a '(neg (var inf var-inf))))
(- (lsh -1 -1)))
- (t (math-reject-arg a 'fixnump)))
-)
+ (t (math-reject-arg a 'fixnump))))
;;; Verify that A is an integer >= 0 and return A in integer form. [I N; - x]
(defun math-check-natnum (a) ; [Public]
((and (not (math-negp a))
(Math-num-integerp a))
(math-trunc a))
- (t (math-reject-arg a 'natnump)))
-)
+ (t (math-reject-arg a 'natnump))))
;;; Verify that A is in floating-point form, or force it to be a float. [F N]
(defun math-check-float (a) ; [Public]
(cond ((eq (car-safe a) 'float) a)
((Math-vectorp a) (math-map-vec 'math-check-float a))
((Math-objectp a) (math-float a))
- (t a))
-)
+ (t a)))
;;; Verify that A is a constant.
(defun math-check-const (a &optional exp-ok)
(if (or (math-constp a)
(and exp-ok math-expand-formulas))
a
- (math-reject-arg a 'constp))
-)
+ (math-reject-arg a 'constp)))
;;; Coerce integer A to be a small integer. [S I]
(- (math-fixnum-big (cdr a)))
(math-fixnum-big (cdr a)))
0)
- a)
-)
+ a))
(defun math-fixnum-big (a)
(if (cdr a)
(+ (car a) (* (math-fixnum-big (cdr a)) 1000))
- (car a))
-)
+ (car a)))
+(defvar math-simplify-only nil)
(defun math-normalize-fancy (a)
(cond ((eq (car a) 'frac)
((or (integerp (car a)) (consp (car a)))
(if (null (cdr a))
(math-normalize (car a))
- (error "Can't use multi-valued function in an expression"))))
-)
+ (error "Can't use multi-valued function in an expression")))))
-(defun math-normalize-nonstandard () ; uses "a"
+;; 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
(setq calc-simplify-mode 'none
- math-simplify-only (car-safe (cdr-safe a)))
+ math-simplify-only (car-safe (cdr-safe math-normalize-a)))
nil)
- (and (symbolp (car a))
+ (and (symbolp (car math-normalize-a))
(or (eq calc-simplify-mode 'none)
(and (eq calc-simplify-mode 'num)
- (let ((aptr (setq a (cons
- (car a)
- (mapcar 'math-normalize (cdr a))))))
+ (let ((aptr (setq math-normalize-a
+ (cons
+ (car math-normalize-a)
+ (mapcar 'math-normalize
+ (cdr math-normalize-a))))))
(while (and aptr (math-constp (car aptr)))
(setq aptr (cdr aptr)))
aptr)))
- (cons (car a) (mapcar 'math-normalize (cdr a)))))
-)
-
-
-
-(setq math-expand-formulas nil)
+ (cons (car math-normalize-a)
+ (mapcar 'math-normalize (cdr math-normalize-a))))))
;;; Normalize a bignum digit list by trimming high-end zeros. [L l]
(and last
(progn
(setcdr last nil)
- a)))
-)
+ a))))
(defun math-bignum-test (a) ; [B N; B s; b b]
(if (consp a)
a
- (math-bignum a))
-)
+ (math-bignum a)))
;;; Return 0 for zero, -1 for negative, 1 for positive. [S n] [Public]
(t (calc-record-why 'realp a)
(if x
(list 'calcFunc-sign a x)
- (list 'calcFunc-sign a)))))
-)
+ (list 'calcFunc-sign a))))))
;;; Return 0 if A is numerically equal to B, <0 if less, >0 if more.
;;; Arguments must be normalized! [S N N]
(eq (car a) (car b))
(math-compare-lists (cdr a) (cdr b)))
0
- 2)))
-)
+ 2))))
;;; Compare two bignum digit lists, return -1 for A<B, 0 for A=B, 1 for A>B.
(defun math-compare-bignum (a b) ; [S l l]
(while (eq (car a) 0) (setq a (cdr a)))
(if a 1 res))
(while (eq (car b) 0) (setq b (cdr b)))
- (if b -1 res)))
-)
+ (if b -1 res))))
(defun math-compare-lists (a b)
(cond ((null a) (null b))
((null b) nil)
(t (and (Math-equal (car a) (car b))
- (math-compare-lists (cdr a) (cdr b)))))
-)
+ (math-compare-lists (cdr a) (cdr b))))))
(defun math-lessp-float (a b) ; [P F F]
(let ((ediff (- (nth 2 a) (nth 2 b))))
(Math-integer-negp (nth 1 a))
(Math-integer-posp (nth 1 b)))
(Math-lessp (nth 1 a)
- (math-scale-int (nth 1 b) ediff)))))
-)
+ (math-scale-int (nth 1 b) ediff))))))
;;; True if A is numerically equal to B. [P N N] [Public]
(defun math-equal (a b)
- (= (math-compare a b) 0)
-)
+ (= (math-compare a b) 0))
;;; True if A is numerically less than B. [P R R] [Public]
(defun math-lessp (a b)
- (= (math-compare a b) -1)
-)
+ (= (math-compare a b) -1))
;;; True if A is numerically equal to the integer B. [P N S] [Public]
;;; B must not be a multiple of 10.
(or (eq a b)
(and (eq (car-safe a) 'float)
(eq (nth 1 a) b)
- (= (nth 2 a) 0)))
-)
+ (= (nth 2 a) 0))))
(cons (1- (length m))
(math-mat-dimens (nth 1 m)))
(list (1- (length m))))
- nil)
-)
+ nil))
(mapcar (function
(lambda (x)
(list func x rhs)))
- (calc-top-list-n (- n) 2)))))))
-)
+ (calc-top-list-n (- n) 2))))))))
(defun calc-unary-op-fancy (name func arg)
(let ((n (prefix-numeric-value arg)))
(calc-enter-result 1
name
(list func (calc-top-n (- n)))
- (- n)))))
-)
-
-
+ (- n))))))
(defvar var-Holidays '(vec (var sat var-sat) (var sun var-sun)))
-
-
-
(defvar var-Decls (list 'vec))
-
-(setq math-simplify-only nil)
-
(defun math-inexact-result ()
(and calc-symbolic-mode
- (signal 'inexact-result nil))
-)
+ (signal 'inexact-result nil)))
(defun math-overflow (&optional exp)
(if (and exp (math-negp exp))
(math-underflow)
- (signal 'math-overflow nil))
-)
+ (signal 'math-overflow nil)))
(defun math-underflow ()
- (signal 'math-underflow nil)
-)
-
-
+ (signal 'math-underflow nil))
;;; Compute the greatest common divisor of A and B. [I I I] [Public]
(defun math-gcd (a b)
(setq c b
b (% a b)
a c))
- a)))
-)
+ a))))
;;;; Algebra.
(defun math-evaluate-expr (x) ; [Public]
(if calc-embedded-info
(calc-embedded-evaluate-expr x)
- (calc-normalize (math-evaluate-expr-rec x)))
-)
-(fset 'calcFunc-evalv (symbol-function 'math-evaluate-expr))
+ (calc-normalize (math-evaluate-expr-rec x))))
+
+(defalias 'calcFunc-evalv 'math-evaluate-expr)
(defun calcFunc-evalvn (x &optional prec)
(if prec
(let ((calc-internal-prec prec))
(calcFunc-evalvn x))))
(let ((calc-symbolic-mode nil))
- (math-evaluate-expr x)))
-)
+ (math-evaluate-expr x))))
(defun math-evaluate-expr-rec (x)
(if (consp x)
(if (Math-primp x)
x
(cons (car x) (mapcar 'math-evaluate-expr-rec (cdr x))))))
- x)
-)
-
-
-
-(setq math-simplifying nil)
-(setq math-living-dangerously nil) ; true if unsafe simplifications are okay.
-(setq math-integrating nil)
-
-
-
-
-(defmacro math-defsimplify (funcs &rest code)
- (append '(progn (math-need-std-simps))
- (mapcar (function
- (lambda (func)
- (list 'put (list 'quote func) ''math-simplify
- (list 'nconc
- (list 'get (list 'quote func) ''math-simplify)
- (list 'list
- (list 'function
- (append '(lambda (expr))
- code)))))))
- (if (symbolp funcs) (list funcs) funcs)))
-)
-(put 'math-defsimplify 'lisp-indent-hook 1)
-
+ x))
(defun math-any-floats (expr)
(if (Math-primp expr)
(math-floatp expr)
(while (and (setq expr (cdr expr)) (not (math-any-floats (car expr)))))
- expr)
-)
+ expr))
(defvar var-FactorRules 'calc-FactorRules)
+(defvar math-mt-many nil)
+(defvar math-mt-func nil)
-
-(defun math-map-tree (mmt-func mmt-expr &optional mmt-many)
- (or mmt-many (setq mmt-many 1000000))
- (math-map-tree-rec mmt-expr)
-)
+(defun math-map-tree (math-mt-func mmt-expr &optional math-mt-many)
+ (or math-mt-many (setq math-mt-many 1000000))
+ (math-map-tree-rec mmt-expr))
(defun math-map-tree-rec (mmt-expr)
- (or (= mmt-many 0)
+ (or (= math-mt-many 0)
(let ((mmt-done nil)
mmt-nextval)
(while (not mmt-done)
- (while (and (/= mmt-many 0)
- (setq mmt-nextval (funcall mmt-func mmt-expr))
+ (while (and (/= math-mt-many 0)
+ (setq mmt-nextval (funcall math-mt-func mmt-expr))
(not (equal mmt-expr mmt-nextval)))
(setq mmt-expr mmt-nextval
- mmt-many (if (> mmt-many 0) (1- mmt-many) (1+ mmt-many))))
+ math-mt-many (if (> math-mt-many 0)
+ (1- math-mt-many)
+ (1+ math-mt-many))))
(if (or (Math-primp mmt-expr)
- (<= mmt-many 0))
+ (<= math-mt-many 0))
(setq mmt-done t)
(setq mmt-nextval (cons (car mmt-expr)
(mapcar 'math-map-tree-rec
(if (equal mmt-nextval mmt-expr)
(setq mmt-done t)
(setq mmt-expr mmt-nextval))))))
- mmt-expr
-)
-
-
-
-
-(setq math-rewrite-selections nil)
+ mmt-expr)
(defun math-is-true (expr)
(if (Math-numberp expr)
(not (Math-zerop expr))
- (math-known-nonzerop expr))
-)
+ (math-known-nonzerop expr)))
(defun math-const-var (expr)
(and (consp expr)
(or (and (symbolp (nth 2 expr))
(boundp (nth 2 expr))
(eq (car-safe (symbol-value (nth 2 expr))) 'special-const))
- (memq (nth 2 expr) '(var-inf var-uinf var-nan))))
-)
-
-
+ (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)
(list 'function
(append '(lambda (u))
code)))))))
- (if (symbolp funcs) (list funcs) funcs)))
-)
+ (if (symbolp funcs) (list funcs) funcs))))
(put 'math-defintegral 'lisp-indent-hook 1)
(defmacro math-defintegral-2 (funcs &rest code)
(list 'function
(append '(lambda (u v))
code)))))))
- (if (symbolp funcs) (list funcs) funcs)))
-)
+ (if (symbolp funcs) (list funcs) funcs))))
(put 'math-defintegral-2 'lisp-indent-hook 1)
-
(defvar var-IntegAfterRules 'calc-IntegAfterRules)
-
(defvar var-FitRules 'calc-FitRules)
-
-(setq math-poly-base-variable nil)
-(setq math-poly-neg-powers nil)
-(setq math-poly-mult-powers 1)
-(setq math-poly-frac-powers nil)
-(setq math-poly-exp-base nil)
-
-
-
+(defvar math-poly-base-variable nil)
+(defvar math-poly-neg-powers nil)
+(defvar math-poly-mult-powers 1)
+(defvar math-poly-frac-powers nil)
+(defvar math-poly-exp-base nil)
(defun math-build-var-name (name)
(if (stringp name)
(setq name (intern name)))
(if (string-match "\\`var-." (symbol-name name))
(list 'var (intern (substring (symbol-name name) 4)) name)
- (list 'var name (intern (concat "var-" (symbol-name name)))))
-)
-
-(setq math-simplifying-units nil)
-(setq math-combining-units t)
-
-
-(put 'math-while 'lisp-indent-hook 1)
-(put 'math-for 'lisp-indent-hook 1)
-(put 'math-foreach 'lisp-indent-hook 1)
+ (list 'var name (intern (concat "var-" (symbol-name name))))))
+(defvar math-simplifying-units nil)
+(defvar math-combining-units t)
;;; Nontrivial number parsing.
(math-integerp int) (math-integerp num) (math-integerp den)
(not (math-zerop den))
(list 'frac (math-add num (math-mul int den)) den)))))
-
+
;; Fractions
((string-match "^\\([0-9]*\\)[:/]\\([0-9]*\\)$" s)
(let ((num (math-match-substring s 1))
(and num den (math-integerp num) (math-integerp den)
(not (math-zerop den))
(list 'frac num den)))))
-
+
;; Modulo forms
((string-match "^\\(.*\\) *mod *\\(.*\\)$" s)
(let* ((n (math-match-substring s 1))
(math-zerop (nth 1 minsec)))
(math-add (list 'hms hours 0 0) minsec))
(t nil)))))
-
+
;; Minutes
((string-match "^\\([^'#^]+\\)[mM']\\(.*\\)$" s)
(let* ((minutes (math-match-substring s 1))
(math-zerop (nth 2 seconds)))
(math-add (list 'hms 0 minutes 0) seconds))
(t nil)))))
-
+
;; Seconds
((string-match "^\\([^\"#^]+\\)[sS\"]$" s)
(let ((seconds (math-read-number (math-match-substring s 1))))
(not (math-negp seconds))
(Math-lessp seconds 60)
(list 'hms 0 0 seconds))))
-
+
;; Integer+fraction with explicit radix
((string-match "^\\([0-9]+\\)\\(#\\|\\^\\^\\)\\([0-9a-zA-Z]*\\)[:/]\\([0-9a-zA-Z]*\\)[:/]\\([0-9a-zA-Z]\\)$" s)
- (let ((radix (string-to-int (math-match-substring s 1)))
+ (let ((radix (string-to-number (math-match-substring s 1)))
(int (math-match-substring s 3))
(num (math-match-substring s 4))
(den (math-match-substring s 5)))
(list 'frac
(math-add num (math-mul int den))
den)))))
-
+
;; Fraction with explicit radix
((string-match "^\\([0-9]+\\)\\(#\\|\\^\\^\\)\\([0-9a-zA-Z]*\\)[:/]\\([0-9a-zA-Z]*\\)$" s)
- (let ((radix (string-to-int (math-match-substring s 1)))
+ (let ((radix (string-to-number (math-match-substring s 1)))
(num (math-match-substring s 3))
(den (math-match-substring s 4)))
(let ((num (if (> (length num) 0) (math-read-radix num radix) 1))
(den (if (> (length den) 0) (math-read-radix den radix) 1)))
(and num den (not (math-zerop den)) (list 'frac num den)))))
-
+
;; Float with explicit radix and exponent
((or (string-match "^0*\\(\\([2-9]\\|1[0-4]\\)\\(#\\|\\^\\^\\)[0-9a-dA-D.]+\\)[eE]\\([-+]?[0-9]+\\)$" s)
(string-match "^\\(\\([0-9]+\\)\\(#\\|\\^\\^\\)[0-9a-zA-Z.]+\\) *\\* *\\2\\.? *\\^ *\\([-+]?[0-9]+\\)$" s))
- (let ((radix (string-to-int (math-match-substring s 2)))
+ (let ((radix (string-to-number (math-match-substring s 2)))
(mant (math-match-substring s 1))
(exp (math-match-substring s 4)))
(let ((mant (math-read-number mant))
;; Float with explicit radix, no exponent
((string-match "^\\([0-9]+\\)\\(#\\|\\^\\^\\)\\([0-9a-zA-Z]*\\)\\.\\([0-9a-zA-Z]*\\)$" s)
- (let ((radix (string-to-int (math-match-substring s 1)))
+ (let ((radix (string-to-number (math-match-substring s 1)))
(int (math-match-substring s 3))
(fracs (math-match-substring s 4)))
(let ((int (if (> (length int) 0) (math-read-radix int radix) 0))
;; Integer with explicit radix
((string-match "^\\([0-9]+\\)\\(#\\|\\^\\^\\)\\([0-9a-zA-Z]+\\)$" s)
(math-read-radix (math-match-substring s 3)
- (string-to-int (math-match-substring s 1))))
+ (string-to-number (math-match-substring s 1))))
;; C language hexadecimal notation
((and (eq calc-language 'c)
(math-match-substring s 2))))
;; Syntax error!
- (t nil))
-)
+ (t nil)))
(defun math-read-radix (s r) ; [I X D]
(setq s (upcase s))
(setq res (math-add (math-mul res r) dig)
i (1+ i)))
(and (= i (length s))
- res))
-)
+ res)))
;;; Expression parsing.
-(defun math-read-expr (exp-str)
- (let ((exp-pos 0)
- (exp-old-pos 0)
- (exp-keep-spaces nil)
- exp-token exp-data)
- (while (setq exp-token (string-match "\\.\\.\\([^.]\\|.[^.]\\)" exp-str))
- (setq exp-str (concat (substring exp-str 0 exp-token) "\\dots"
- (substring exp-str (+ exp-token 2)))))
+(defvar math-expr-data)
+
+(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)))))
(math-build-parse-table)
(math-read-token)
(let ((val (catch 'syntax (math-read-expr-level 0))))
(if (stringp val)
- (list 'error exp-old-pos val)
- (if (equal exp-token 'end)
+ (list 'error math-exp-old-pos val)
+ (if (equal math-exp-token 'end)
val
- (list 'error exp-old-pos "Syntax error")))))
-)
+ (list 'error math-exp-old-pos "Syntax error"))))))
(defun math-read-plain-expr (exp-str &optional error-check)
(let* ((calc-language nil)
(and error-check
(eq (car-safe val) 'error)
(error "%s: %s" (nth 2 val) exp-str))
- val)
-)
+ val))
(defun math-read-string ()
- (let ((str (read-from-string (concat exp-data "\""))))
- (or (and (= (cdr str) (1+ (length exp-data)))
+ (let ((str (read-from-string (concat math-expr-data "\""))))
+ (or (and (= (cdr str) (1+ (length math-expr-data)))
(stringp (car str)))
(throw 'syntax "Error in string constant"))
(math-read-token)
- (append '(vec) (car str) nil))
-)
+ (append '(vec) (car str) nil)))
(setq str (concat (substring str 0 (match-beginning 0))
(substring str (match-end 0)))))
(if (string-match "\\\\[^ \n|]" str)
- (if (eq calc-language 'tex)
+ (if (eq calc-language 'latex)
(math-read-expr str)
- (let ((calc-language 'tex)
+ (let ((calc-language 'latex)
(calc-language-option nil)
- (math-expr-opers (get 'tex 'math-oper-table))
- (math-expr-function-mapping (get 'tex 'math-function-table))
- (math-expr-variable-mapping (get 'tex 'math-variable-table)))
+ (math-expr-opers (get 'latex 'math-oper-table))
+ (math-expr-function-mapping (get 'latex 'math-function-table))
+ (math-expr-variable-mapping (get 'latex '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))))
-)
+ (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)))
(= (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)))))
(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)))
- matrix)))
-)
-
-
+ (not (cdr math-read-big-lines)))
+ matrix))))
;;; Nontrivial "flat" formatting.
+(defvar math-format-hash-args nil)
+(defvar calc-can-abbrev-vectors nil)
+
(defun math-format-flat-expr-fancy (a prec)
(cond
((eq (car a) 'incomplete)
(symbol-name (car a))))
"("
(math-format-flat-vector (cdr a) ", " 0)
- ")"))))))
-)
-(setq math-format-hash-args nil)
+ ")")))))))
(defun math-format-flat-vector (vec sep prec)
(if vec
(while (setq vec (cdr vec))
(setq buf (concat buf sep (math-format-flat-expr (car vec) prec))))
buf)
- "")
-)
-(setq calc-can-abbrev-vectors nil)
+ ""))
(defun math-format-nice-expr (x w)
(cond ((and (eq (car-safe x) 'vec)
(substring str p))
pos (1+ p))
(setq pos (+ pos w)))))
- str)))
-)
+ str))))
(defun math-assq2 (v a)
(while (and a (not (eq v (nth 1 (car a)))))
(setq a (cdr a)))
- (car a)
-)
-
+ (car a))
(defun math-format-number-fancy (a prec)
(cond
(math-format-number (nth 2 a))))
((eq (car a) 'vec)
(math-format-flat-expr a 0))
- (t (format "%s" a)))
-)
+ (t (format "%s" a))))
(defun math-adjust-fraction (a)
(if (nth 1 calc-frac-format)
(math-gcd (nth 2 a)
(nth 1 calc-frac-format)))))
(list 'frac (math-mul (nth 1 a) g) (math-mul (nth 2 a) g))))
- a)
-)
+ a))
(defun math-format-bignum-fancy (a) ; [X L]
(let ((str (cond ((= calc-number-radix 10)
(if calc-radix-formatter
(funcall calc-radix-formatter calc-number-radix str)
(format "%d#%s" calc-number-radix str))
- str))
-)
+ str)))
(defun math-group-float (str) ; [X X]
str (concat (substring str 0 i)
calc-group-char
(substring str i))))
- str)
-)
-
-
-
-
-
-
-
-
-(setq math-compose-level 0)
-(setq math-comp-selected nil)
-(setq math-comp-tagged nil)
-(setq math-comp-sel-hpos nil)
-(setq math-comp-sel-vpos nil)
-(setq math-comp-sel-cpos nil)
-(setq math-compose-hash-args nil)
-
+ str))
;;; Users can redefine this in their .emacs files.
(defvar calc-keypad-user-menu nil
- "If not NIL, this describes an additional menu for calc-keypad.
+ "If non-nil, this describes an additional menu for calc-keypad.
It should contain a list of three rows.
Each row should be a list of six keys.
Each key should be a list of a label string, plus a Calc command name spec.
list containing a numeric entry string, or nil.
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