home *** CD-ROM | disk | FTP | other *** search
Wrap
Text File | 1991-10-31 | 55.3 KB | 1,776 lines
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.