lisp/calc/calc-lang.el

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