Newsgroups: comp.sources.misc
From: daveg@synaptics.com (David Gillespie)
Subject:  v24i067:  gnucalc - GNU Emacs Calculator, v2.00, Part19/56
Message-ID: <1991Oct31.072559.17839@sparky.imd.sterling.com>
X-Md4-Signature: c17169ce2fe78b8fee5f579d2932282f
Date: Thu, 31 Oct 1991 07:25:59 GMT
Approved: kent@sparky.imd.sterling.com

Submitted-by: daveg@synaptics.com (David Gillespie)
Posting-number: Volume 24, Issue 67
Archive-name: gnucalc/part19
Environment: Emacs
Supersedes: gmcalc: Volume 13, Issue 27-45

---- Cut Here and unpack ----
#!/bin/sh
# this is Part.19 (part 19 of a multipart archive)
# do not concatenate these parts, unpack them in order with /bin/sh
# file calc-keypd.el continued
#
if test ! -r _shar_seq_.tmp; then
	echo 'Please unpack part 1 first!'
	exit 1
fi
(read Scheck
 if test "$Scheck" != 19; then
	echo Please unpack part "$Scheck" next!
	exit 1
 else
	exit 0
 fi
) < _shar_seq_.tmp || exit 1
if test ! -f _shar_wnt_.tmp; then
	echo 'x - still skipping calc-keypd.el'
else
echo 'x - continuing file calc-keypd.el'
sed 's/^X//' << 'SHAR_EOF' >> 'calc-keypd.el' &&
X		   calc-word-size) calc-word-size )
X       ( "ARSH"  calc-rshift-arith ) )
X     ( ( "A"     ("A") )
X       ( "B"     ("B") )
X       ( "C"     ("C") )
X       ( "D"     ("D") )
X       ( "E"     ("E") )
X       ( "F"     ("F") ) ) )
)
X
;;; |----+----+----+----+----+----|
;;; |SUM |PROD|MAX |MAP*|MAP^|MAP$|
;;; |----+----+----+----+----+----|
;;; |INV |DET |TRN |IDNT|CRSS|"x" |
;;; |----+----+----+----+----+----|
;;; |PACK|UNPK|INDX|BLD |LEN |... |
X
(defvar calc-keypad-vector-menu
X  '( ( ( "SUM"   calc-vector-sum calc-vector-alt-sum calc-vector-mean )
X       ( "PROD"  calc-vector-product nil calc-vector-sdev )
X       ( "MAX"   calc-vector-max calc-vector-min )
X       ( "MAP*"  (lambda () (interactive)
X		   (calc-map '(2 calcFunc-mul "*"))) )
X       ( "MAP^"  (lambda () (interactive)
X		   (calc-map '(2 calcFunc-pow "^"))) )
X       ( "MAP$"  calc-map-stack ) )
X     ( ( "MINV"  calc-inv )
X       ( "MDET"  calc-mdet )
X       ( "MTRN"  calc-transpose calc-conj-transpose )
X       ( "IDNT"  (progn calc-num-prefix calc-ident) )
X       ( "CRSS"  calc-cross )
X       ( "\"x\"" "\excalc-algebraic-entry\rx\r"
X	         "\excalc-algebraic-entry\ry\r"
X		 "\excalc-algebraic-entry\rz\r"
X		 "\excalc-algebraic-entry\rt\r") )
X     ( ( "PACK"  calc-pack )
X       ( "UNPK"  calc-unpack )
X       ( "INDX"  (progn calc-num-prefix calc-index) "\C-u\excalc-index\r" )
X       ( "BLD"   (progn calc-num-prefix calc-build-vector) )
X       ( "LEN"   calc-vlength )
X       ( "..."   calc-full-vectors ) ) )
)
X
;;; |----+----+----+----+----+----|
;;; |FLT |FIX |SCI |ENG |GRP |    |
;;; |----+----+----+----+----+----|
;;; |RAD |DEG |FRAC|POLR|SYMB|PREC|
;;; |----+----+----+----+----+----|
;;; |SWAP|RLL3|RLL4|OVER|STO |RCL |
X
(defvar calc-keypad-modes-menu
X  '( ( ( "FLT"   calc-normal-notation )
X       ( "FIX"   calc-fix-notation )
X       ( "SCI"   calc-sci-notation )
X       ( "ENG"   calc-eng-notation )
X       ( "GRP"   calc-group-digits "\C-u-3\excalc-group-digits\r" )
X       ( ""	 nil ) )
X     ( ( "RAD"   calc-radians-mode )
X       ( "DEG"   calc-degrees-mode )
X       ( "FRAC"  calc-frac-mode )
X       ( "POLR"  calc-polar-mode )
X       ( "SYMB"	 calc-symbolic-mode )
X       ( "PREC"  calc-precision ) )
X     ( ( "SWAP"  calc-roll-down )
X       ( "RLL3"  (progn 3 calc-roll-up) (progn 3 calc-roll-down) )
X       ( "RLL4"  (progn 4 calc-roll-up) (progn 4 calc-roll-down) )
X       ( "OVER"  calc-over )
X       ( "STO"   calc-keypad-store )
X       ( "RCL"   calc-keypad-recall ) ) )
)
X
SHAR_EOF
echo 'File calc-keypd.el is complete' &&
chmod 0644 calc-keypd.el ||
echo 'restore of calc-keypd.el failed'
Wc_c="`wc -c < 'calc-keypd.el'`"
test 22155 -eq "$Wc_c" ||
	echo 'calc-keypd.el: original size 22155, current size' "$Wc_c"
rm -f _shar_wnt_.tmp
fi
# ============= calc-lang.el ==============
if test -f 'calc-lang.el' -a X"$1" != X"-c"; then
	echo 'x - skipping calc-lang.el (File already exists)'
	rm -f _shar_wnt_.tmp
else
> _shar_wnt_.tmp
echo 'x - extracting calc-lang.el (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'calc-lang.el' &&
;; Calculator for GNU Emacs, part II [calc-lang.el]
;; Copyright (C) 1990, 1991 Free Software Foundation, Inc.
;; Written by Dave Gillespie, daveg@csvax.cs.caltech.edu.
X
;; This file is part of GNU Emacs.
X
;; 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.
X
;; 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.
X
X
X
;; This file is autoloaded from calc-ext.el.
(require 'calc-ext)
X
(require 'calc-macs)
X
(defun calc-Need-calc-lang () nil)
X
X
;;; Alternate entry/display languages.
X
(defun calc-set-language (lang &optional option no-refresh)
X  (setq math-expr-opers (or (get lang 'math-oper-table) math-standard-opers)
X	math-expr-function-mapping (get lang 'math-function-table)
X	math-expr-variable-mapping (get lang 'math-variable-table)
X	calc-language-input-filter (get lang 'math-input-filter)
X	calc-language-output-filter (get lang 'math-output-filter)
X	calc-vector-brackets (or (get lang 'math-vector-brackets) "[]")
X	calc-complex-format (get lang 'math-complex-format)
X	calc-radix-formatter (get lang 'math-radix-formatter)
X	calc-function-open (or (get lang 'math-function-open) "(")
X	calc-function-close (or (get lang 'math-function-close) ")"))
X  (if no-refresh
X      (setq calc-language lang
X	    calc-language-option option)
X    (calc-change-mode '(calc-language calc-language-option)
X		      (list lang option) t))
)
X
(defun calc-normal-language ()
X  (interactive)
X  (calc-wrapper
X   (calc-set-language nil)
X   (message "Normal language mode."))
)
X
(defun calc-flat-language ()
X  (interactive)
X  (calc-wrapper
X   (calc-set-language 'flat)
X   (message "Flat language mode (all stack entries shown on one line)."))
)
X
(defun calc-big-language ()
X  (interactive)
X  (calc-wrapper
X   (calc-set-language 'big)
X   (message "\"Big\" language mode."))
)
X
(defun calc-unformatted-language ()
X  (interactive)
X  (calc-wrapper
X   (calc-set-language 'unform)
X   (message "Unformatted language mode."))
)
X
X
(defun calc-c-language ()
X  (interactive)
X  (calc-wrapper
X   (calc-set-language 'c)
X   (message "`C' language mode."))
)
X
(put 'c 'math-oper-table
X  '( ( "u+"    ident	     -1 1000 )
X     ( "u-"    neg	     -1 1000 )
X     ( "u!"    calcFunc-lnot -1 1000 )
X     ( "~"     calcFunc-not  -1 1000 )
X     ( "*"     *	     190 191 )
X     ( "/"     /	     190 191 )
X     ( "%"     %	     190 191 )
X     ( "+"     +	     180 181 )
X     ( "-"     -	     180 181 )
X     ( "<<"    calcFunc-lsh  170 171 )
X     ( ">>"    calcFunc-rsh  170 171 )
X     ( "<"     calcFunc-lt   160 161 )
X     ( ">"     calcFunc-gt   160 161 )
X     ( "<="    calcFunc-leq  160 161 )
X     ( ">="    calcFunc-geq  160 161 )
X     ( "=="    calcFunc-eq   150 151 )
X     ( "!="    calcFunc-neq  150 151 )
X     ( "&"     calcFunc-and  140 141 )
X     ( "^"     calcFunc-xor  131 130 )
X     ( "|"     calcFunc-or   120 121 )
X     ( "&&"    calcFunc-land 110 111 )
X     ( "||"    calcFunc-lor  100 101 )
X     ( "?"     (math-read-if)  91  90 )
X     ( "!!!"   calcFunc-pnot  -1  88 )
X     ( "&&&"   calcFunc-pand  85  86 )
X     ( "|||"   calcFunc-por   75  76 )
X     ( "="     calcFunc-assign 51 50 )
X     ( ":="    calcFunc-assign 51 50 )
X     ( "::"    calcFunc-condition 45 46 )
)) ; should support full assignments
X
(put 'c 'math-function-table
X  '( ( acos	   . calcFunc-arccos )
X     ( acosh	   . calcFunc-arccosh )
X     ( asin	   . calcFunc-arcsin )
X     ( asinh	   . calcFunc-arcsinh )
X     ( atan	   . calcFunc-arctan )
X     ( atan2	   . calcFunc-arctan2 )
X     ( atanh	   . calcFunc-arctanh )
))
X
(put 'c 'math-variable-table
X  '( ( M_PI	   . var-pi )
X     ( M_E	   . var-e )
))
X
(put 'c 'math-vector-brackets "{}")
X
(put 'c 'math-radix-formatter
X     (function (lambda (r s)
X		 (if (= r 16) (format "0x%s" s)
X		   (if (= r 8) (format "0%s" s)
X		     (format "%d#%s" r s))))))
X
X
(defun calc-pascal-language (n)
X  (interactive "P")
X  (calc-wrapper
X   (and n (setq n (prefix-numeric-value n)))
X   (calc-set-language 'pascal n)
X   (message (if (and n (/= n 0))
X		(if (> n 0)
X		    "Pascal language mode (all uppercase)."
X		  "Pascal language mode (all lowercase).")
X	      "Pascal language mode.")))
)
X
(put 'pascal 'math-oper-table
X  '( ( "not"   calcFunc-lnot -1 1000 )
X     ( "*"     *	     190 191 )
X     ( "/"     /	     190 191 )
X     ( "and"   calcFunc-and  190 191 )
X     ( "div"   calcFunc-idiv 190 191 )
X     ( "mod"   %	     190 191 )
X     ( "u+"    ident	     -1  185 )
X     ( "u-"    neg	     -1  185 )
X     ( "+"     +	     180 181 )
X     ( "-"     -	     180 181 )
X     ( "or"    calcFunc-or   180 181 )
X     ( "xor"   calcFunc-xor  180 181 )
X     ( "shl"   calcFunc-lsh  180 181 )
X     ( "shr"   calcFunc-rsh  180 181 )
X     ( "in"    calcFunc-in   160 161 )
X     ( "<"     calcFunc-lt   160 161 )
X     ( ">"     calcFunc-gt   160 161 )
X     ( "<="    calcFunc-leq  160 161 )
X     ( ">="    calcFunc-geq  160 161 )
X     ( "="     calcFunc-eq   160 161 )
X     ( "<>"    calcFunc-neq  160 161 )
X     ( "!!!"   calcFunc-pnot  -1  85 )
X     ( "&&&"   calcFunc-pand  80  81 )
X     ( "|||"   calcFunc-por   75  76 )
X     ( ":="    calcFunc-assign 51 50 )
X     ( "::"    calcFunc-condition 45 46 )
))
X
(put 'pascal 'math-input-filter 'calc-input-case-filter)
(put 'pascal 'math-output-filter 'calc-output-case-filter)
X
(put 'pascal 'math-radix-formatter
X     (function (lambda (r s)
X		 (if (= r 16) (format "$%s" s)
X		   (format "%d#%s" r s)))))
X
(defun calc-input-case-filter (str)
X  (cond ((or (null calc-language-option) (= calc-language-option 0))
X	 str)
X	(t
X	 (downcase str)))
)
X
(defun calc-output-case-filter (str)
X  (cond ((or (null calc-language-option) (= calc-language-option 0))
X	 str)
X	((> calc-language-option 0)
X	 (upcase str))
X	(t
X	 (downcase str)))
)
X
X
(defun calc-fortran-language (n)
X  (interactive "P")
X  (calc-wrapper
X   (and n (setq n (prefix-numeric-value n)))
X   (calc-set-language 'fortran n)
X   (message (if (and n (/= n 0))
X		(if (> n 0)
X		    "FORTRAN language mode (all uppercase)."
X		  "FORTRAN language mode (all lowercase).")
X	      "FORTRAN language mode.")))
)
X
(put 'fortran 'math-oper-table
X  '( ( "u/"    (math-parse-fortran-vector) -1 1 )
X     ( "/"     (math-parse-fortran-vector-end) 1 -1 )
X     ( "**"    ^             201 200 )
X     ( "u+"    ident	     -1  191 )
X     ( "u-"    neg	     -1  191 )
X     ( "*"     *	     190 191 )
X     ( "/"     /	     190 191 )
X     ( "+"     +	     180 181 )
X     ( "-"     -	     180 181 )
X     ( ".LT."  calcFunc-lt   160 161 )
X     ( ".GT."  calcFunc-gt   160 161 )
X     ( ".LE."  calcFunc-leq  160 161 )
X     ( ".GE."  calcFunc-geq  160 161 )
X     ( ".EQ."  calcFunc-eq   160 161 )
X     ( ".NE."  calcFunc-neq  160 161 )
X     ( ".NOT." calcFunc-lnot -1  121 )
X     ( ".AND." calcFunc-land 110 111 )
X     ( ".OR."  calcFunc-lor  100 101 )
X     ( "!!!"   calcFunc-pnot  -1  85 )
X     ( "&&&"   calcFunc-pand  80  81 )
X     ( "|||"   calcFunc-por   75  76 )
X     ( "="     calcFunc-assign 51 50 )
X     ( ":="    calcFunc-assign 51 50 )
X     ( "::"    calcFunc-condition 45 46 )
))
X
(put 'fortran 'math-vector-brackets "//")
X
(put 'fortran 'math-function-table
X  '( ( acos	   . calcFunc-arccos )
X     ( acosh	   . calcFunc-arccosh )
X     ( aimag	   . calcFunc-im )
X     ( aint	   . calcFunc-ftrunc )
X     ( asin	   . calcFunc-arcsin )
X     ( asinh	   . calcFunc-arcsinh )
X     ( atan	   . calcFunc-arctan )
X     ( atan2	   . calcFunc-arctan2 )
X     ( atanh	   . calcFunc-arctanh )
X     ( conjg	   . calcFunc-conj )
X     ( log	   . calcFunc-ln )
X     ( nint	   . calcFunc-round )
X     ( real	   . calcFunc-re )
))
X
(put 'fortran 'math-input-filter 'calc-input-case-filter)
(put 'fortran 'math-output-filter 'calc-output-case-filter)
X
(defun math-parse-fortran-vector (op)
X  (let ((math-parsing-fortran-vector '(end . "\000")))
X    (prog1
X	(math-read-brackets t "]")
X      (setq exp-token (car math-parsing-fortran-vector)
X	    exp-data (cdr math-parsing-fortran-vector))))
)
X
(defun math-parse-fortran-vector-end (x op)
X  (if math-parsing-fortran-vector
X      (progn
X	(setq math-parsing-fortran-vector (cons exp-token exp-data)
X	      exp-token 'end
X	      exp-data "\000")
X	x)
X    (throw 'syntax "Unmatched closing `/'"))
)
(setq math-parsing-fortran-vector nil)
X
X
(defun calc-tex-language (n)
X  (interactive "P")
X  (calc-wrapper
X   (and n (setq n (prefix-numeric-value n)))
X   (calc-set-language 'tex n)
X   (message (if (and n (/= n 0))
X		(if (> n 0)
X		    "TeX language mode with \\hbox{func}(\\hbox{var})."
X		  "TeX language mode with \\func{\\hbox{var}}.")
X	      "TeX language mode.")))
)
X
(put 'tex 'math-oper-table
X  '( ( "u+"       ident		   -1 1000 )
X     ( "u-"       neg		   -1 1000 )
X     ( "\\hat"    calcFunc-hat     -1  950 )
X     ( "\\check"  calcFunc-check   -1  950 )
X     ( "\\tilde"  calcFunc-tilde   -1  950 )
X     ( "\\acute"  calcFunc-acute   -1  950 )
X     ( "\\grave"  calcFunc-grave   -1  950 )
X     ( "\\dot"    calcFunc-dot     -1  950 )
X     ( "\\ddot"   calcFunc-dotdot  -1  950 )
X     ( "\\breve"  calcFunc-breve   -1  950 )
X     ( "\\bar"    calcFunc-bar     -1  950 )
X     ( "\\vec"    calcFunc-Vec     -1  950 )
X     ( "\\underline" calcFunc-under -1  950 )
X     ( "u|"       calcFunc-abs	   -1    0 )
X     ( "|"        closing	    0   -1 )
X     ( "\\lfloor" calcFunc-floor   -1    0 )
X     ( "\\rfloor" closing           0   -1 )
X     ( "\\lceil"  calcFunc-ceil    -1    0 )
X     ( "\\rceil"  closing           0   -1 )
X     ( "\\pm"	  sdev		   300 300 )
X     ( "!"        calcFunc-fact	   210  -1 )
X     ( "^"	  ^		   201 200 )
X     ( "_"	  calcFunc-subscr  201 200 )
X     ( "\\times"  *		   191 190 )
X     ( "*"        *		   191 190 )
X     ( "2x"	  *		   191 190 )
X     ( "+"	  +		   180 181 )
X     ( "-"	  -		   180 181 )
X     ( "\\over"	  /		   170 171 )
X     ( "/"	  /		   170 171 )
X     ( "\\choose" calcFunc-choose  170 171 )
X     ( "\\mod"	  %		   170 171 )
X     ( "<"	  calcFunc-lt	   160 161 )
X     ( ">"	  calcFunc-gt	   160 161 )
X     ( "\\leq"	  calcFunc-leq	   160 161 )
X     ( "\\geq"	  calcFunc-geq	   160 161 )
X     ( "="	  calcFunc-eq	   160 161 )
X     ( "\\neq"	  calcFunc-neq	   160 161 )
X     ( "\\ne"	  calcFunc-neq	   160 161 )
X     ( "\\lnot"   calcFunc-lnot     -1 121 )
X     ( "\\land"	  calcFunc-land    110 111 )
X     ( "\\lor"	  calcFunc-lor     100 101 )
X     ( "?"	  (math-read-if)    91  90 )
X     ( "!!!"	  calcFunc-pnot	    -1  85 )
X     ( "&&&"	  calcFunc-pand	    80  81 )
X     ( "|||"	  calcFunc-por	    75  76 )
X     ( "\\gets"	  calcFunc-assign   51  50 )
X     ( ":="	  calcFunc-assign   51  50 )
X     ( "::"       calcFunc-condition 45 46 )
X     ( "\\to"	  calcFunc-evalto   40  41 )
X     ( "\\to"	  calcFunc-evalto   40  -1 )
X     ( "=>" 	  calcFunc-evalto   40  41 )
X     ( "=>" 	  calcFunc-evalto   40  -1 )
))
X
(put 'tex 'math-function-table
X  '( ( \\arccos	   . calcFunc-arccos )
X     ( \\arcsin	   . calcFunc-arcsin )
X     ( \\arctan	   . calcFunc-arctan )
X     ( \\arg	   . calcFunc-arg )
X     ( \\cos	   . calcFunc-cos )
X     ( \\cosh	   . calcFunc-cosh )
X     ( \\det	   . calcFunc-det )
X     ( \\exp	   . calcFunc-exp )
X     ( \\gcd	   . calcFunc-gcd )
X     ( \\ln	   . calcFunc-ln )
X     ( \\log	   . calcFunc-log10 )
X     ( \\max	   . calcFunc-max )
X     ( \\min	   . calcFunc-min )
X     ( \\tan	   . calcFunc-tan )
X     ( \\sin	   . calcFunc-sin )
X     ( \\sinh	   . calcFunc-sinh )
X     ( \\sqrt	   . calcFunc-sqrt )
X     ( \\tanh	   . calcFunc-tanh )
X     ( \\phi	   . calcFunc-totient )
X     ( \\mu	   . calcFunc-moebius )
))
X
(put 'tex 'math-variable-table
X  '( ( \\pi	   . var-pi )
X     ( \\infty	   . var-inf )
X     ( \\infty	   . var-uinf )
X     ( \\phi       . var-phi )
X     ( \\gamma     . var-gamma )
X     ( \\sum       . (math-parse-tex-sum calcFunc-sum) )
X     ( \\prod      . (math-parse-tex-sum calcFunc-prod) )
))
X
(put 'tex 'math-complex-format 'i)
X
(defun math-parse-tex-sum (f val)
X  (let (low high save)
X    (or (equal exp-data "_") (throw 'syntax "Expected `_'"))
X    (math-read-token)
X    (setq save exp-old-pos)
X    (setq low (math-read-factor))
X    (or (eq (car-safe low) 'calcFunc-eq)
X	(progn
X	  (setq exp-old-pos (1+ save))
X	  (throw 'syntax "Expected equation")))
X    (or (equal exp-data "^") (throw 'syntax "Expected `^'"))
X    (math-read-token)
X    (setq high (math-read-factor))
X    (list (nth 2 f) (math-read-factor) (nth 1 low) (nth 2 low) high))
)
X
(defun math-tex-input-filter (str)   ; allow parsing of 123\,456\,789.
X  (while (string-match "[0-9]\\\\,[0-9]" str)
X    (setq str (concat (substring str 0 (1+ (match-beginning 0)))
X		      (substring str (1- (match-end 0))))))
X  str
)
(put 'tex 'math-input-filter 'math-tex-input-filter)
X
X
(defun calc-eqn-language (n)
X  (interactive "P")
X  (calc-wrapper
X   (calc-set-language 'eqn)
X   (message "Eqn language mode."))
)
X
(put 'eqn 'math-oper-table
X  '( ( "u+"       ident		   -1 1000 )
X     ( "u-"       neg		   -1 1000 )
X     ( "prime"    (math-parse-eqn-prime) 950  -1 )
X     ( "prime"    calcFunc-Prime   950  -1 )
X     ( "dot"      calcFunc-dot     950  -1 )
X     ( "dotdot"   calcFunc-dotdot  950  -1 )
X     ( "hat"      calcFunc-hat     950  -1 )
X     ( "tilde"    calcFunc-tilde   950  -1 )
X     ( "vec"      calcFunc-Vec     950  -1 )
X     ( "dyad"     calcFunc-dyad    950  -1 )
X     ( "bar"      calcFunc-bar     950  -1 )
X     ( "under"    calcFunc-under   950  -1 )
X     ( "sub"	  calcFunc-subscr  931 930 )
X     ( "sup"	  ^		   921 920 )
X     ( "sqrt"	  calcFunc-sqrt    -1  910 )
X     ( "over"	  /		   900 901 )
X     ( "u|"       calcFunc-abs	   -1    0 )
X     ( "|"        closing	    0   -1 )
X     ( "left floor"  calcFunc-floor -1   0 )
X     ( "right floor" closing        0   -1 )
X     ( "left ceil"   calcFunc-ceil  -1   0 )
X     ( "right ceil"  closing        0   -1 )
X     ( "+-"	  sdev		   300 300 )
X     ( "!"        calcFunc-fact	   210  -1 )
X     ( "times"    *		   191 190 )
X     ( "*"        *		   191 190 )
X     ( "2x"	  *		   191 190 )
X     ( "/"	  /		   180 181 )
X     ( "%"	  %		   180 181 )
X     ( "+"	  +		   170 171 )
X     ( "-"	  -		   170 171 )
X     ( "<"	  calcFunc-lt	   160 161 )
X     ( ">"	  calcFunc-gt	   160 161 )
X     ( "<="	  calcFunc-leq	   160 161 )
X     ( ">="	  calcFunc-geq	   160 161 )
X     ( "="	  calcFunc-eq	   160 161 )
X     ( "=="	  calcFunc-eq	   160 161 )
X     ( "!="	  calcFunc-neq	   160 161 )
X     ( "u!"       calcFunc-lnot     -1 121 )
X     ( "&&"	  calcFunc-land    110 111 )
X     ( "||"	  calcFunc-lor     100 101 )
X     ( "?"	  (math-read-if)    91  90 )
X     ( "!!!"	  calcFunc-pnot	    -1  85 )
X     ( "&&&"	  calcFunc-pand	    80  81 )
X     ( "|||"	  calcFunc-por	    75  76 )
X     ( "<-"	  calcFunc-assign   51  50 )
X     ( ":="	  calcFunc-assign   51  50 )
X     ( "::"	  calcFunc-condition 45 46 )
X     ( "->"	  calcFunc-evalto   40  41 )
X     ( "->"	  calcFunc-evalto   40  -1 )
X     ( "=>" 	  calcFunc-evalto   40  41 )
X     ( "=>" 	  calcFunc-evalto   40  -1 )
))
X
(put 'eqn 'math-function-table
X  '( ( arc\ cos	   . calcFunc-arccos )
X     ( arc\ cosh   . calcFunc-arccosh )
X     ( arc\ sin	   . calcFunc-arcsin )
X     ( arc\ sinh   . calcFunc-arcsinh )
X     ( arc\ tan	   . calcFunc-arctan )
X     ( arc\ tanh   . calcFunc-arctanh )
X     ( GAMMA	   . calcFunc-gamma )
X     ( phi	   . calcFunc-totient )
X     ( mu	   . calcFunc-moebius )
X     ( matrix	   . (math-parse-eqn-matrix) )
))
X
(put 'eqn 'math-variable-table
X  '( ( inf	   . var-uinf )
))
X
(put 'eqn 'math-complex-format 'i)
X
(defun math-parse-eqn-matrix (f sym)
X  (let ((vec nil))
X    (while (assoc exp-data '(("ccol") ("lcol") ("rcol")))
X      (math-read-token)
X      (or (equal exp-data calc-function-open)
X	  (throw 'syntax "Expected `{'"))
X      (math-read-token)
X      (setq vec (cons (cons 'vec (math-read-expr-list)) vec))
X      (or (equal exp-data calc-function-close)
X	  (throw 'syntax "Expected `}'"))
X      (math-read-token))
X    (or (equal exp-data calc-function-close)
X	(throw 'syntax "Expected `}'"))
X    (math-read-token)
X    (math-transpose (cons 'vec (nreverse vec))))
)
X
(defun math-parse-eqn-prime (x sym)
X  (if (eq (car-safe x) 'var)
X      (if (equal exp-data calc-function-open)
X	  (progn
X	    (math-read-token)
X	    (let ((args (if (or (equal exp-data calc-function-close)
X				(eq exp-token 'end))
X			    nil
X			  (math-read-expr-list))))
X	      (if (not (or (equal exp-data calc-function-close)
X			   (eq exp-token 'end)))
X		  (throw 'syntax "Expected `)'"))
X	      (math-read-token)
X	      (cons (intern (format "calcFunc-%s'" (nth 1 x))) args)))
X	(list 'var
X	      (intern (concat (symbol-name (nth 1 x)) "'"))
X	      (intern (concat (symbol-name (nth 2 x)) "'"))))
X    (list 'calcFunc-Prime x))
)
X
X
(defun calc-mathematica-language ()
X  (interactive)
X  (calc-wrapper
X   (calc-set-language 'math)
X   (message "Mathematica language mode."))
)
X
(put 'math 'math-oper-table
X  '( ( "[["    (math-read-math-subscr) 250 -1 )
X     ( "!"     calcFunc-fact  210 -1 )
X     ( "!!"    calcFunc-dfact 210 -1 )
X     ( "^"     ^	     201 200 )
X     ( "u+"    ident	     -1  197 )
X     ( "u-"    neg	     -1  197 )
X     ( "/"     /	     195 196 )
X     ( "*"     *	     190 191 )
X     ( "2x"    *	     190 191 )
X     ( "+"     +	     180 181 )
X     ( "-"     -	     180 181 )
X     ( "<"     calcFunc-lt   160 161 )
X     ( ">"     calcFunc-gt   160 161 )
X     ( "<="    calcFunc-leq  160 161 )
X     ( ">="    calcFunc-geq  160 161 )
X     ( "=="    calcFunc-eq   150 151 )
X     ( "!="    calcFunc-neq  150 151 )
X     ( "u!"    calcFunc-lnot -1  121 )
X     ( "&&"    calcFunc-land 110 111 )
X     ( "||"    calcFunc-lor  100 101 )
X     ( "!!!"   calcFunc-pnot  -1  85 )
X     ( "&&&"   calcFunc-pand  80  81 )
X     ( "|||"   calcFunc-por   75  76 )
X     ( ":="    calcFunc-assign 51 50 )
X     ( "="     calcFunc-assign 51 50 )
X     ( "->"    calcFunc-assign 51 50 )
X     ( ":>"    calcFunc-assign 51 50 )
X     ( "::"    calcFunc-condition 45 46 )
))
X
(put 'math 'math-function-table
X  '( ( Abs	   . calcFunc-abs )
X     ( ArcCos	   . calcFunc-arccos )
X     ( ArcCosh	   . calcFunc-arccosh )
X     ( ArcSin	   . calcFunc-arcsin )
X     ( ArcSinh	   . calcFunc-arcsinh )
X     ( ArcTan	   . calcFunc-arctan )
X     ( ArcTanh	   . calcFunc-arctanh )
X     ( Arg	   . calcFunc-arg )
X     ( Binomial	   . calcFunc-choose )
X     ( Ceiling	   . calcFunc-ceil )
X     ( Conjugate   . calcFunc-conj )
X     ( Cos	   . calcFunc-cos )
X     ( Cosh	   . calcFunc-cosh )
X     ( D	   . calcFunc-deriv )
X     ( Dt	   . calcFunc-tderiv )
X     ( Det	   . calcFunc-det )
X     ( Exp	   . calcFunc-exp )
X     ( EulerPhi	   . calcFunc-totient )
X     ( Floor	   . calcFunc-floor )
X     ( Gamma	   . calcFunc-gamma )
X     ( GCD	   . calcFunc-gcd )
X     ( If	   . calcFunc-if )
X     ( Im	   . calcFunc-im )
X     ( Inverse	   . calcFunc-inv )
X     ( Integrate   . calcFunc-integ )
X     ( Join	   . calcFunc-vconcat )
X     ( LCM	   . calcFunc-lcm )
X     ( Log	   . calcFunc-ln )
X     ( Max	   . calcFunc-max )
X     ( Min	   . calcFunc-min )
X     ( Mod	   . calcFunc-mod )
X     ( MoebiusMu   . calcFunc-moebius )
X     ( Random	   . calcFunc-random )
X     ( Round	   . calcFunc-round )
X     ( Re	   . calcFunc-re )
X     ( Sign	   . calcFunc-sign )
X     ( Sin	   . calcFunc-sin )
X     ( Sinh	   . calcFunc-sinh )
X     ( Sqrt	   . calcFunc-sqrt )
X     ( Tan	   . calcFunc-tan )
X     ( Tanh	   . calcFunc-tanh )
X     ( Transpose   . calcFunc-trn )
X     ( Length	   . calcFunc-vlen )
))
X
(put 'math 'math-variable-table
X  '( ( I	   . var-i )
X     ( Pi	   . var-pi )
X     ( E	   . var-e )
X     ( GoldenRatio . var-phi )
X     ( EulerGamma  . var-gamma )
X     ( Infinity	   . var-inf )
X     ( ComplexInfinity . var-uinf )
X     ( Indeterminate . var-nan )
))
X
(put 'math 'math-vector-brackets "{}")
(put 'math 'math-complex-format 'I)
(put 'math 'math-function-open "[")
(put 'math 'math-function-close "]")
X
(put 'math 'math-radix-formatter
X     (function (lambda (r s) (format "%d^^%s" r s))))
X
(defun math-read-math-subscr (x op)
X  (let ((idx (math-read-expr-level 0)))
X    (or (and (equal exp-data "]")
X	     (progn
X	       (math-read-token)
X	       (equal exp-data "]")))
X	(throw 'syntax "Expected ']]'"))
X    (math-read-token)
X    (list 'calcFunc-subscr x idx))
)
X
X
(defun calc-maple-language ()
X  (interactive)
X  (calc-wrapper
X   (calc-set-language 'maple)
X   (message "Maple language mode."))
)
X
(put 'maple 'math-oper-table
X  '( ( "matrix" ident	     -1  300 )
X     ( "MATRIX" ident	     -1  300 )
X     ( "!"     calcFunc-fact  210 -1 )
X     ( "^"     ^	     201 200 )
X     ( "**"    ^	     201 200 )
X     ( "u+"    ident	     -1  197 )
X     ( "u-"    neg	     -1  197 )
X     ( "/"     /	     191 192 )
X     ( "*"     *	     191 192 )
X     ( "intersect" calcFunc-vint 191 192 )
X     ( "+"     +	     180 181 )
X     ( "-"     -	     180 181 )
X     ( "union" calcFunc-vunion 180 181 )
X     ( "minus" calcFunc-vdiff 180 181 )
X     ( "mod"   %	     170 170 )
X     ( ".."    calcFunc-mapleintv 165 165 )
X     ( "\\dots" (math-read-maple-dots) 165 165 )
X     ( "<"     calcFunc-lt   160 160 )
X     ( ">"     calcFunc-gt   160 160 )
X     ( "<="    calcFunc-leq  160 160 )
X     ( ">="    calcFunc-geq  160 160 )
X     ( "="     calcFunc-eq   160 160 )
X     ( "<>"    calcFunc-neq  160 160 )
X     ( "not"   calcFunc-lnot -1  121 )
X     ( "and"   calcFunc-land 110 111 )
X     ( "or"    calcFunc-lor  100 101 )
X     ( "!!!"   calcFunc-pnot  -1  85 )
X     ( "&&&"   calcFunc-pand  80  81 )
X     ( "|||"   calcFunc-por   75  76 )
X     ( ":="    calcFunc-assign 51 50 )
X     ( "::"    calcFunc-condition 45 46 )
))
X
(put 'maple 'math-function-table
X  '( ( bernoulli   . calcFunc-bern )
X     ( binomial	   . calcFunc-choose )
X     ( diff	   . calcFunc-deriv )
X     ( GAMMA	   . calcFunc-gamma )
X     ( ifactor	   . calcFunc-prfac )
X     ( igcd 	   . calcFunc-gcd )
X     ( ilcm	   . calcFunc-lcm )
X     ( int  	   . calcFunc-integ )
X     ( modp	   . % )
X     ( irem	   . % )
X     ( iquo	   . calcFunc-idiv )
X     ( isprime	   . calcFunc-prime )
X     ( length	   . calcFunc-vlen )
X     ( member	   . calcFunc-in )
X     ( crossprod   . calcFunc-cross )
X     ( inverse	   . calcFunc-inv )
X     ( trace	   . calcFunc-tr )
X     ( transpose   . calcFunc-trn )
X     ( vectdim	   . calcFunc-vlen )
))
X
(put 'maple 'math-variable-table
X  '( ( I	   . var-i )
X     ( Pi	   . var-pi )
X     ( E	   . var-e )
X     ( infinity	   . var-inf )
X     ( infinity    . var-uinf )
X     ( infinity    . var-nan )
))
X
(put 'maple 'math-complex-format 'I)
X
(defun math-read-maple-dots (x op)
X  (list 'intv 3 x (math-read-expr-level (nth 3 op)))
)
X
X
X
X
X
(defun math-read-big-rec (h1 v1 h2 v2 &optional baseline prec short)
X  (or prec (setq prec 0))
X
X  ;; Clip whitespace above or below.
X  (while (and (< v1 v2) (math-read-big-emptyp h1 v1 h2 (1+ v1)))
X    (setq v1 (1+ v1)))
X  (while (and (< v1 v2) (math-read-big-emptyp h1 (1- v2) h2 v2))
X    (setq v2 (1- v2)))
X
X  ;; If formula is a single line high, normal parser can handle it.
X  (if (<= v2 (1+ v1))
X      (if (or (<= v2 v1)
X	      (> h1 (length (setq v2 (nth v1 lines)))))
X	  (math-read-big-error h1 v1)
X	(setq the-baseline v1
X	      the-h2 h2
X	      v2 (nth v1 lines)
X	      h2 (math-read-expr (substring v2 h1 (min h2 (length v2)))))
X	(if (eq (car-safe h2) 'error)
X	    (math-read-big-error (+ h1 (nth 1 h2)) v1 (nth 2 h2))
X	  h2))
X
X    ;; Clip whitespace at left or right.
X    (while (and (< h1 h2) (math-read-big-emptyp h1 v1 (1+ h1) v2))
X      (setq h1 (1+ h1)))
X    (while (and (< h1 h2) (math-read-big-emptyp (1- h2) v1 h2 v2))
X      (setq h2 (1- h2)))
X
X    ;; Scan to find widest left-justified "----" in the region.
X    (let* ((widest nil)
X	   (widest-h2 0)
X	   (lines-v1 (nthcdr v1 lines))
X	   (p lines-v1)
X	   (v v1)
X	   (other-v nil)
X	   other-char line len h)
X      (while (< v v2)
X	(setq line (car p)
X	      len (min h2 (length line)))
X	(and (< h1 len)
X	     (/= (aref line h1) ?\ )
X	     (if (and (= (aref line h1) ?\-)
X		      ;; Make sure it's not a minus sign.
X		      (or (and (< (1+ h1) len) (= (aref line (1+ h1)) ?\-))
X			  (/= (math-read-big-char h1 (1- v)) ?\ )
X			  (/= (math-read-big-char h1 (1+ v)) ?\ )))
X		 (progn
X		   (setq h h1)
X		   (while (and (< (setq h (1+ h)) len)
X			       (= (aref line h) ?\-)))
X		   (if (> h widest-h2)
X		       (setq widest v
X			     widest-h2 h)))
X	       (or other-v (setq other-v v other-char (aref line h1)))))
X	(setq v (1+ v)
X	      p (cdr p)))
X
X      (cond ((not (setq v other-v))
X	     (math-read-big-error h1 v1))   ; Should never happen!
X
X	    ;; Quotient.
X	    (widest
X	     (setq h widest-h2
X		   v widest)
X	     (let ((num (math-read-big-rec h1 v1 h v))
X		   (den (math-read-big-rec h1 (1+ v) h v2)))
X	       (setq p (if (and (math-integerp num) (math-integerp den))
X			   (math-make-frac num den)
X			 (list '/ num den)))))
X
X	    ;; Big radical sign.
X	    ((= other-char ?\\)
X	     (or (= (math-read-big-char (1+ h1) v) ?\|)
X		 (math-read-big-error (1+ h1) v "Malformed root sign"))
X	     (math-read-big-emptyp h1 v1 (1+ h1) v nil t)
X	     (while (= (math-read-big-char (1+ h1) (setq v (1- v))) ?\|))
X	     (or (= (math-read-big-char (setq h (+ h1 2)) v) ?\_)
X		 (math-read-big-error h v "Malformed root sign"))
X	     (while (= (math-read-big-char (setq h (1+ h)) v) ?\_))
X	     (math-read-big-emptyp h1 v1 (1+ h1) v nil t)
X	     (math-read-big-emptyp h1 (1+ other-v) h v2 nil t)
X	     (setq p (list 'calcFunc-sqrt (math-read-big-rec
X					   (+ h1 2) (1+ v)
X					   h (1+ other-v) baseline))
X		   v the-baseline))
X
X	    ;; Small radical sign.
X	    ((and (= other-char ?V)
X		  (= (math-read-big-char (1+ h1) (1- v)) ?\_))
X	     (setq h (1+ h1))
X	     (math-read-big-emptyp h1 v1 h (1- v) nil t)
X	     (math-read-big-emptyp h1 (1+ v) h v2 nil t)
X	     (math-read-big-emptyp h1 v1 (1+ h1) v nil t)
X	     (while (= (math-read-big-char (setq h (1+ h)) (1- v)) ?\_))
X	     (setq p (list 'calcFunc-sqrt (math-read-big-rec
X					   (1+ h1) v h (1+ v) t))
X		   v the-baseline))
X
X	    ;; Binomial coefficient.
X	    ((and (= other-char ?\()
X		  (= (math-read-big-char (1+ h1) v) ?\ )
X		  (= (string-match "( *)" (nth v lines) h1) h1))
X	     (setq h (match-end 0))
X	     (math-read-big-emptyp h1 v1 (1+ h1) v nil t)
X	     (math-read-big-emptyp h1 (1+ v) (1+ h1) v2 nil t)
X	     (math-read-big-emptyp (1- h) v1 h v nil t)
X	     (math-read-big-emptyp (1- h) (1+ v) h v2 nil t)
X	     (setq p (list 'calcFunc-choose
X			   (math-read-big-rec (1+ h1) v1 (1- h) v)
X			   (math-read-big-rec (1+ h1) (1+ v)
X					      (1- h) v2))))
X
X	    ;; Minus sign.
X	    ((= other-char ?\-)
X	     (setq p (list 'neg (math-read-big-rec (1+ h1) v1 h2 v2 v 250 t))
X		   v the-baseline
X		   h the-h2))
X
X	    ;; Parentheses.
X	    ((= other-char ?\()
X	     (math-read-big-emptyp h1 v1 (1+ h1) v nil t)
X	     (math-read-big-emptyp h1 (1+ v) (1+ h1) v2 nil t)
X	     (setq h (math-read-big-balance (1+ h1) v "(" t))
X	     (math-read-big-emptyp (1- h) v1 h v nil t)
X	     (math-read-big-emptyp (1- h) (1+ v) h v2 nil t)
X	     (let ((sep (math-read-big-char (1- h) v))
X		   hmid)
X	       (if (= sep ?\.)
X		   (setq h (1+ h)))
X	       (if (= sep ?\])
X		   (math-read-big-error (1- h) v "Expected `)'"))
X	       (if (= sep ?\))
X		   (setq p (math-read-big-rec (1+ h1) v1 (1- h) v2 v))
X		 (setq hmid (math-read-big-balance h v "(")
X		       p (list p (math-read-big-rec h v1 (1- hmid) v2 v))
X		       h hmid)
X		 (cond ((= sep ?\.)
X			(setq p (cons 'intv (cons (if (= (math-read-big-char
X							  (1- h) v)
X							 ?\))
X						      0 1)
X						  p))))
X		       ((= (math-read-big-char (1- h) v) ?\])
X			(math-read-big-error (1- h) v "Expected `)'"))
X		       ((= sep ?\,)
X			(or (and (math-realp (car p)) (math-realp (nth 1 p)))
X			    (math-read-big-error
X			     h1 v "Complex components must be real"))
X			(setq p (cons 'cplx p)))
X		       ((= sep ?\;)
X			(or (and (math-realp (car p)) (math-anglep (nth 1 p)))
X			    (math-read-big-error
X			     h1 v "Complex components must be real"))
X			(setq p (cons 'polar p)))))))
X
X	    ;; Matrix.
X	    ((and (= other-char ?\[)
X		  (or (= (math-read-big-char (setq h h1) (1+ v)) ?\[)
X		      (= (math-read-big-char (setq h (1+ h)) v) ?\[)
X		      (and (= (math-read-big-char h v) ?\ )
X			   (= (math-read-big-char (setq h (1+ h)) v) ?\[)))
X		  (= (math-read-big-char h (1+ v)) ?\[))
X	     (math-read-big-emptyp h1 v1 h v nil t)
X	     (let ((vtop v)
X		   (hleft h)
X		   (hright nil))
X	       (setq p nil)
X	       (while (progn
X			(setq h (math-read-big-balance (1+ hleft) v "["))
X			(if hright
X			    (or (= h hright)
X				(math-read-big-error hright v "Expected `]'"))
X			  (setq hright h))
X			(setq p (cons (math-read-big-rec
X				       hleft v h (1+ v)) p))
X			(and (memq (math-read-big-char h v) '(?\  ?\,))
X			     (= (math-read-big-char hleft (1+ v)) ?\[)))
X		 (setq v (1+ v)))
X	       (or (= hleft h1)
X		   (progn
X		     (if (= (math-read-big-char h v) ?\ )
X			 (setq h (1+ h)))
X		     (and (= (math-read-big-char h v) ?\])
X			  (setq h (1+ h))))
X		   (math-read-big-error (1- h) v "Expected `]'"))
X	       (if (= (math-read-big-char h vtop) ?\,)
X		   (setq h (1+ h)))
X	       (math-read-big-emptyp h1 (1+ v) (1- h) v2 nil t)
X	       (setq v (+ vtop (/ (- v vtop) 2))
X		     p (cons 'vec (nreverse p)))))
X
X	    ;; Square brackets.
X	    ((= other-char ?\[)
X	     (math-read-big-emptyp h1 v1 (1+ h1) v nil t)
X	     (math-read-big-emptyp h1 (1+ v) (1+ h1) v2 nil t)
X	     (setq p nil
X		   h (1+ h1))
X	     (while (progn
X		      (setq widest (math-read-big-balance h v "[" t))
X		      (math-read-big-emptyp (1- h) v1 h v nil t)
X		      (math-read-big-emptyp (1- h) (1+ v) h v2 nil t)
X		      (setq p (cons (math-read-big-rec
X				     h v1 (1- widest) v2 v) p)
X			    h widest)
X		      (= (math-read-big-char (1- h) v) ?\,)))
X	     (setq widest (math-read-big-char (1- h) v))
X	     (if (or (memq widest '(?\; ?\)))
X		     (and (eq widest ?\.) (cdr p)))
X		 (math-read-big-error (1- h) v "Expected `]'"))
X	     (if (= widest ?\.)
X		 (setq h (1+ h)
X		       widest (math-read-big-balance h v "[")
X		       p (nconc p (list (math-read-big-big-rec
X					 h v1 (1- widest) v2 v)))
X		       h widest
X		       p (cons 'intv (cons (if (= (math-read-big-char (1- h) v)
X						  ?\])
X					       3 2)
X					   p)))
X	       (setq p (cons 'vec (nreverse p)))))
X
X	    ;; Date form.
X	    ((= other-char ?\<)
X	     (setq line (nth v lines))
X	     (string-match ">" line h1)
X	     (setq h (match-end 0))
X	     (math-read-big-emptyp h1 v1 h v nil t)
X	     (math-read-big-emptyp h1 (1+ v) h v2 nil t)
X	     (setq p (math-read-big-rec h1 v h (1+ v) v)))
X
X	    ;; Variable name or function call.
X	    ((or (and (>= other-char ?a) (<= other-char ?z))
X		 (and (>= other-char ?A) (<= other-char ?Z)))
X	     (setq line (nth v lines))
X	     (string-match "\\([a-zA-Z'_]+\\) *" line h1)
X	     (setq h (match-end 1)
X		   widest (match-end 0)
X		   p (math-match-substring line 1))
X	     (math-read-big-emptyp h1 v1 h v nil t)
X	     (math-read-big-emptyp h1 (1+ v) h v2 nil t)
X	     (if (= (math-read-big-char widest v) ?\()
X		 (progn
X		   (setq line (if (string-match "-" p)
X				  (intern p)
X				(intern (concat "calcFunc-" p)))
X			 h (1+ widest)
X			 p nil)
X		   (math-read-big-emptyp widest v1 h v nil t)
X		   (math-read-big-emptyp widest (1+ v) h v2 nil t)
X		   (while (progn
X			    (setq widest (math-read-big-balance h v "(" t))
X			    (math-read-big-emptyp (1- h) v1 h v nil t)
X			    (math-read-big-emptyp (1- h) (1+ v) h v2 nil t)
X			    (setq p (cons (math-read-big-rec
X					   h v1 (1- widest) v2 v) p)
X				  h widest)
X			    (= (math-read-big-char (1- h) v) ?\,)))
X		   (or (= (math-read-big-char (1- h) v) ?\))
X		       (math-read-big-error (1- h) v "Expected `)'"))
X		   (setq p (cons line (nreverse p))))
X	       (setq p (list 'var
X			     (intern (math-remove-dashes p))
X			     (if (string-match "-" p)
X				 (intern p)
X			       (intern (concat "var-" p)))))))
X
X	    ;; Number.
X	    (t
X	     (setq line (nth v lines))
X	     (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)
X		 (math-read-big-error h v "Expected a number"))
X	     (setq h (match-end 0)
X		   p (math-read-number (math-match-substring line 0)))
X	     (math-read-big-emptyp h1 v1 h v nil t)
X	     (math-read-big-emptyp h1 (1+ v) h v2 nil t)))
X
X      ;; Now left term is bounded by h1, v1, h, v2; baseline = v.
X      (if baseline
X	  (or (= v baseline)
X	      (math-read-big-error h1 v "Inconsistent baseline in formula"))
X	(setq baseline v))
X
X      ;; Look for superscripts or subscripts.
X      (setq line (nth baseline lines)
X	    len (min h2 (length line))
X	    widest h)
X      (while (and (< widest len)
X		  (= (aref line widest) ?\ ))
X	(setq widest (1+ widest)))
X      (and (>= widest len) (setq widest h2))
X      (if (math-read-big-emptyp h v widest v2)
X	  (if (math-read-big-emptyp h v1 widest v)
X	      (setq h widest)
X	    (setq p (list '^ p (math-read-big-rec h v1 widest v))
X		  h widest))
X	  (if (math-read-big-emptyp h v1 widest v)
X	      (setq p (list 'calcFunc-subscr p
X			    (math-read-big-rec h v widest v2))
X		    h widest)))
X
X      ;; Look for an operator name and grab additional terms.
X      (while (and (< h len)
X		  (if (setq widest (and (math-read-big-emptyp
X					 h v1 (1+ h) v)
X					(math-read-big-emptyp
X					 h (1+ v) (1+ h) v2)
X					(string-match "<=\\|>=\\|\\+/-\\|!=\\|&&\\|||\\|:=\\|=>\\|." line h)
X					(assoc (math-match-substring line 0)
X					       math-standard-opers)))
X		      (and (>= (nth 2 widest) prec)
X			   (setq h (match-end 0)))
X		    (and (not (eq (string-match ",\\|;\\|\\.\\.\\|)\\|\\]\\|:" line h)
X				  h))
X			 (setq widest '("2x" * 196 195)))))
X	(cond ((eq (nth 3 widest) -1)
X	       (setq p (list (nth 1 widest) p)))
X	      ((equal (car widest) "?")
X	       (let ((y (math-read-big-rec h v1 h2 v2 baseline nil t)))
X		 (or (= (math-read-big-char the-h2 baseline) ?\:)
X		     (math-read-big-error the-h2 baseline "Expected `:'"))
X		 (setq p (list (nth 1 widest) p y
X			       (math-read-big-rec (1+ the-h2) v1 h2 v2
X						  baseline (nth 3 widest) t))
X		       h the-h2)))
X	      (t
X	       (setq p (list (nth 1 widest) p
X			     (math-read-big-rec h v1 h2 v2
X						baseline (nth 3 widest) t))
X		     h the-h2))))
X
X      ;; Return all relevant information to caller.
X      (setq the-baseline baseline
X	    the-h2 h)
X      (or short (= the-h2 h2)
X	  (math-read-big-error h baseline))
X      p))
)
X
(defun math-read-big-char (h v)
X  (or (and (>= h h1)
X	   (< h h2)
X	   (>= v v1)
X	   (< v v2)
X	   (let ((line (nth v lines)))
X	     (and line
X		  (< h (length line))
X		  (aref line h))))
X      ?\ )
)
X
(defun math-read-big-emptyp (eh1 ev1 eh2 ev2 &optional what error)
X  (and (< ev1 v1) (setq ev1 v1))
X  (and (< eh1 h1) (setq eh1 h1))
X  (and (> ev2 v2) (setq ev2 v2))
X  (and (> eh2 h2) (setq eh2 h2))
X  (or what (setq what ?\ ))
X  (let ((p (nthcdr ev1 lines))
X	h)
X    (while (and (< ev1 ev2)
X		(progn
X		  (setq h (min eh2 (length (car p))))
X		  (while (and (>= (setq h (1- h)) eh1)
X			      (= (aref (car p) h) what)))
X		  (and error (>= h eh1)
X		       (math-read-big-error h ev1 (if (stringp error)
X						      error
X						    "Whitespace expected")))
X		  (< h eh1)))
X      (setq ev1 (1+ ev1)
X	    p (cdr p)))
X    (>= ev1 ev2))
)
X
(defun math-read-big-error (h v &optional msg)
X  (let ((pos 0)
X	(p lines))
X    (while (> v 0)
X      (setq pos (+ pos 1 (length (car p)))
X	    p (cdr p)
X	    v (1- v)))
X    (setq h (+ pos (min h (length (car p))))
X	  err-msg (list 'error h (or msg "Syntax error")))
X    (throw 'syntax nil))
)
X
(defun math-read-big-balance (h v what &optional commas)
X  (let* ((line (nth v lines))
X	 (len (min h2 (length line)))
X	 (count 1))
X    (while (> count 0)
X      (if (>= h len)
X	  (if what
X	      (math-read-big-error h1 v (format "Unmatched `%s'" what))
X	    (setq count 0))
X	(if (memq (aref line h) '(?\( ?\[))
X	    (setq count (1+ count))
X	  (if (if (and commas (= count 1))
X		  (or (memq (aref line h) '(?\) ?\] ?\, ?\;))
X		      (and (eq (aref line h) ?\.)
X			   (< (1+ h) len)
X			   (eq (aref line (1+ h)) ?\.)))
X		(memq (aref line h) '(?\) ?\])))
X	      (setq count (1- count))))
X	(setq h (1+ h))))
X    h)
)
X
X
X
X
SHAR_EOF
chmod 0644 calc-lang.el ||
echo 'restore of calc-lang.el failed'
Wc_c="`wc -c < 'calc-lang.el'`"
test 36543 -eq "$Wc_c" ||
	echo 'calc-lang.el: original size 36543, current size' "$Wc_c"
rm -f _shar_wnt_.tmp
fi
# ============= calc-macs.el ==============
if test -f 'calc-macs.el' -a X"$1" != X"-c"; then
	echo 'x - skipping calc-macs.el (File already exists)'
	rm -f _shar_wnt_.tmp
else
> _shar_wnt_.tmp
echo 'x - extracting calc-macs.el (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'calc-macs.el' &&
;; Calculator for GNU Emacs, part I [calc-macs.el]
;; Copyright (C) 1990, 1991 Free Software Foundation, Inc.
;; Written by Dave Gillespie, daveg@csvax.cs.caltech.edu.
X
;; This file is part of GNU Emacs.
X
;; 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.
X
;; 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.
X
X
(provide 'calc-macs)
X
(defun calc-need-macros () nil)
X
X
(defmacro calc-record-compilation-date-macro ()
X  (` (setq calc-installed-date (, (concat (current-time-string)
X					  " by "
X					  (user-full-name)))))
)
X
X
(defmacro calc-wrapper (&rest body)
X  (list 'calc-do (list 'function (append (list 'lambda ()) body)))
)
X
;; We use "point" here to generate slightly smaller byte-code than "t".
(defmacro calc-slow-wrapper (&rest body)
X  (list 'calc-do (list 'function (append (list 'lambda ()) body)) (point))
)
X
X
(defmacro math-showing-full-precision (body)
X  (list 'let
X	'((calc-float-format calc-full-float-format))
X	body)
)
X
X
(defmacro math-with-extra-prec (delta &rest body)
X  (` (math-normalize
X      (let ((calc-internal-prec (+ calc-internal-prec (, delta))))
X	(,@ body))))
)
X
X
;;; Faster in-line version zerop, normalized values only.
(defmacro Math-zerop (a)   ; [P N]
X  (` (if (consp (, a))
X	 (and (not (memq (car (, a)) '(bigpos bigneg)))
X	      (if (eq (car (, a)) 'float)
X		  (eq (nth 1 (, a)) 0)
X		(math-zerop (, a))))
X       (eq (, a) 0)))
)
X
(defmacro Math-integer-negp (a)
X  (` (if (consp (, a))
X	 (eq (car (, a)) 'bigneg)
X       (< (, a) 0)))
)
X
(defmacro Math-integer-posp (a)
X  (` (if (consp (, a))
X	 (eq (car (, a)) 'bigpos)
X       (> (, a) 0)))
)
X
X
(defmacro Math-negp (a)
X  (` (if (consp (, a))
X	 (or (eq (car (, a)) 'bigneg)
X	     (and (not (eq (car (, a)) 'bigpos))
X		  (if (memq (car (, a)) '(frac float))
X		      (Math-integer-negp (nth 1 (, a)))
X		    (math-negp (, a)))))
X       (< (, a) 0)))
)
X
X
(defmacro Math-looks-negp (a)   ; [P x] [Public]
X  (` (or (Math-negp (, a))
X	 (and (consp (, a)) (or (eq (car (, a)) 'neg)
X				(and (memq (car (, a)) '(* /))
X				     (or (math-looks-negp (nth 1 (, a)))
X					 (math-looks-negp (nth 2 (, a)))))))))
)
X
X
(defmacro Math-posp (a)
X  (` (if (consp (, a))
X	 (or (eq (car (, a)) 'bigpos)
X	     (and (not (eq (car (, a)) 'bigneg))
X		  (if (memq (car (, a)) '(frac float))
X		      (Math-integer-posp (nth 1 (, a)))
X		    (math-posp (, a)))))
X       (> (, a) 0)))
)
X
X
(defmacro Math-integerp (a)
X  (` (or (not (consp (, a)))
X	 (memq (car (, a)) '(bigpos bigneg))))
)
X
X
(defmacro Math-natnump (a)
X  (` (if (consp (, a))
X	 (eq (car (, a)) 'bigpos)
X       (>= (, a) 0)))
)
X
(defmacro Math-ratp (a)
X  (` (or (not (consp (, a)))
X	 (memq (car (, a)) '(bigpos bigneg frac))))
)
X
(defmacro Math-realp (a)
X  (` (or (not (consp (, a)))
X	 (memq (car (, a)) '(bigpos bigneg frac float))))
)
X
(defmacro Math-anglep (a)
X  (` (or (not (consp (, a)))
X	 (memq (car (, a)) '(bigpos bigneg frac float hms))))
)
X
(defmacro Math-numberp (a)
X  (` (or (not (consp (, a)))
X	 (memq (car (, a)) '(bigpos bigneg frac float cplx polar))))
)
X
(defmacro Math-scalarp (a)
X  (` (or (not (consp (, a)))
X	 (memq (car (, a)) '(bigpos bigneg frac float cplx polar hms))))
)
X
(defmacro Math-vectorp (a)
X  (` (and (consp (, a)) (eq (car (, a)) 'vec)))
)
X
(defmacro Math-messy-integerp (a)
X  (` (and (consp (, a))
X	  (eq (car (, a)) 'float)
X	  (>= (nth 2 (, a)) 0)))
)
X
(defmacro Math-objectp (a)    ;  [Public]
X  (` (or (not (consp (, a)))
X	 (memq (car (, a))
X	       '(bigpos bigneg frac float cplx polar hms date sdev intv mod))))
)
X
(defmacro Math-objvecp (a)    ;  [Public]
X  (` (or (not (consp (, a)))
X	 (memq (car (, a))
X	       '(bigpos bigneg frac float cplx polar hms date
X			sdev intv mod vec))))
)
X
X
;;; Compute the negative of A.  [O O; o o] [Public]
(defmacro Math-integer-neg (a)
X  (` (if (consp (, a))
X	 (if (eq (car (, a)) 'bigpos)
X	     (cons 'bigneg (cdr (, a)))
X	   (cons 'bigpos (cdr (, a))))
X       (- (, a))))
)
X
X
(defmacro Math-equal (a b)
X  (` (= (math-compare (, a) (, b)) 0))
)
X
(defmacro Math-lessp (a b)
X  (` (= (math-compare (, a) (, b)) -1))
)
X
X
(defmacro math-working (msg arg)    ; [Public]
X  (` (if (eq calc-display-working-message 'lots)
X	 (math-do-working (, msg) (, arg))))
)
X
X
(defmacro calc-with-default-simplification (body)
X  (list 'let
X	'((calc-simplify-mode (and (not (memq calc-simplify-mode '(none num)))
X				   calc-simplify-mode)))
X	body)
)
X
X
(defmacro Math-primp (a)
X  (` (or (not (consp (, a)))
X	 (memq (car (, a)) '(bigpos bigneg frac float cplx polar
X				    hms date mod var))))
)
X
X
(defmacro calc-with-trail-buffer (&rest body)
X  (` (let ((save-buf (current-buffer))
X	   (calc-command-flags nil))
X       (unwind-protect
X	   (, (append '(progn
X			 (set-buffer (calc-trail-display t))
X			 (goto-char calc-trail-pointer))
X		      body))
X	 (set-buffer save-buf))))
)
X
X
(defmacro Math-num-integerp (a)
X  (` (or (not (consp (, a)))
X	 (memq (car (, a)) '(bigpos bigneg))
X	 (and (eq (car (, a)) 'float)
X	      (>= (nth 2 (, a)) 0))))
)
X
X
(defmacro Math-bignum-test (a)   ; [B N; B s; b b]
X  (` (if (consp (, a))
X	 (, a)
X       (math-bignum (, a))))
)
X
X
(defmacro Math-equal-int (a b)
X  (` (or (eq (, a) (, b))
X	 (and (consp (, a))
X	      (eq (car (, a)) 'float)
X	      (eq (nth 1 (, a)) (, b))
X	      (= (nth 2 (, a)) 0))))
)
X
(defmacro Math-natnum-lessp (a b)
X  (` (if (consp (, a))
X	 (and (consp (, b))
X	      (= (math-compare-bignum (cdr (, a)) (cdr (, b))) -1))
X       (or (consp (, b))
X	   (< (, a) (, b)))))
)
X
X
(defmacro math-format-radix-digit (a)   ; [X D]
X  (` (aref math-radix-digits (, a)))
)
X
X
SHAR_EOF
chmod 0644 calc-macs.el ||
echo 'restore of calc-macs.el failed'
Wc_c="`wc -c < 'calc-macs.el'`"
test 6182 -eq "$Wc_c" ||
	echo 'calc-macs.el: original size 6182, current size' "$Wc_c"
rm -f _shar_wnt_.tmp
fi
# ============= calc-maint.el ==============
if test -f 'calc-maint.el' -a X"$1" != X"-c"; then
	echo 'x - skipping calc-maint.el (File already exists)'
	rm -f _shar_wnt_.tmp
else
> _shar_wnt_.tmp
echo 'x - extracting calc-maint.el (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'calc-maint.el' &&
;; Calculator for GNU Emacs, maintenance routines
;; Copyright (C) 1990, 1991 Free Software Foundation, Inc.
;; Written by Dave Gillespie, daveg@csvax.cs.caltech.edu.
X
;; This file is part of GNU Emacs.
X
;; 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.
X
;; 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.
X
X
X
X
(defun calc-compile ()
X  "Compile all parts of Calc.
Unix usage:
X     emacs -batch -l calc-maint -f calc-compile"
X  (interactive)
X  (if (equal (user-full-name) "David Gillespie")
X      (load "~/lisp/newbytecomp"))
X  (setq byte-compile-verbose t)
X  (if noninteractive
X      (let ((old-message (symbol-function 'message))
X	    (old-write-region (symbol-function 'write-region))
X	    (comp-was-func nil)
X	    (comp-len 0))
X	(unwind-protect
X	    (progn
X	      (fset 'message (symbol-function 'calc-compile-message))
X	      (fset 'write-region (symbol-function 'calc-compile-write-region))
X	      (calc-do-compile))
X	  (fset 'message old-message)
X	  (fset 'write-region old-write-region)))
X    (calc-do-compile))
)
X
(defun calc-do-compile ()
X  (let ((make-backup-files nil)
X	(changed-rules nil)
X	(changed-units nil)
X	(message-bug (string-match "^18.\\([0-4][0-9]\\|5[0-6]\\)"
X				   emacs-version)))
X    (setq max-lisp-eval-depth (max 400 max-lisp-eval-depth))
X
X    ;; Make sure we're in the right directory.
X    (find-file "calc.el")
X    (if (= (buffer-size) 0)
X	(error "This command must be used in the Calc source directory."))
X
X    ;; Make sure current directory is in load-path.
X    (setq load-path (cons default-directory load-path))
X    (load "calc-macs.el" nil t t)
X    (provide 'calc)
X    (provide 'calc-ext)
X
X    ;; Compile all the source files.
X    (let ((files (append
X		  '("calc.el" "calc-ext.el")
X		  (sort (directory-files
X			 default-directory nil
X			 "\\`\\(calc-.[^x].*\\|macedit\\)\\.el\\'")
X			'string<))))
X      (while files
X	(if (file-newer-than-file-p (car files) (concat (car files) "c"))
X	    (progn
X	      (if (string-match "calc-rules" (car files))
X		  (setq changed-rules t))
X	      (if (string-match "calc-units" (car files))
X		  (setq changed-units t))
X	      (or message-bug (message ""))
X	      (byte-compile-file (car files)))
X	  (message "File %s is up to date." (car files)))
X	(if (string-match "calc\\(-ext\\)?.el" (car files))
X	    (load (concat (car files) "c") nil t t))
X	(setq files (cdr files))))
X
X    (if (or changed-units changed-rules)
X	(condition-case err
X	    (progn
X
X	      ;; Pre-build the units table.
X	      (if changed-units
X		  (progn
X		    (or message-bug (message ""))
X		    (save-excursion
X		      (calc-create-buffer)
X		      (math-build-units-table))
X		    (find-file "calc-units.elc")
X		    (goto-char (point-max))
X		    (insert "\n(setq math-units-table '"
X			    (prin1-to-string math-units-table)
X			    ")\n")
X		    (save-buffer)))
X
X	      ;; Pre-build rewrite rules for j D, j M, etc.
X	      (if changed-rules
X		  (let ((rules nil))
X		    (or message-bug (message ""))
X		    (find-file "calc-rules.elc")
X		    (goto-char (point-min))
X		    (while (re-search-forward "defun calc-\\([A-Za-z]*Rules\\)"
X					      nil t)
X		      (setq rules (cons (buffer-substring (match-beginning 1)
X							  (match-end 1))
X					rules)))
X		    (goto-char (point-min))
X		    (re-search-forward "\n(defun calc-[A-Za-z]*Rules")
X		    (beginning-of-line)
X		    (delete-region (point) (point-max))
X		    (mapcar (function
X			     (lambda (v)
X			       (let* ((vv (intern (concat "var-" v)))
X				      (val (save-excursion
X					     (calc-create-buffer)
X					     (calc-var-value vv))))
X				 (insert "\n(defun calc-" v " () '"
X					 (prin1-to-string val) ")\n"))))
X			    (sort rules 'string<))
X		    (save-buffer))))
X	  (error (message "Unable to pre-build tables %s" err))))
X    (message "Done.  Don't forget to install with \"make public\" or \"make private\"."))
)
X
(defun calc-compile-message (fmt &rest args)
X  (cond ((and (= (length args) 2)
X	      (stringp (car args))
X	      (string-match ".elc?\\'" (car args))
X	      (symbolp (nth 1 args)))
X	 (let ((name (symbol-name (nth 1 args))))
X	   (princ (if comp-was-func ", " "  "))
X	   (if (and comp-was-func (eq (string-match comp-was-func name) 0))
X	       (setq name (substring name (1- (length comp-was-func))))
X	     (setq comp-was-func (if (string-match "\\`[a-zA-Z]+-" name)
X				     (substring name 0 (match-end 0))
X				   " ")))
X	   (if (> (+ comp-len (length name)) 75)
X	       (progn
X		 (princ "\n  ")
X		 (setq comp-len 0)))
X	   (princ name)
X	   (send-string-to-terminal "")  ; cause an fflush(stdout)
X	   (setq comp-len (+ comp-len 2 (length name)))))
X	((and (setq comp-was-func nil
X		    comp-len 0)
X	      (= (length args) 1)
X	      (stringp (car args))
X	      (string-match ".elc?\\'" (car args)))
X	 (or (string-match "Saving file %s..." fmt)
X	     (funcall old-message fmt (file-name-nondirectory (car args)))))
X	((string-match "\\(Preparing\\|Building\\).*\\.\\.\\.$" fmt)
X	 (send-string-to-terminal (apply 'format fmt args)))
X	((string-match "\\(Preparing\\|Building\\).*\\.\\.\\. *done$" fmt)
X	 (send-string-to-terminal "done\n"))
X	(t (apply old-message fmt args)))
)
X
(defun calc-compile-write-region (start end filename &optional append visit)
X  (if (eq visit t)
X      (set-buffer-auto-saved))
X  (if (and (string-match "\\.elc" filename)
X	   (= start (point-min))
X	   (= end (point-max)))
X      (save-excursion
X	(goto-char (point-min))
X	(if (search-forward "\n(require (quote calc-macs))\n" nil t)
X	    (replace-match ""))
X	(setq end (point-max))))
X  (funcall old-write-region start end filename append 'quietly)
X  (message "Wrote %s" filename)
X  nil
)
X
X
X
(defun calc-split-manual (&optional force)
X  "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
X        M-x calc-split-manual RET"
X  (interactive "P")
X  (or (let ((case-fold-search t))
X	(string-match "calc\\.texinfo" (buffer-name)))
X      force
X      (error "This command should be used in the calc.texinfo buffer."))
X  (let ((srcbuf (current-buffer))
X	tutpos refpos endpos (maxpos (point-max)))
X    (goto-char 1)
X    (search-forward "@c [tutorial]")
SHAR_EOF
true || echo 'restore of calc-maint.el failed'
fi
echo 'End of  part 19'
echo 'File calc-maint.el is continued in part 20'
echo 20 > _shar_seq_.tmp
exit 0
exit 0 # Just in case...
-- 
Kent Landfield                   INTERNET: kent@sparky.IMD.Sterling.COM
Sterling Software, IMD           UUCP:     uunet!sparky!kent
Phone:    (402) 291-8300         FAX:      (402) 291-4362
Please send comp.sources.misc-related mail to kent@uunet.uu.net.