cgit.sxemacs.org Git - packages/blob - xemacs-packages/calc/calc-lang.el

   1 ;; Calculator for GNU Emacs, part II [calc-lang.el]
   2 ;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc.
   3 ;; Written by Dave Gillespie, daveg@synaptics.com.
   4
   5 ;; This file is part of GNU Emacs.
   6
   7 ;; GNU Emacs is distributed in the hope that it will be useful,
   8 ;; but WITHOUT ANY WARRANTY.  No author or distributor
   9 ;; accepts responsibility to anyone for the consequences of using it
  10 ;; or for whether it serves any particular purpose or works at all,
  11 ;; unless he says so in writing.  Refer to the GNU Emacs General Public
  12 ;; License for full details.
  13
  14 ;; Everyone is granted permission to copy, modify and redistribute
  15 ;; GNU Emacs, but only under the conditions described in the
  16 ;; GNU Emacs General Public License.   A copy of this license is
  17 ;; supposed to have been given to you along with GNU Emacs so you
  18 ;; can know your rights and responsibilities.  It should be in a
  19 ;; file named COPYING.  Among other things, the copyright notice
  20 ;; and this notice must be preserved on all copies.
  21
  22
  23
  24 ;; This file is autoloaded from calc-ext.el.
  25 (require 'calc-ext)
  26
  27 (require 'calc-macs)
  28
  29 (defun calc-Need-calc-lang () nil)
  30
  31
  32 ;;; Alternate entry/display languages.
  33
  34 (defun calc-set-language (lang &optional option no-refresh)
  35   (setq math-expr-opers (or (get lang 'math-oper-table) math-standard-opers)
  36         math-expr-function-mapping (get lang 'math-function-table)
  37         math-expr-variable-mapping (get lang 'math-variable-table)
  38         calc-language-input-filter (get lang 'math-input-filter)
  39         calc-language-output-filter (get lang 'math-output-filter)
  40         calc-vector-brackets (or (get lang 'math-vector-brackets) "[]")
  41         calc-complex-format (get lang 'math-complex-format)
  42         calc-radix-formatter (get lang 'math-radix-formatter)
  43         calc-function-open (or (get lang 'math-function-open) "(")
  44         calc-function-close (or (get lang 'math-function-close) ")"))
  45   (if no-refresh
  46       (setq calc-language lang
  47             calc-language-option option)
  48     (calc-change-mode '(calc-language calc-language-option)
  49                       (list lang option) t))
  50 )
  51
  52 (defun calc-normal-language ()
  53   (interactive)
  54   (calc-wrapper
  55    (calc-set-language nil)
  56    (message "Normal language mode."))
  57 )
  58
  59 (defun calc-flat-language ()
  60   (interactive)
  61   (calc-wrapper
  62    (calc-set-language 'flat)
  63    (message "Flat language mode (all stack entries shown on one line)."))
  64 )
  65
  66 (defun calc-big-language ()
  67   (interactive)
  68   (calc-wrapper
  69    (calc-set-language 'big)
  70    (message "\"Big\" language mode."))
  71 )
  72
  73 (defun calc-unformatted-language ()
  74   (interactive)
  75   (calc-wrapper
  76    (calc-set-language 'unform)
  77    (message "Unformatted language mode."))
  78 )
  79
  80
  81 (defun calc-c-language ()
  82   (interactive)
  83   (calc-wrapper
  84    (calc-set-language 'c)
  85    (message "`C' language mode."))
  86 )
  87
  88 (put 'c 'math-oper-table
  89   '( ( "u+"    ident         -1 1000 )
  90      ( "u-"    neg           -1 1000 )
  91      ( "u!"    calcFunc-lnot -1 1000 )
  92      ( "~"     calcFunc-not  -1 1000 )
  93      ( "*"     *             190 191 )
  94      ( "/"     /             190 191 )
  95      ( "%"     %             190 191 )
  96      ( "+"     +             180 181 )
  97      ( "-"     -             180 181 )
  98      ( "<<"    calcFunc-lsh  170 171 )
  99      ( ">>"    calcFunc-rsh  170 171 )
 100      ( "<"     calcFunc-lt   160 161 )
 101      ( ">"     calcFunc-gt   160 161 )
 102      ( "<="    calcFunc-leq  160 161 )
 103      ( ">="    calcFunc-geq  160 161 )
 104      ( "=="    calcFunc-eq   150 151 )
 105      ( "!="    calcFunc-neq  150 151 )
 106      ( "&"     calcFunc-and  140 141 )
 107      ( "^"     calcFunc-xor  131 130 )
 108      ( "|"     calcFunc-or   120 121 )
 109      ( "&&"    calcFunc-land 110 111 )
 110      ( "||"    calcFunc-lor  100 101 )
 111      ( "?"     (math-read-if)  91  90 )
 112      ( "!!!"   calcFunc-pnot  -1  88 )
 113      ( "&&&"   calcFunc-pand  85  86 )
 114      ( "|||"   calcFunc-por   75  76 )
 115      ( "="     calcFunc-assign 51 50 )
 116      ( ":="    calcFunc-assign 51 50 )
 117      ( "::"    calcFunc-condition 45 46 )
 118 )) ; should support full assignments
 119
 120 (put 'c 'math-function-table
 121   '( ( acos        . calcFunc-arccos )
 122      ( acosh       . calcFunc-arccosh )
 123      ( asin        . calcFunc-arcsin )
 124      ( asinh       . calcFunc-arcsinh )
 125      ( atan        . calcFunc-arctan )
 126      ( atan2       . calcFunc-arctan2 )
 127      ( atanh       . calcFunc-arctanh )
 128 ))
 129
 130 (put 'c 'math-variable-table
 131   '( ( M_PI        . var-pi )
 132      ( M_E         . var-e )
 133 ))
 134
 135 (put 'c 'math-vector-brackets "{}")
 136
 137 (put 'c 'math-radix-formatter
 138      (function (lambda (r s)
 139                  (if (= r 16) (format "0x%s" s)
 140                    (if (= r 8) (format "0%s" s)
 141                      (format "%d#%s" r s))))))
 142
 143
 144 (defun calc-pascal-language (n)
 145   (interactive "P")
 146   (calc-wrapper
 147    (and n (setq n (prefix-numeric-value n)))
 148    (calc-set-language 'pascal n)
 149    (message (if (and n (/= n 0))
 150                 (if (> n 0)
 151                     "Pascal language mode (all uppercase)."
 152                   "Pascal language mode (all lowercase).")
 153               "Pascal language mode.")))
 154 )
 155
 156 (put 'pascal 'math-oper-table
 157   '( ( "not"   calcFunc-lnot -1 1000 )
 158      ( "*"     *             190 191 )
 159      ( "/"     /             190 191 )
 160      ( "and"   calcFunc-and  190 191 )
 161      ( "div"   calcFunc-idiv 190 191 )
 162      ( "mod"   %             190 191 )
 163      ( "u+"    ident         -1  185 )
 164      ( "u-"    neg           -1  185 )
 165      ( "+"     +             180 181 )
 166      ( "-"     -             180 181 )
 167      ( "or"    calcFunc-or   180 181 )
 168      ( "xor"   calcFunc-xor  180 181 )
 169      ( "shl"   calcFunc-lsh  180 181 )
 170      ( "shr"   calcFunc-rsh  180 181 )
 171      ( "in"    calcFunc-in   160 161 )
 172      ( "<"     calcFunc-lt   160 161 )
 173      ( ">"     calcFunc-gt   160 161 )
 174      ( "<="    calcFunc-leq  160 161 )
 175      ( ">="    calcFunc-geq  160 161 )
 176      ( "="     calcFunc-eq   160 161 )
 177      ( "<>"    calcFunc-neq  160 161 )
 178      ( "!!!"   calcFunc-pnot  -1  85 )
 179      ( "&&&"   calcFunc-pand  80  81 )
 180      ( "|||"   calcFunc-por   75  76 )
 181      ( ":="    calcFunc-assign 51 50 )
 182      ( "::"    calcFunc-condition 45 46 )
 183 ))
 184
 185 (put 'pascal 'math-input-filter 'calc-input-case-filter)
 186 (put 'pascal 'math-output-filter 'calc-output-case-filter)
 187
 188 (put 'pascal 'math-radix-formatter
 189      (function (lambda (r s)
 190                  (if (= r 16) (format "$%s" s)
 191                    (format "%d#%s" r s)))))
 192
 193 (defun calc-input-case-filter (str)
 194   (cond ((or (null calc-language-option) (= calc-language-option 0))
 195          str)
 196         (t
 197          (downcase str)))
 198 )
 199
 200 (defun calc-output-case-filter (str)
 201   (cond ((or (null calc-language-option) (= calc-language-option 0))
 202          str)
 203         ((> calc-language-option 0)
 204          (upcase str))
 205         (t
 206          (downcase str)))
 207 )
 208
 209
 210 (defun calc-fortran-language (n)
 211   (interactive "P")
 212   (calc-wrapper
 213    (and n (setq n (prefix-numeric-value n)))
 214    (calc-set-language 'fortran n)
 215    (message (if (and n (/= n 0))
 216                 (if (> n 0)
 217                     "FORTRAN language mode (all uppercase)."
 218                   "FORTRAN language mode (all lowercase).")
 219               "FORTRAN language mode.")))
 220 )
 221
 222 (put 'fortran 'math-oper-table
 223   '( ( "u/"    (math-parse-fortran-vector) -1 1 )
 224      ( "/"     (math-parse-fortran-vector-end) 1 -1 )
 225      ( "**"    ^             201 200 )
 226      ( "u+"    ident         -1  191 )
 227      ( "u-"    neg           -1  191 )
 228      ( "*"     *             190 191 )
 229      ( "/"     /             190 191 )
 230      ( "+"     +             180 181 )
 231      ( "-"     -             180 181 )
 232      ( ".LT."  calcFunc-lt   160 161 )
 233      ( ".GT."  calcFunc-gt   160 161 )
 234      ( ".LE."  calcFunc-leq  160 161 )
 235      ( ".GE."  calcFunc-geq  160 161 )
 236      ( ".EQ."  calcFunc-eq   160 161 )
 237      ( ".NE."  calcFunc-neq  160 161 )
 238      ( ".NOT." calcFunc-lnot -1  121 )
 239      ( ".AND." calcFunc-land 110 111 )
 240      ( ".OR."  calcFunc-lor  100 101 )
 241      ( "!!!"   calcFunc-pnot  -1  85 )
 242      ( "&&&"   calcFunc-pand  80  81 )
 243      ( "|||"   calcFunc-por   75  76 )
 244      ( "="     calcFunc-assign 51 50 )
 245      ( ":="    calcFunc-assign 51 50 )
 246      ( "::"    calcFunc-condition 45 46 )
 247 ))
 248
 249 (put 'fortran 'math-vector-brackets "//")
 250
 251 (put 'fortran 'math-function-table
 252   '( ( acos        . calcFunc-arccos )
 253      ( acosh       . calcFunc-arccosh )
 254      ( aimag       . calcFunc-im )
 255      ( aint        . calcFunc-ftrunc )
 256      ( asin        . calcFunc-arcsin )
 257      ( asinh       . calcFunc-arcsinh )
 258      ( atan        . calcFunc-arctan )
 259      ( atan2       . calcFunc-arctan2 )
 260      ( atanh       . calcFunc-arctanh )
 261      ( conjg       . calcFunc-conj )
 262      ( log         . calcFunc-ln )
 263      ( nint        . calcFunc-round )
 264      ( real        . calcFunc-re )
 265 ))
 266
 267 (put 'fortran 'math-input-filter 'calc-input-case-filter)
 268 (put 'fortran 'math-output-filter 'calc-output-case-filter)
 269
 270 (defun math-parse-fortran-vector (op)
 271   (let ((math-parsing-fortran-vector '(end . "\000")))
 272     (prog1
 273         (math-read-brackets t "]")
 274       (setq exp-token (car math-parsing-fortran-vector)
 275             exp-data (cdr math-parsing-fortran-vector))))
 276 )
 277
 278 (defun math-parse-fortran-vector-end (x op)
 279   (if math-parsing-fortran-vector
 280       (progn
 281         (setq math-parsing-fortran-vector (cons exp-token exp-data)
 282               exp-token 'end
 283               exp-data "\000")
 284         x)
 285     (throw 'syntax "Unmatched closing `/'"))
 286 )
 287 (setq math-parsing-fortran-vector nil)
 288
 289 (defun math-parse-fortran-subscr (sym args)
 290   (setq sym (math-build-var-name sym))
 291   (while args
 292     (setq sym (list 'calcFunc-subscr sym (car args))
 293           args (cdr args)))
 294   sym
 295 )
 296
 297
 298 (defun calc-tex-language (n)
 299   (interactive "P")
 300   (calc-wrapper
 301    (and n (setq n (prefix-numeric-value n)))
 302    (calc-set-language 'tex n)
 303    (message (if (and n (/= n 0))
 304                 (if (> n 0)
 305                     "TeX language mode with \\hbox{func}(\\hbox{var})."
 306                   "TeX language mode with \\func{\\hbox{var}}.")
 307               "TeX language mode.")))
 308 )
 309
 310 (put 'tex 'math-oper-table
 311   '( ( "u+"       ident            -1 1000 )
 312      ( "u-"       neg              -1 1000 )
 313      ( "\\hat"    calcFunc-hat     -1  950 )
 314      ( "\\check"  calcFunc-check   -1  950 )
 315      ( "\\tilde"  calcFunc-tilde   -1  950 )
 316      ( "\\acute"  calcFunc-acute   -1  950 )
 317      ( "\\grave"  calcFunc-grave   -1  950 )
 318      ( "\\dot"    calcFunc-dot     -1  950 )
 319      ( "\\ddot"   calcFunc-dotdot  -1  950 )
 320      ( "\\breve"  calcFunc-breve   -1  950 )
 321      ( "\\bar"    calcFunc-bar     -1  950 )
 322      ( "\\vec"    calcFunc-Vec     -1  950 )
 323      ( "\\underline" calcFunc-under -1  950 )
 324      ( "u|"       calcFunc-abs     -1    0 )
 325      ( "|"        closing           0   -1 )
 326      ( "\\lfloor" calcFunc-floor   -1    0 )
 327      ( "\\rfloor" closing           0   -1 )
 328      ( "\\lceil"  calcFunc-ceil    -1    0 )
 329      ( "\\rceil"  closing           0   -1 )
 330      ( "\\pm"     sdev             300 300 )
 331      ( "!"        calcFunc-fact    210  -1 )
 332      ( "^"        ^                201 200 )
 333      ( "_"        calcFunc-subscr  201 200 )
 334      ( "\\times"  *                191 190 )
 335      ( "*"        *                191 190 )
 336      ( "2x"       *                191 190 )
 337      ( "+"        +                180 181 )
 338      ( "-"        -                180 181 )
 339      ( "\\over"   /                170 171 )
 340      ( "/"        /                170 171 )
 341      ( "\\choose" calcFunc-choose  170 171 )
 342      ( "\\mod"    %                170 171 )
 343      ( "<"        calcFunc-lt      160 161 )
 344      ( ">"        calcFunc-gt      160 161 )
 345      ( "\\leq"    calcFunc-leq     160 161 )
 346      ( "\\geq"    calcFunc-geq     160 161 )
 347      ( "="        calcFunc-eq      160 161 )
 348      ( "\\neq"    calcFunc-neq     160 161 )
 349      ( "\\ne"     calcFunc-neq     160 161 )
 350      ( "\\lnot"   calcFunc-lnot     -1 121 )
 351      ( "\\land"   calcFunc-land    110 111 )
 352      ( "\\lor"    calcFunc-lor     100 101 )
 353      ( "?"        (math-read-if)    91  90 )
 354      ( "!!!"      calcFunc-pnot     -1  85 )
 355      ( "&&&"      calcFunc-pand     80  81 )
 356      ( "|||"      calcFunc-por      75  76 )
 357      ( "\\gets"   calcFunc-assign   51  50 )
 358      ( ":="       calcFunc-assign   51  50 )
 359      ( "::"       calcFunc-condition 45 46 )
 360      ( "\\to"     calcFunc-evalto   40  41 )
 361      ( "\\to"     calcFunc-evalto   40  -1 )
 362      ( "=>"       calcFunc-evalto   40  41 )
 363      ( "=>"       calcFunc-evalto   40  -1 )
 364 ))
 365
 366 (put 'tex 'math-function-table
 367   '( ( \\arccos    . calcFunc-arccos )
 368      ( \\arcsin    . calcFunc-arcsin )
 369      ( \\arctan    . calcFunc-arctan )
 370      ( \\arg       . calcFunc-arg )
 371      ( \\cos       . calcFunc-cos )
 372      ( \\cosh      . calcFunc-cosh )
 373      ( \\det       . calcFunc-det )
 374      ( \\exp       . calcFunc-exp )
 375      ( \\gcd       . calcFunc-gcd )
 376      ( \\ln        . calcFunc-ln )
 377      ( \\log       . calcFunc-log10 )
 378      ( \\max       . calcFunc-max )
 379      ( \\min       . calcFunc-min )
 380      ( \\tan       . calcFunc-tan )
 381      ( \\sin       . calcFunc-sin )
 382      ( \\sinh      . calcFunc-sinh )
 383      ( \\sqrt      . calcFunc-sqrt )
 384      ( \\tanh      . calcFunc-tanh )
 385      ( \\phi       . calcFunc-totient )
 386      ( \\mu        . calcFunc-moebius )
 387 ))
 388
 389 (put 'tex 'math-variable-table
 390   '( ( \\pi        . var-pi )
 391      ( \\infty     . var-inf )
 392      ( \\infty     . var-uinf )
 393      ( \\phi       . var-phi )
 394      ( \\gamma     . var-gamma )
 395      ( \\sum       . (math-parse-tex-sum calcFunc-sum) )
 396      ( \\prod      . (math-parse-tex-sum calcFunc-prod) )
 397 ))
 398
 399 (put 'tex 'math-complex-format 'i)
 400
 401 (defun math-parse-tex-sum (f val)
 402   (let (low high save)
 403     (or (equal exp-data "_") (throw 'syntax "Expected `_'"))
 404     (math-read-token)
 405     (setq save exp-old-pos)
 406     (setq low (math-read-factor))
 407     (or (eq (car-safe low) 'calcFunc-eq)
 408         (progn
 409           (setq exp-old-pos (1+ save))
 410           (throw 'syntax "Expected equation")))
 411     (or (equal exp-data "^") (throw 'syntax "Expected `^'"))
 412     (math-read-token)
 413     (setq high (math-read-factor))
 414     (list (nth 2 f) (math-read-factor) (nth 1 low) (nth 2 low) high))
 415 )
 416
 417 (defun math-tex-input-filter (str)   ; allow parsing of 123\,456\,789.
 418   (while (string-match "[0-9]\\\\,[0-9]" str)
 419     (setq str (concat (substring str 0 (1+ (match-beginning 0)))
 420                       (substring str (1- (match-end 0))))))
 421   str
 422 )
 423 (put 'tex 'math-input-filter 'math-tex-input-filter)
 424
 425
 426 (defun calc-eqn-language (n)
 427   (interactive "P")
 428   (calc-wrapper
 429    (calc-set-language 'eqn)
 430    (message "Eqn language mode."))
 431 )
 432
 433 (put 'eqn 'math-oper-table
 434   '( ( "u+"       ident            -1 1000 )
 435      ( "u-"       neg              -1 1000 )
 436      ( "prime"    (math-parse-eqn-prime) 950  -1 )
 437      ( "prime"    calcFunc-Prime   950  -1 )
 438      ( "dot"      calcFunc-dot     950  -1 )
 439      ( "dotdot"   calcFunc-dotdot  950  -1 )
 440      ( "hat"      calcFunc-hat     950  -1 )
 441      ( "tilde"    calcFunc-tilde   950  -1 )
 442      ( "vec"      calcFunc-Vec     950  -1 )
 443      ( "dyad"     calcFunc-dyad    950  -1 )
 444      ( "bar"      calcFunc-bar     950  -1 )
 445      ( "under"    calcFunc-under   950  -1 )
 446      ( "sub"      calcFunc-subscr  931 930 )
 447      ( "sup"      ^                921 920 )
 448      ( "sqrt"     calcFunc-sqrt    -1  910 )
 449      ( "over"     /                900 901 )
 450      ( "u|"       calcFunc-abs     -1    0 )
 451      ( "|"        closing           0   -1 )
 452      ( "left floor"  calcFunc-floor -1   0 )
 453      ( "right floor" closing        0   -1 )
 454      ( "left ceil"   calcFunc-ceil  -1   0 )
 455      ( "right ceil"  closing        0   -1 )
 456      ( "+-"       sdev             300 300 )
 457      ( "!"        calcFunc-fact    210  -1 )
 458      ( "times"    *                191 190 )
 459      ( "*"        *                191 190 )
 460      ( "2x"       *                191 190 )
 461      ( "/"        /                180 181 )
 462      ( "%"        %                180 181 )
 463      ( "+"        +                170 171 )
 464      ( "-"        -                170 171 )
 465      ( "<"        calcFunc-lt      160 161 )
 466      ( ">"        calcFunc-gt      160 161 )
 467      ( "<="       calcFunc-leq     160 161 )
 468      ( ">="       calcFunc-geq     160 161 )
 469      ( "="        calcFunc-eq      160 161 )
 470      ( "=="       calcFunc-eq      160 161 )
 471      ( "!="       calcFunc-neq     160 161 )
 472      ( "u!"       calcFunc-lnot     -1 121 )
 473      ( "&&"       calcFunc-land    110 111 )
 474      ( "||"       calcFunc-lor     100 101 )
 475      ( "?"        (math-read-if)    91  90 )
 476      ( "!!!"      calcFunc-pnot     -1  85 )
 477      ( "&&&"      calcFunc-pand     80  81 )
 478      ( "|||"      calcFunc-por      75  76 )
 479      ( "<-"       calcFunc-assign   51  50 )
 480      ( ":="       calcFunc-assign   51  50 )
 481      ( "::"       calcFunc-condition 45 46 )
 482      ( "->"       calcFunc-evalto   40  41 )
 483      ( "->"       calcFunc-evalto   40  -1 )
 484      ( "=>"       calcFunc-evalto   40  41 )
 485      ( "=>"       calcFunc-evalto   40  -1 )
 486 ))
 487
 488 (put 'eqn 'math-function-table
 489   '( ( arc\ cos    . calcFunc-arccos )
 490      ( arc\ cosh   . calcFunc-arccosh )
 491      ( arc\ sin    . calcFunc-arcsin )
 492      ( arc\ sinh   . calcFunc-arcsinh )
 493      ( arc\ tan    . calcFunc-arctan )
 494      ( arc\ tanh   . calcFunc-arctanh )
 495      ( GAMMA       . calcFunc-gamma )
 496      ( phi         . calcFunc-totient )
 497      ( mu          . calcFunc-moebius )
 498      ( matrix      . (math-parse-eqn-matrix) )
 499 ))
 500
 501 (put 'eqn 'math-variable-table
 502   '( ( inf         . var-uinf )
 503 ))
 504
 505 (put 'eqn 'math-complex-format 'i)
 506
 507 (defun math-parse-eqn-matrix (f sym)
 508   (let ((vec nil))
 509     (while (assoc exp-data '(("ccol") ("lcol") ("rcol")))
 510       (math-read-token)
 511       (or (equal exp-data calc-function-open)
 512           (throw 'syntax "Expected `{'"))
 513       (math-read-token)
 514       (setq vec (cons (cons 'vec (math-read-expr-list)) vec))
 515       (or (equal exp-data calc-function-close)
 516           (throw 'syntax "Expected `}'"))
 517       (math-read-token))
 518     (or (equal exp-data calc-function-close)
 519         (throw 'syntax "Expected `}'"))
 520     (math-read-token)
 521     (math-transpose (cons 'vec (nreverse vec))))
 522 )
 523
 524 (defun math-parse-eqn-prime (x sym)
 525   (if (eq (car-safe x) 'var)
 526       (if (equal exp-data calc-function-open)
 527           (progn
 528             (math-read-token)
 529             (let ((args (if (or (equal exp-data calc-function-close)
 530                                 (eq exp-token 'end))
 531                             nil
 532                           (math-read-expr-list))))
 533               (if (not (or (equal exp-data calc-function-close)
 534                            (eq exp-token 'end)))
 535                   (throw 'syntax "Expected `)'"))
 536               (math-read-token)
 537               (cons (intern (format "calcFunc-%s'" (nth 1 x))) args)))
 538         (list 'var
 539               (intern (concat (symbol-name (nth 1 x)) "'"))
 540               (intern (concat (symbol-name (nth 2 x)) "'"))))
 541     (list 'calcFunc-Prime x))
 542 )
 543
 544
 545 (defun calc-mathematica-language ()
 546   (interactive)
 547   (calc-wrapper
 548    (calc-set-language 'math)
 549    (message "Mathematica language mode."))
 550 )
 551
 552 (put 'math 'math-oper-table
 553   '( ( "[["    (math-read-math-subscr) 250 -1 )
 554      ( "!"     calcFunc-fact  210 -1 )
 555      ( "!!"    calcFunc-dfact 210 -1 )
 556      ( "^"     ^             201 200 )
 557      ( "u+"    ident         -1  197 )
 558      ( "u-"    neg           -1  197 )
 559      ( "/"     /             195 196 )
 560      ( "*"     *             190 191 )
 561      ( "2x"    *             190 191 )
 562      ( "+"     +             180 181 )
 563      ( "-"     -             180 181 )
 564      ( "<"     calcFunc-lt   160 161 )
 565      ( ">"     calcFunc-gt   160 161 )
 566      ( "<="    calcFunc-leq  160 161 )
 567      ( ">="    calcFunc-geq  160 161 )
 568      ( "=="    calcFunc-eq   150 151 )
 569      ( "!="    calcFunc-neq  150 151 )
 570      ( "u!"    calcFunc-lnot -1  121 )
 571      ( "&&"    calcFunc-land 110 111 )
 572      ( "||"    calcFunc-lor  100 101 )
 573      ( "!!!"   calcFunc-pnot  -1  85 )
 574      ( "&&&"   calcFunc-pand  80  81 )
 575      ( "|||"   calcFunc-por   75  76 )
 576      ( ":="    calcFunc-assign 51 50 )
 577      ( "="     calcFunc-assign 51 50 )
 578      ( "->"    calcFunc-assign 51 50 )
 579      ( ":>"    calcFunc-assign 51 50 )
 580      ( "::"    calcFunc-condition 45 46 )
 581 ))
 582
 583 (put 'math 'math-function-table
 584   '( ( Abs         . calcFunc-abs )
 585      ( ArcCos      . calcFunc-arccos )
 586      ( ArcCosh     . calcFunc-arccosh )
 587      ( ArcSin      . calcFunc-arcsin )
 588      ( ArcSinh     . calcFunc-arcsinh )
 589      ( ArcTan      . calcFunc-arctan )
 590      ( ArcTanh     . calcFunc-arctanh )
 591      ( Arg         . calcFunc-arg )
 592      ( Binomial    . calcFunc-choose )
 593      ( Ceiling     . calcFunc-ceil )
 594      ( Conjugate   . calcFunc-conj )
 595      ( Cos         . calcFunc-cos )
 596      ( Cosh        . calcFunc-cosh )
 597      ( D           . calcFunc-deriv )
 598      ( Dt          . calcFunc-tderiv )
 599      ( Det         . calcFunc-det )
 600      ( Exp         . calcFunc-exp )
 601      ( EulerPhi    . calcFunc-totient )
 602      ( Floor       . calcFunc-floor )
 603      ( Gamma       . calcFunc-gamma )
 604      ( GCD         . calcFunc-gcd )
 605      ( If          . calcFunc-if )
 606      ( Im          . calcFunc-im )
 607      ( Inverse     . calcFunc-inv )
 608      ( Integrate   . calcFunc-integ )
 609      ( Join        . calcFunc-vconcat )
 610      ( LCM         . calcFunc-lcm )
 611      ( Log         . calcFunc-ln )
 612      ( Max         . calcFunc-max )
 613      ( Min         . calcFunc-min )
 614      ( Mod         . calcFunc-mod )
 615      ( MoebiusMu   . calcFunc-moebius )
 616      ( Random      . calcFunc-random )
 617      ( Round       . calcFunc-round )
 618      ( Re          . calcFunc-re )
 619      ( Sign        . calcFunc-sign )
 620      ( Sin         . calcFunc-sin )
 621      ( Sinh        . calcFunc-sinh )
 622      ( Sqrt        . calcFunc-sqrt )
 623      ( Tan         . calcFunc-tan )
 624      ( Tanh        . calcFunc-tanh )
 625      ( Transpose   . calcFunc-trn )
 626      ( Length      . calcFunc-vlen )
 627 ))
 628
 629 (put 'math 'math-variable-table
 630   '( ( I           . var-i )
 631      ( Pi          . var-pi )
 632      ( E           . var-e )
 633      ( GoldenRatio . var-phi )
 634      ( EulerGamma  . var-gamma )
 635      ( Infinity    . var-inf )
 636      ( ComplexInfinity . var-uinf )
 637      ( Indeterminate . var-nan )
 638 ))
 639
 640 (put 'math 'math-vector-brackets "{}")
 641 (put 'math 'math-complex-format 'I)
 642 (put 'math 'math-function-open "[")
 643 (put 'math 'math-function-close "]")
 644
 645 (put 'math 'math-radix-formatter
 646      (function (lambda (r s) (format "%d^^%s" r s))))
 647
 648 (defun math-read-math-subscr (x op)
 649   (let ((idx (math-read-expr-level 0)))
 650     (or (and (equal exp-data "]")
 651              (progn
 652                (math-read-token)
 653                (equal exp-data "]")))
 654         (throw 'syntax "Expected ']]'"))
 655     (math-read-token)
 656     (list 'calcFunc-subscr x idx))
 657 )
 658
 659
 660 (defun calc-maple-language ()
 661   (interactive)
 662   (calc-wrapper
 663    (calc-set-language 'maple)
 664    (message "Maple language mode."))
 665 )
 666
 667 (put 'maple 'math-oper-table
 668   '( ( "matrix" ident        -1  300 )
 669      ( "MATRIX" ident        -1  300 )
 670      ( "!"     calcFunc-fact  210 -1 )
 671      ( "^"     ^             201 200 )
 672      ( "**"    ^             201 200 )
 673      ( "u+"    ident         -1  197 )
 674      ( "u-"    neg           -1  197 )
 675      ( "/"     /             191 192 )
 676      ( "*"     *             191 192 )
 677      ( "intersect" calcFunc-vint 191 192 )
 678      ( "+"     +             180 181 )
 679      ( "-"     -             180 181 )
 680      ( "union" calcFunc-vunion 180 181 )
 681      ( "minus" calcFunc-vdiff 180 181 )
 682      ( "mod"   %             170 170 )
 683      ( ".."    (math-read-maple-dots) 165 165 )
 684      ( "\\dots" (math-read-maple-dots) 165 165 )
 685      ( "<"     calcFunc-lt   160 160 )
 686      ( ">"     calcFunc-gt   160 160 )
 687      ( "<="    calcFunc-leq  160 160 )
 688      ( ">="    calcFunc-geq  160 160 )
 689      ( "="     calcFunc-eq   160 160 )
 690      ( "<>"    calcFunc-neq  160 160 )
 691      ( "not"   calcFunc-lnot -1  121 )
 692      ( "and"   calcFunc-land 110 111 )
 693      ( "or"    calcFunc-lor  100 101 )
 694      ( "!!!"   calcFunc-pnot  -1  85 )
 695      ( "&&&"   calcFunc-pand  80  81 )
 696      ( "|||"   calcFunc-por   75  76 )
 697      ( ":="    calcFunc-assign 51 50 )
 698      ( "::"    calcFunc-condition 45 46 )
 699 ))
 700
 701 (put 'maple 'math-function-table
 702   '( ( bernoulli   . calcFunc-bern )
 703      ( binomial    . calcFunc-choose )
 704      ( diff        . calcFunc-deriv )
 705      ( GAMMA       . calcFunc-gamma )
 706      ( ifactor     . calcFunc-prfac )
 707      ( igcd        . calcFunc-gcd )
 708      ( ilcm        . calcFunc-lcm )
 709      ( int         . calcFunc-integ )
 710      ( modp        . % )
 711      ( irem        . % )
 712      ( iquo        . calcFunc-idiv )
 713      ( isprime     . calcFunc-prime )
 714      ( length      . calcFunc-vlen )
 715      ( member      . calcFunc-in )
 716      ( crossprod   . calcFunc-cross )
 717      ( inverse     . calcFunc-inv )
 718      ( trace       . calcFunc-tr )
 719      ( transpose   . calcFunc-trn )
 720      ( vectdim     . calcFunc-vlen )
 721 ))
 722
 723 (put 'maple 'math-variable-table
 724   '( ( I           . var-i )
 725      ( Pi          . var-pi )
 726      ( E           . var-e )
 727      ( infinity    . var-inf )
 728      ( infinity    . var-uinf )
 729      ( infinity    . var-nan )
 730 ))
 731
 732 (put 'maple 'math-complex-format 'I)
 733
 734 (defun math-read-maple-dots (x op)
 735   (list 'intv 3 x (math-read-expr-level (nth 3 op)))
 736 )
 737
 738
 739
 740
 741
 742 (defun math-read-big-rec (h1 v1 h2 v2 &optional baseline prec short)
 743   (or prec (setq prec 0))
 744
 745   ;; Clip whitespace above or below.
 746   (while (and (< v1 v2) (math-read-big-emptyp h1 v1 h2 (1+ v1)))
 747     (setq v1 (1+ v1)))
 748   (while (and (< v1 v2) (math-read-big-emptyp h1 (1- v2) h2 v2))
 749     (setq v2 (1- v2)))
 750
 751   ;; If formula is a single line high, normal parser can handle it.
 752   (if (<= v2 (1+ v1))
 753       (if (or (<= v2 v1)
 754               (> h1 (length (setq v2 (nth v1 lines)))))
 755           (math-read-big-error h1 v1)
 756         (setq the-baseline v1
 757               the-h2 h2
 758               v2 (nth v1 lines)
 759               h2 (math-read-expr (substring v2 h1 (min h2 (length v2)))))
 760         (if (eq (car-safe h2) 'error)
 761             (math-read-big-error (+ h1 (nth 1 h2)) v1 (nth 2 h2))
 762           h2))
 763
 764     ;; Clip whitespace at left or right.
 765     (while (and (< h1 h2) (math-read-big-emptyp h1 v1 (1+ h1) v2))
 766       (setq h1 (1+ h1)))
 767     (while (and (< h1 h2) (math-read-big-emptyp (1- h2) v1 h2 v2))
 768       (setq h2 (1- h2)))
 769
 770     ;; Scan to find widest left-justified "----" in the region.
 771     (let* ((widest nil)
 772            (widest-h2 0)
 773            (lines-v1 (nthcdr v1 lines))
 774            (p lines-v1)
 775            (v v1)
 776            (other-v nil)
 777            other-char line len h)
 778       (while (< v v2)
 779         (setq line (car p)
 780               len (min h2 (length line)))
 781         (and (< h1 len)
 782              (/= (aref line h1) ?\ )
 783              (if (and (= (aref line h1) ?\-)
 784                       ;; Make sure it's not a minus sign.
 785                       (or (and (< (1+ h1) len) (= (aref line (1+ h1)) ?\-))
 786                           (/= (math-read-big-char h1 (1- v)) ?\ )
 787                           (/= (math-read-big-char h1 (1+ v)) ?\ )))
 788                  (progn
 789                    (setq h h1)
 790                    (while (and (< (setq h (1+ h)) len)
 791                                (= (aref line h) ?\-)))
 792                    (if (> h widest-h2)
 793                        (setq widest v
 794                              widest-h2 h)))
 795                (or other-v (setq other-v v other-char (aref line h1)))))
 796         (setq v (1+ v)
 797               p (cdr p)))
 798
 799       (cond ((not (setq v other-v))
 800              (math-read-big-error h1 v1))   ; Should never happen!
 801
 802             ;; Quotient.
 803             (widest
 804              (setq h widest-h2
 805                    v widest)
 806              (let ((num (math-read-big-rec h1 v1 h v))
 807                    (den (math-read-big-rec h1 (1+ v) h v2)))
 808                (setq p (if (and (math-integerp num) (math-integerp den))
 809                            (math-make-frac num den)
 810                          (list '/ num den)))))
 811
 812             ;; Big radical sign.
 813             ((= other-char ?\\)
 814              (or (= (math-read-big-char (1+ h1) v) ?\|)
 815                  (math-read-big-error (1+ h1) v "Malformed root sign"))
 816              (math-read-big-emptyp h1 v1 (1+ h1) v nil t)
 817              (while (= (math-read-big-char (1+ h1) (setq v (1- v))) ?\|))
 818              (or (= (math-read-big-char (setq h (+ h1 2)) v) ?\_)
 819                  (math-read-big-error h v "Malformed root sign"))
 820              (while (= (math-read-big-char (setq h (1+ h)) v) ?\_))
 821              (math-read-big-emptyp h1 v1 (1+ h1) v nil t)
 822              (math-read-big-emptyp h1 (1+ other-v) h v2 nil t)
 823              (setq p (list 'calcFunc-sqrt (math-read-big-rec
 824                                            (+ h1 2) (1+ v)
 825                                            h (1+ other-v) baseline))
 826                    v the-baseline))
 827
 828             ;; Small radical sign.
 829             ((and (= other-char ?V)
 830                   (= (math-read-big-char (1+ h1) (1- v)) ?\_))
 831              (setq h (1+ h1))
 832              (math-read-big-emptyp h1 v1 h (1- v) nil t)
 833              (math-read-big-emptyp h1 (1+ v) h v2 nil t)
 834              (math-read-big-emptyp h1 v1 (1+ h1) v nil t)
 835              (while (= (math-read-big-char (setq h (1+ h)) (1- v)) ?\_))
 836              (setq p (list 'calcFunc-sqrt (math-read-big-rec
 837                                            (1+ h1) v h (1+ v) t))
 838                    v the-baseline))
 839
 840             ;; Binomial coefficient.
 841             ((and (= other-char ?\()
 842                   (= (math-read-big-char (1+ h1) v) ?\ )
 843                   (= (string-match "( *)" (nth v lines) h1) h1))
 844              (setq h (match-end 0))
 845              (math-read-big-emptyp h1 v1 (1+ h1) v nil t)
 846              (math-read-big-emptyp h1 (1+ v) (1+ h1) v2 nil t)
 847              (math-read-big-emptyp (1- h) v1 h v nil t)
 848              (math-read-big-emptyp (1- h) (1+ v) h v2 nil t)
 849              (setq p (list 'calcFunc-choose
 850                            (math-read-big-rec (1+ h1) v1 (1- h) v)
 851                            (math-read-big-rec (1+ h1) (1+ v)
 852                                               (1- h) v2))))
 853
 854             ;; Minus sign.
 855             ((= other-char ?\-)
 856              (setq p (list 'neg (math-read-big-rec (1+ h1) v1 h2 v2 v 250 t))
 857                    v the-baseline
 858                    h the-h2))
 859
 860             ;; Parentheses.
 861             ((= other-char ?\()
 862              (math-read-big-emptyp h1 v1 (1+ h1) v nil t)
 863              (math-read-big-emptyp h1 (1+ v) (1+ h1) v2 nil t)
 864              (setq h (math-read-big-balance (1+ h1) v "(" t))
 865              (math-read-big-emptyp (1- h) v1 h v nil t)
 866              (math-read-big-emptyp (1- h) (1+ v) h v2 nil t)
 867              (let ((sep (math-read-big-char (1- h) v))
 868                    hmid)
 869                (if (= sep ?\.)
 870                    (setq h (1+ h)))
 871                (if (= sep ?\])
 872                    (math-read-big-error (1- h) v "Expected `)'"))
 873                (if (= sep ?\))
 874                    (setq p (math-read-big-rec (1+ h1) v1 (1- h) v2 v))
 875                  (setq hmid (math-read-big-balance h v "(")
 876                        p (list p (math-read-big-rec h v1 (1- hmid) v2 v))
 877                        h hmid)
 878                  (cond ((= sep ?\.)
 879                         (setq p (cons 'intv (cons (if (= (math-read-big-char
 880                                                           (1- h) v)
 881                                                          ?\))
 882                                                       0 1)
 883                                                   p))))
 884                        ((= (math-read-big-char (1- h) v) ?\])
 885                         (math-read-big-error (1- h) v "Expected `)'"))
 886                        ((= sep ?\,)
 887                         (or (and (math-realp (car p)) (math-realp (nth 1 p)))
 888                             (math-read-big-error
 889                              h1 v "Complex components must be real"))
 890                         (setq p (cons 'cplx p)))
 891                        ((= sep ?\;)
 892                         (or (and (math-realp (car p)) (math-anglep (nth 1 p)))
 893                             (math-read-big-error
 894                              h1 v "Complex components must be real"))
 895                         (setq p (cons 'polar p)))))))
 896
 897             ;; Matrix.
 898             ((and (= other-char ?\[)
 899                   (or (= (math-read-big-char (setq h h1) (1+ v)) ?\[)
 900                       (= (math-read-big-char (setq h (1+ h)) v) ?\[)
 901                       (and (= (math-read-big-char h v) ?\ )
 902                            (= (math-read-big-char (setq h (1+ h)) v) ?\[)))
 903                   (= (math-read-big-char h (1+ v)) ?\[))
 904              (math-read-big-emptyp h1 v1 h v nil t)
 905              (let ((vtop v)
 906                    (hleft h)
 907                    (hright nil))
 908                (setq p nil)
 909                (while (progn
 910                         (setq h (math-read-big-balance (1+ hleft) v "["))
 911                         (if hright
 912                             (or (= h hright)
 913                                 (math-read-big-error hright v "Expected `]'"))
 914                           (setq hright h))
 915                         (setq p (cons (math-read-big-rec
 916                                        hleft v h (1+ v)) p))
 917                         (and (memq (math-read-big-char h v) '(?\  ?\,))
 918                              (= (math-read-big-char hleft (1+ v)) ?\[)))
 919                  (setq v (1+ v)))
 920                (or (= hleft h1)
 921                    (progn
 922                      (if (= (math-read-big-char h v) ?\ )
 923                          (setq h (1+ h)))
 924                      (and (= (math-read-big-char h v) ?\])
 925                           (setq h (1+ h))))
 926                    (math-read-big-error (1- h) v "Expected `]'"))
 927                (if (= (math-read-big-char h vtop) ?\,)
 928                    (setq h (1+ h)))
 929                (math-read-big-emptyp h1 (1+ v) (1- h) v2 nil t)
 930                (setq v (+ vtop (/ (- v vtop) 2))
 931                      p (cons 'vec (nreverse p)))))
 932
 933             ;; Square brackets.
 934             ((= other-char ?\[)
 935              (math-read-big-emptyp h1 v1 (1+ h1) v nil t)
 936              (math-read-big-emptyp h1 (1+ v) (1+ h1) v2 nil t)
 937              (setq p nil
 938                    h (1+ h1))
 939              (while (progn
 940                       (setq widest (math-read-big-balance h v "[" t))
 941                       (math-read-big-emptyp (1- h) v1 h v nil t)
 942                       (math-read-big-emptyp (1- h) (1+ v) h v2 nil t)
 943                       (setq p (cons (math-read-big-rec
 944                                      h v1 (1- widest) v2 v) p)
 945                             h widest)
 946                       (= (math-read-big-char (1- h) v) ?\,)))
 947              (setq widest (math-read-big-char (1- h) v))
 948              (if (or (memq widest '(?\; ?\)))
 949                      (and (eq widest ?\.) (cdr p)))
 950                  (math-read-big-error (1- h) v "Expected `]'"))
 951              (if (= widest ?\.)
 952                  (setq h (1+ h)
 953                        widest (math-read-big-balance h v "[")
 954                        p (nconc p (list (math-read-big-big-rec
 955                                          h v1 (1- widest) v2 v)))
 956                        h widest
 957                        p (cons 'intv (cons (if (= (math-read-big-char (1- h) v)
 958                                                   ?\])
 959                                                3 2)
 960                                            p)))
 961                (setq p (cons 'vec (nreverse p)))))
 962
 963             ;; Date form.
 964             ((= other-char ?\<)
 965              (setq line (nth v lines))
 966              (string-match ">" line h1)
 967              (setq h (match-end 0))
 968              (math-read-big-emptyp h1 v1 h v nil t)
 969              (math-read-big-emptyp h1 (1+ v) h v2 nil t)
 970              (setq p (math-read-big-rec h1 v h (1+ v) v)))
 971
 972             ;; Variable name or function call.
 973             ((or (and (>= other-char ?a) (<= other-char ?z))
 974                  (and (>= other-char ?A) (<= other-char ?Z)))
 975              (setq line (nth v lines))
 976              (string-match "\\([a-zA-Z'_]+\\) *" line h1)
 977              (setq h (match-end 1)
 978                    widest (match-end 0)
 979                    p (math-match-substring line 1))
 980              (math-read-big-emptyp h1 v1 h v nil t)
 981              (math-read-big-emptyp h1 (1+ v) h v2 nil t)
 982              (if (= (math-read-big-char widest v) ?\()
 983                  (progn
 984                    (setq line (if (string-match "-" p)
 985                                   (intern p)
 986                                 (intern (concat "calcFunc-" p)))
 987                          h (1+ widest)
 988                          p nil)
 989                    (math-read-big-emptyp widest v1 h v nil t)
 990                    (math-read-big-emptyp widest (1+ v) h v2 nil t)
 991                    (while (progn
 992                             (setq widest (math-read-big-balance h v "(" t))
 993                             (math-read-big-emptyp (1- h) v1 h v nil t)
 994                             (math-read-big-emptyp (1- h) (1+ v) h v2 nil t)
 995                             (setq p (cons (math-read-big-rec
 996                                            h v1 (1- widest) v2 v) p)
 997                                   h widest)
 998                             (= (math-read-big-char (1- h) v) ?\,)))
 999                    (or (= (math-read-big-char (1- h) v) ?\))
1000                        (math-read-big-error (1- h) v "Expected `)'"))
1001                    (setq p (cons line (nreverse p))))
1002                (setq p (list 'var
1003                              (intern (math-remove-dashes p))
1004                              (if (string-match "-" p)
1005                                  (intern p)
1006                                (intern (concat "var-" p)))))))
1007
1008             ;; Number.
1009             (t
1010              (setq line (nth v lines))
1011              (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)
1012                  (math-read-big-error h v "Expected a number"))
1013              (setq h (match-end 0)
1014                    p (math-read-number (math-match-substring line 0)))
1015              (math-read-big-emptyp h1 v1 h v nil t)
1016              (math-read-big-emptyp h1 (1+ v) h v2 nil t)))
1017
1018       ;; Now left term is bounded by h1, v1, h, v2; baseline = v.
1019       (if baseline
1020           (or (= v baseline)
1021               (math-read-big-error h1 v "Inconsistent baseline in formula"))
1022         (setq baseline v))
1023
1024       ;; Look for superscripts or subscripts.
1025       (setq line (nth baseline lines)
1026             len (min h2 (length line))
1027             widest h)
1028       (while (and (< widest len)
1029                   (= (aref line widest) ?\ ))
1030         (setq widest (1+ widest)))
1031       (and (>= widest len) (setq widest h2))
1032       (if (math-read-big-emptyp h v widest v2)
1033           (if (math-read-big-emptyp h v1 widest v)
1034               (setq h widest)
1035             (setq p (list '^ p (math-read-big-rec h v1 widest v))
1036                   h widest))
1037           (if (math-read-big-emptyp h v1 widest v)
1038               (setq p (list 'calcFunc-subscr p
1039                             (math-read-big-rec h v widest v2))
1040                     h widest)))
1041
1042       ;; Look for an operator name and grab additional terms.
1043       (while (and (< h len)
1044                   (if (setq widest (and (math-read-big-emptyp
1045                                          h v1 (1+ h) v)
1046                                         (math-read-big-emptyp
1047                                          h (1+ v) (1+ h) v2)
1048                                         (string-match "<=\\|>=\\|\\+/-\\|!=\\|&&\\|||\\|:=\\|=>\\|." line h)
1049                                         (assoc (math-match-substring line 0)
1050                                                math-standard-opers)))
1051                       (and (>= (nth 2 widest) prec)
1052                            (setq h (match-end 0)))
1053                     (and (not (eq (string-match ",\\|;\\|\\.\\.\\|)\\|\\]\\|:" line h)
1054                                   h))
1055                          (setq widest '("2x" * 196 195)))))
1056         (cond ((eq (nth 3 widest) -1)
1057                (setq p (list (nth 1 widest) p)))
1058               ((equal (car widest) "?")
1059                (let ((y (math-read-big-rec h v1 h2 v2 baseline nil t)))
1060                  (or (= (math-read-big-char the-h2 baseline) ?\:)
1061                      (math-read-big-error the-h2 baseline "Expected `:'"))
1062                  (setq p (list (nth 1 widest) p y
1063                                (math-read-big-rec (1+ the-h2) v1 h2 v2
1064                                                   baseline (nth 3 widest) t))
1065                        h the-h2)))
1066               (t
1067                (setq p (list (nth 1 widest) p
1068                              (math-read-big-rec h v1 h2 v2
1069                                                 baseline (nth 3 widest) t))
1070                      h the-h2))))
1071
1072       ;; Return all relevant information to caller.
1073       (setq the-baseline baseline
1074             the-h2 h)
1075       (or short (= the-h2 h2)
1076           (math-read-big-error h baseline))
1077       p))
1078 )
1079
1080 (defun math-read-big-char (h v)
1081   (or (and (>= h h1)
1082            (< h h2)
1083            (>= v v1)
1084            (< v v2)
1085            (let ((line (nth v lines)))
1086              (and line
1087                   (< h (length line))
1088                   (aref line h))))
1089       ?\ )
1090 )
1091
1092 (defun math-read-big-emptyp (eh1 ev1 eh2 ev2 &optional what error)
1093   (and (< ev1 v1) (setq ev1 v1))
1094   (and (< eh1 h1) (setq eh1 h1))
1095   (and (> ev2 v2) (setq ev2 v2))
1096   (and (> eh2 h2) (setq eh2 h2))
1097   (or what (setq what ?\ ))
1098   (let ((p (nthcdr ev1 lines))
1099         h)
1100     (while (and (< ev1 ev2)
1101                 (progn
1102                   (setq h (min eh2 (length (car p))))
1103                   (while (and (>= (setq h (1- h)) eh1)
1104                               (= (aref (car p) h) what)))
1105                   (and error (>= h eh1)
1106                        (math-read-big-error h ev1 (if (stringp error)
1107                                                       error
1108                                                     "Whitespace expected")))
1109                   (< h eh1)))
1110       (setq ev1 (1+ ev1)
1111             p (cdr p)))
1112     (>= ev1 ev2))
1113 )
1114
1115 (defun math-read-big-error (h v &optional msg)
1116   (let ((pos 0)
1117         (p lines))
1118     (while (> v 0)
1119       (setq pos (+ pos 1 (length (car p)))
1120             p (cdr p)
1121             v (1- v)))
1122     (setq h (+ pos (min h (length (car p))))
1123           err-msg (list 'error h (or msg "Syntax error")))
1124     (throw 'syntax nil))
1125 )
1126
1127 (defun math-read-big-balance (h v what &optional commas)
1128   (let* ((line (nth v lines))
1129          (len (min h2 (length line)))
1130          (count 1))
1131     (while (> count 0)
1132       (if (>= h len)
1133           (if what
1134               (math-read-big-error h1 v (format "Unmatched `%s'" what))
1135             (setq count 0))
1136         (if (memq (aref line h) '(?\( ?\[))
1137             (setq count (1+ count))
1138           (if (if (and commas (= count 1))
1139                   (or (memq (aref line h) '(?\) ?\] ?\, ?\;))
1140                       (and (eq (aref line h) ?\.)
1141                            (< (1+ h) len)
1142                            (eq (aref line (1+ h)) ?\.)))
1143                 (memq (aref line h) '(?\) ?\])))
1144               (setq count (1- count))))
1145         (setq h (1+ h))))
1146     h)
1147 )
1148
1149
1150
1151