code.delx.au - gnu-emacs/blob - 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, 2007 Free Software Foundation, Inc.
   5
   6 ;; Author: David Gillespie <daveg@synaptics.com>
   7 ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 3, or (at your option)
  14 ;; any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  24 ;; Boston, MA 02110-1301, USA.
  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
  36 ;; Declare functions which are defined elsewhere.
  37 (declare-function math-compose-vector "calccomp" (a sep prec))
  38 (declare-function math-compose-var "calccomp" (a v))
  39 (declare-function math-tex-expr-is-flat "calccomp" (a))
  40 (declare-function math-read-factor "calc-aent" ())
  41 (declare-function math-read-expr-level "calc-aent" (exp-prec &optional exp-term))
  42
  43 ;; Declare variables which are defined elsewhere.
  44 (defvar calc-lang-slash-idiv)
  45 (defvar calc-lang-allow-underscores)
  46 (defvar math-comp-left-bracket)
  47 (defvar math-comp-right-bracket)
  48 (defvar math-comp-comma)
  49 (defvar math-comp-vector-prec)
  50
  51 ;;; Alternate entry/display languages.
  52
  53 (defun calc-set-language (lang &optional option no-refresh)
  54   (setq math-expr-opers (or (get lang 'math-oper-table) (math-standard-ops))
  55         math-expr-function-mapping (get lang 'math-function-table)
  56         math-expr-variable-mapping (get lang 'math-variable-table)
  57         calc-language-input-filter (get lang 'math-input-filter)
  58         calc-language-output-filter (get lang 'math-output-filter)
  59         calc-vector-brackets (or (get lang 'math-vector-brackets) "[]")
  60         calc-complex-format (get lang 'math-complex-format)
  61         calc-radix-formatter (get lang 'math-radix-formatter)
  62         calc-function-open (or (get lang 'math-function-open) "(")
  63         calc-function-close (or (get lang 'math-function-close) ")"))
  64   (if no-refresh
  65       (setq calc-language lang
  66             calc-language-option option)
  67     (calc-change-mode '(calc-language calc-language-option)
  68                       (list lang option) t)))
  69
  70 (defun calc-normal-language ()
  71   (interactive)
  72   (calc-wrapper
  73    (calc-set-language nil)
  74    (message "Normal language mode")))
  75
  76 (defun calc-flat-language ()
  77   (interactive)
  78   (calc-wrapper
  79    (calc-set-language 'flat)
  80    (message "Flat language mode (all stack entries shown on one line)")))
  81
  82 (defun calc-big-language ()
  83   (interactive)
  84   (calc-wrapper
  85    (calc-set-language 'big)
  86    (message "\"Big\" language mode")))
  87
  88 (defun calc-unformatted-language ()
  89   (interactive)
  90   (calc-wrapper
  91    (calc-set-language 'unform)
  92    (message "Unformatted language mode")))
  93
  94
  95 (defun calc-c-language ()
  96   (interactive)
  97   (calc-wrapper
  98    (calc-set-language 'c)
  99    (message "`C' language mode")))
 100
 101 (put 'c 'math-oper-table
 102   '( ( "u!"    calcFunc-lnot -1 1000 )
 103      ( "~"     calcFunc-not  -1 1000 )
 104      ( "u+"    ident         -1  197 )
 105      ( "u-"    neg           -1  197 )
 106      ( "*"     *             190 191 )
 107      ( "/"     /             190 191 )
 108      ( "%"     %             190 191 )
 109      ( "+"     +             180 181 )
 110      ( "-"     -             180 181 )
 111      ( "<<"    calcFunc-lsh  170 171 )
 112      ( ">>"    calcFunc-rsh  170 171 )
 113      ( "<"     calcFunc-lt   160 161 )
 114      ( ">"     calcFunc-gt   160 161 )
 115      ( "<="    calcFunc-leq  160 161 )
 116      ( ">="    calcFunc-geq  160 161 )
 117      ( "=="    calcFunc-eq   150 151 )
 118      ( "!="    calcFunc-neq  150 151 )
 119      ( "&"     calcFunc-and  140 141 )
 120      ( "^"     calcFunc-xor  131 130 )
 121      ( "|"     calcFunc-or   120 121 )
 122      ( "&&"    calcFunc-land 110 111 )
 123      ( "||"    calcFunc-lor  100 101 )
 124      ( "?"     (math-read-if)  91  90 )
 125      ( "!!!"   calcFunc-pnot  -1  88 )
 126      ( "&&&"   calcFunc-pand  85  86 )
 127      ( "|||"   calcFunc-por   75  76 )
 128      ( "="     calcFunc-assign 51 50 )
 129      ( ":="    calcFunc-assign 51 50 )
 130      ( "::"    calcFunc-condition 45 46 ))) ; should support full assignments
 131
 132 (put 'c 'math-function-table
 133   '( ( acos        . calcFunc-arccos )
 134      ( acosh       . calcFunc-arccosh )
 135      ( asin        . calcFunc-arcsin )
 136      ( asinh       . calcFunc-arcsinh )
 137      ( atan        . calcFunc-arctan )
 138      ( atan2       . calcFunc-arctan2 )
 139      ( atanh       . calcFunc-arctanh )))
 140
 141 (put 'c 'math-variable-table
 142   '( ( M_PI        . var-pi )
 143      ( M_E         . var-e )))
 144
 145 (put 'c 'math-vector-brackets "{}")
 146
 147 (put 'c 'math-radix-formatter
 148      (function (lambda (r s)
 149                  (if (= r 16) (format "0x%s" s)
 150                    (if (= r 8) (format "0%s" s)
 151                      (format "%d#%s" r s))))))
 152
 153 (put 'c 'math-compose-subscr
 154      (function
 155       (lambda (a)
 156         (let ((args (cdr (cdr a))))
 157           (list 'horiz
 158                 (math-compose-expr (nth 1 a) 1000)
 159                 "["
 160                 (math-compose-vector args ", " 0)
 161                 "]")))))
 162
 163 (add-to-list 'calc-lang-slash-idiv 'c)
 164 (add-to-list 'calc-lang-allow-underscores 'c)
 165 (add-to-list 'calc-lang-c-type-hex 'c)
 166 (add-to-list 'calc-lang-brackets-are-subscripts 'c)
 167
 168 (defun calc-pascal-language (n)
 169   (interactive "P")
 170   (calc-wrapper
 171    (and n (setq n (prefix-numeric-value n)))
 172    (calc-set-language 'pascal n)
 173    (message (if (and n (/= n 0))
 174                 (if (> n 0)
 175                     "Pascal language mode (all uppercase)"
 176                   "Pascal language mode (all lowercase)")
 177               "Pascal language mode"))))
 178
 179 (put 'pascal 'math-oper-table
 180   '( ( "not"   calcFunc-lnot -1 1000 )
 181      ( "*"     *             190 191 )
 182      ( "/"     /             190 191 )
 183      ( "and"   calcFunc-and  190 191 )
 184      ( "div"   calcFunc-idiv 190 191 )
 185      ( "mod"   %             190 191 )
 186      ( "u+"    ident         -1  185 )
 187      ( "u-"    neg           -1  185 )
 188      ( "+"     +             180 181 )
 189      ( "-"     -             180 181 )
 190      ( "or"    calcFunc-or   180 181 )
 191      ( "xor"   calcFunc-xor  180 181 )
 192      ( "shl"   calcFunc-lsh  180 181 )
 193      ( "shr"   calcFunc-rsh  180 181 )
 194      ( "in"    calcFunc-in   160 161 )
 195      ( "<"     calcFunc-lt   160 161 )
 196      ( ">"     calcFunc-gt   160 161 )
 197      ( "<="    calcFunc-leq  160 161 )
 198      ( ">="    calcFunc-geq  160 161 )
 199      ( "="     calcFunc-eq   160 161 )
 200      ( "<>"    calcFunc-neq  160 161 )
 201      ( "!!!"   calcFunc-pnot  -1  85 )
 202      ( "&&&"   calcFunc-pand  80  81 )
 203      ( "|||"   calcFunc-por   75  76 )
 204      ( ":="    calcFunc-assign 51 50 )
 205      ( "::"    calcFunc-condition 45 46 )))
 206
 207 (put 'pascal 'math-input-filter 'calc-input-case-filter)
 208 (put 'pascal 'math-output-filter 'calc-output-case-filter)
 209
 210 (put 'pascal 'math-radix-formatter
 211      (function (lambda (r s)
 212                  (if (= r 16) (format "$%s" s)
 213                    (format "%d#%s" r s)))))
 214
 215 (put 'pascal 'math-lang-read-symbol
 216      '((?\$
 217         (eq (string-match
 218              "\\(\\$[0-9a-fA-F]+\\)\\($\\|[^0-9a-zA-Z]\\)"
 219              math-exp-str math-exp-pos)
 220             math-exp-pos)
 221         (setq math-exp-token 'number
 222               math-expr-data (math-match-substring math-exp-str 1)
 223               math-exp-pos (match-end 1)))))
 224
 225 (put 'pascal 'math-compose-subscr
 226      (function
 227       (lambda (a)
 228         (let ((args (cdr (cdr a))))
 229           (while (eq (car-safe (nth 1 a)) 'calcFunc-subscr)
 230             (setq args (append (cdr (cdr (nth 1 a))) args)
 231                   a (nth 1 a)))
 232           (list 'horiz
 233                 (math-compose-expr (nth 1 a) 1000)
 234                 "["
 235                 (math-compose-vector args ", " 0)
 236                 "]")))))
 237
 238 (add-to-list 'calc-lang-allow-underscores 'pascal)
 239 (add-to-list 'calc-lang-brackets-are-subscripts 'pascal)
 240
 241 (defun calc-input-case-filter (str)
 242   (cond ((or (null calc-language-option) (= calc-language-option 0))
 243          str)
 244         (t
 245          (downcase str))))
 246
 247 (defun calc-output-case-filter (str)
 248   (cond ((or (null calc-language-option) (= calc-language-option 0))
 249          str)
 250         ((> calc-language-option 0)
 251          (upcase str))
 252         (t
 253          (downcase str))))
 254
 255
 256 (defun calc-fortran-language (n)
 257   (interactive "P")
 258   (calc-wrapper
 259    (and n (setq n (prefix-numeric-value n)))
 260    (calc-set-language 'fortran n)
 261    (message (if (and n (/= n 0))
 262                 (if (> n 0)
 263                     "FORTRAN language mode (all uppercase)"
 264                   "FORTRAN language mode (all lowercase)")
 265               "FORTRAN language mode"))))
 266
 267 (put 'fortran 'math-oper-table
 268   '( ( "u/"    (math-parse-fortran-vector) -1 1 )
 269      ( "/"     (math-parse-fortran-vector-end) 1 -1 )
 270      ( "**"    ^             201 200 )
 271      ( "u+"    ident         -1  191 )
 272      ( "u-"    neg           -1  191 )
 273      ( "*"     *             190 191 )
 274      ( "/"     /             190 191 )
 275      ( "+"     +             180 181 )
 276      ( "-"     -             180 181 )
 277      ( ".LT."  calcFunc-lt   160 161 )
 278      ( ".GT."  calcFunc-gt   160 161 )
 279      ( ".LE."  calcFunc-leq  160 161 )
 280      ( ".GE."  calcFunc-geq  160 161 )
 281      ( ".EQ."  calcFunc-eq   160 161 )
 282      ( ".NE."  calcFunc-neq  160 161 )
 283      ( ".NOT." calcFunc-lnot -1  121 )
 284      ( ".AND." calcFunc-land 110 111 )
 285      ( ".OR."  calcFunc-lor  100 101 )
 286      ( "!!!"   calcFunc-pnot  -1  85 )
 287      ( "&&&"   calcFunc-pand  80  81 )
 288      ( "|||"   calcFunc-por   75  76 )
 289      ( "="     calcFunc-assign 51 50 )
 290      ( ":="    calcFunc-assign 51 50 )
 291      ( "::"    calcFunc-condition 45 46 )))
 292
 293 (put 'fortran 'math-vector-brackets "//")
 294
 295 (put 'fortran 'math-function-table
 296   '( ( acos        . calcFunc-arccos )
 297      ( acosh       . calcFunc-arccosh )
 298      ( aimag       . calcFunc-im )
 299      ( aint        . calcFunc-ftrunc )
 300      ( asin        . calcFunc-arcsin )
 301      ( asinh       . calcFunc-arcsinh )
 302      ( atan        . calcFunc-arctan )
 303      ( atan2       . calcFunc-arctan2 )
 304      ( atanh       . calcFunc-arctanh )
 305      ( conjg       . calcFunc-conj )
 306      ( log         . calcFunc-ln )
 307      ( nint        . calcFunc-round )
 308      ( real        . calcFunc-re )))
 309
 310 (put 'fortran 'math-input-filter 'calc-input-case-filter)
 311
 312 (put 'fortran 'math-output-filter 'calc-output-case-filter)
 313
 314 (put 'fortran 'math-lang-read-symbol
 315      '((?\.
 316         (eq (string-match "\\.[a-zA-Z][a-zA-Z][a-zA-Z]?\\."
 317                           math-exp-str math-exp-pos) math-exp-pos)
 318         (setq math-exp-token 'punc
 319               math-expr-data (upcase (math-match-substring math-exp-str 0))
 320               math-exp-pos (match-end 0)))))
 321
 322 (put 'fortran 'math-compose-subscr
 323      (function
 324       (lambda (a)
 325         (let ((args (cdr (cdr a))))
 326           (while (eq (car-safe (nth 1 a)) 'calcFunc-subscr)
 327             (setq args (append (cdr (cdr (nth 1 a))) args)
 328                   a (nth 1 a)))
 329           (list 'horiz
 330                 (math-compose-expr (nth 1 a) 1000)
 331                 "("
 332                 (math-compose-vector args ", " 0)
 333                 ")")))))
 334
 335 (add-to-list 'calc-lang-slash-idiv 'fortran)
 336 (add-to-list 'calc-lang-allow-underscores 'fortran)
 337 (add-to-list 'calc-lang-parens-are-subscripts 'fortran)
 338
 339 ;; The next few variables are local to math-read-exprs in calc-aent.el
 340 ;; and math-read-expr in calc-ext.el, but are set in functions they call.
 341
 342 (defvar math-exp-token)
 343 (defvar math-expr-data)
 344 (defvar math-exp-old-pos)
 345
 346 (defvar math-parsing-fortran-vector nil)
 347 (defun math-parse-fortran-vector (op)
 348   (let ((math-parsing-fortran-vector '(end . "\000")))
 349     (prog1
 350         (math-read-brackets t "]")
 351       (setq math-exp-token (car math-parsing-fortran-vector)
 352             math-expr-data (cdr math-parsing-fortran-vector)))))
 353
 354 (defun math-parse-fortran-vector-end (x op)
 355   (if math-parsing-fortran-vector
 356       (progn
 357         (setq math-parsing-fortran-vector (cons math-exp-token math-expr-data)
 358               math-exp-token 'end
 359               math-expr-data "\000")
 360         x)
 361     (throw 'syntax "Unmatched closing `/'")))
 362
 363 (defun math-parse-fortran-subscr (sym args)
 364   (setq sym (math-build-var-name sym))
 365   (while args
 366     (setq sym (list 'calcFunc-subscr sym (car args))
 367           args (cdr args)))
 368   sym)
 369
 370
 371 (defun calc-tex-language (n)
 372   (interactive "P")
 373   (calc-wrapper
 374    (and n (setq n (prefix-numeric-value n)))
 375    (calc-set-language 'tex n)
 376    (cond ((not n)
 377           (message "TeX language mode"))
 378          ((= n 0)
 379           (message "TeX language mode with multiline matrices"))
 380          ((= n 1)
 381           (message "TeX language mode with \\hbox{func}(\\hbox{var})"))
 382          ((> n 1)
 383           (message
 384            "TeX language mode with \\hbox{func}(\\hbox{var}) and multiline matrices"))
 385          ((= n -1)
 386           (message "TeX language mode with \\func(\\hbox{var})"))
 387          ((< n -1)
 388           (message
 389            "TeX language mode with \\func(\\hbox{var}) and multiline matrices")))))
 390
 391 (defun calc-latex-language (n)
 392   (interactive "P")
 393   (calc-wrapper
 394    (and n (setq n (prefix-numeric-value n)))
 395    (calc-set-language 'latex n)
 396    (cond ((not n)
 397           (message "LaTeX language mode"))
 398          ((= n 0)
 399           (message "LaTeX language mode with multiline matrices"))
 400          ((= n 1)
 401           (message "LaTeX language mode with \\text{func}(\\text{var})"))
 402          ((> n 1)
 403           (message
 404            "LaTeX language mode with \\text{func}(\\text{var}) and multiline matrices"))
 405          ((= n -1)
 406           (message "LaTeX language mode with \\func(\\text{var})"))
 407          ((< n -1)
 408           (message
 409            "LaTeX language mode with \\func(\\text{var}) and multiline matrices")))))
 410
 411 (put 'tex 'math-oper-table
 412   '( ( "\\hat"    calcFunc-hat     -1  950 )
 413      ( "\\check"  calcFunc-check   -1  950 )
 414      ( "\\tilde"  calcFunc-tilde   -1  950 )
 415      ( "\\acute"  calcFunc-acute   -1  950 )
 416      ( "\\grave"  calcFunc-grave   -1  950 )
 417      ( "\\dot"    calcFunc-dot     -1  950 )
 418      ( "\\ddot"   calcFunc-dotdot  -1  950 )
 419      ( "\\breve"  calcFunc-breve   -1  950 )
 420      ( "\\bar"    calcFunc-bar     -1  950 )
 421      ( "\\vec"    calcFunc-Vec     -1  950 )
 422      ( "\\underline" calcFunc-under -1  950 )
 423      ( "u|"       calcFunc-abs     -1    0 )
 424      ( "|"        closing           0   -1 )
 425      ( "\\lfloor" calcFunc-floor   -1    0 )
 426      ( "\\rfloor" closing           0   -1 )
 427      ( "\\lceil"  calcFunc-ceil    -1    0 )
 428      ( "\\rceil"  closing           0   -1 )
 429      ( "\\pm"     sdev             300 300 )
 430      ( "!"        calcFunc-fact    210  -1 )
 431      ( "^"        ^                201 200 )
 432      ( "_"        calcFunc-subscr  201 200 )
 433      ( "u+"       ident            -1  197 )
 434      ( "u-"       neg              -1  197 )
 435      ( "\\times"  *                191 190 )
 436      ( "*"        *                191 190 )
 437      ( "2x"       *                191 190 )
 438      ( "+"        +                180 181 )
 439      ( "-"        -                180 181 )
 440      ( "\\over"   /                170 171 )
 441      ( "/"        /                170 171 )
 442      ( "\\choose" calcFunc-choose  170 171 )
 443      ( "\\mod"    %                170 171 )
 444      ( "<"        calcFunc-lt      160 161 )
 445      ( ">"        calcFunc-gt      160 161 )
 446      ( "\\leq"    calcFunc-leq     160 161 )
 447      ( "\\geq"    calcFunc-geq     160 161 )
 448      ( "="        calcFunc-eq      160 161 )
 449      ( "\\neq"    calcFunc-neq     160 161 )
 450      ( "\\ne"     calcFunc-neq     160 161 )
 451      ( "\\lnot"   calcFunc-lnot     -1 121 )
 452      ( "\\land"   calcFunc-land    110 111 )
 453      ( "\\lor"    calcFunc-lor     100 101 )
 454      ( "?"        (math-read-if)    91  90 )
 455      ( "!!!"      calcFunc-pnot     -1  85 )
 456      ( "&&&"      calcFunc-pand     80  81 )
 457      ( "|||"      calcFunc-por      75  76 )
 458      ( "\\gets"   calcFunc-assign   51  50 )
 459      ( ":="       calcFunc-assign   51  50 )
 460      ( "::"       calcFunc-condition 45 46 )
 461      ( "\\to"     calcFunc-evalto   40  41 )
 462      ( "\\to"     calcFunc-evalto   40  -1 )
 463      ( "=>"       calcFunc-evalto   40  41 )
 464      ( "=>"       calcFunc-evalto   40  -1 )))
 465
 466 (put 'tex 'math-function-table
 467   '( ( \\arccos    . calcFunc-arccos )
 468      ( \\arcsin    . calcFunc-arcsin )
 469      ( \\arctan    . calcFunc-arctan )
 470      ( \\arg       . calcFunc-arg )
 471      ( \\cos       . calcFunc-cos )
 472      ( \\cosh      . calcFunc-cosh )
 473      ( \\cot       . calcFunc-cot )
 474      ( \\coth      . calcFunc-coth )
 475      ( \\csc       . calcFunc-csc )
 476      ( \\det       . calcFunc-det )
 477      ( \\exp       . calcFunc-exp )
 478      ( \\gcd       . calcFunc-gcd )
 479      ( \\ln        . calcFunc-ln )
 480      ( \\log       . calcFunc-log10 )
 481      ( \\max       . calcFunc-max )
 482      ( \\min       . calcFunc-min )
 483      ( \\sec       . calcFunc-sec )
 484      ( \\sin       . calcFunc-sin )
 485      ( \\sinh      . calcFunc-sinh )
 486      ( \\sqrt      . calcFunc-sqrt )
 487      ( \\tan       . calcFunc-tan )
 488      ( \\tanh      . calcFunc-tanh )
 489      ( \\phi       . calcFunc-totient )
 490      ( \\mu        . calcFunc-moebius )))
 491
 492 (put 'tex 'math-special-function-table
 493      '((calcFunc-sum . (math-compose-tex-sum "\\sum"))
 494        (calcFunc-prod . (math-compose-tex-sum "\\prod"))
 495        (intv . math-compose-tex-intv)))
 496
 497 (put 'tex 'math-variable-table
 498   '(
 499     ;; The Greek letters
 500     ( \\alpha      . var-alpha )
 501     ( \\beta       . var-beta  )
 502     ( \\gamma      . var-gamma )
 503     ( \\Gamma      . var-Gamma )
 504     ( \\delta      . var-delta )
 505     ( \\Delta      . var-Delta )
 506     ( \\epsilon    . var-epsilon )
 507     ( \\varepsilon . var-varepsilon)
 508     ( \\zeta       . var-zeta )
 509     ( \\eta        . var-eta  )
 510     ( \\theta      . var-theta )
 511     ( \\vartheta   . var-vartheta )
 512     ( \\Theta      . var-Theta )
 513     ( \\iota       . var-iota )
 514     ( \\kappa      . var-kappa )
 515     ( \\lambda     . var-lambda )
 516     ( \\Lambda     . var-Lambda )
 517     ( \\mu         . var-mu )
 518     ( \\nu         . var-nu )
 519     ( \\xi         . var-xi )
 520     ( \\Xi         . var-Xi )
 521     ( \\pi         . var-pi )
 522     ( \\varpi      . var-varpi )
 523     ( \\Pi         . var-Pi )
 524     ( \\rho        . var-rho )
 525     ( \\varrho     . var-varrho )
 526     ( \\sigma      . var-sigma )
 527     ( \\sigma      . var-varsigma )
 528     ( \\Sigma      . var-Sigma )
 529     ( \\tau        . var-tau )
 530     ( \\upsilon    . var-upsilon )
 531     ( \\Upsilon    . var-Upsilon )
 532     ( \\phi        . var-phi )
 533     ( \\varphi     . var-varphi )
 534     ( \\Phi        . var-Phi )
 535     ( \\chi        . var-chi )
 536     ( \\psi        . var-psi )
 537     ( \\Psi        . var-Psi )
 538     ( \\omega      . var-omega )
 539     ( \\Omega      . var-Omega )
 540     ;; Others
 541     ( \\ell        . var-ell )
 542     ( \\infty      . var-inf )
 543     ( \\infty      . var-uinf )
 544     ( \\sum        . (math-parse-tex-sum calcFunc-sum) )
 545     ( \\prod       . (math-parse-tex-sum calcFunc-prod) )))
 546
 547 (put 'tex 'math-punc-table
 548      '((?\{ . ?\()
 549        (?\} . ?\))
 550        (?\& . ?\,)))
 551
 552 (put 'tex 'math-complex-format 'i)
 553
 554 (put 'tex 'math-input-filter 'math-tex-input-filter)
 555
 556 (put 'tex 'math-matrix-formatter
 557      (function
 558       (lambda (a)
 559         (if (and (integerp calc-language-option)
 560                  (or (= calc-language-option 0)
 561                      (> calc-language-option 1)
 562                      (< calc-language-option -1)))
 563             (append '(vleft 0 "\\matrix{")
 564                     (math-compose-tex-matrix (cdr a))
 565                     '("}"))
 566           (append '(horiz "\\matrix{ ")
 567                   (math-compose-tex-matrix (cdr a))
 568                   '(" }"))))))
 569
 570 (put 'tex 'math-var-formatter 'math-compose-tex-var)
 571
 572 (put 'tex 'math-func-formatter 'math-compose-tex-func)
 573
 574 (put 'tex 'math-dots "\\ldots")
 575
 576 (put 'tex 'math-big-parens '("\\left( " . " \\right)"))
 577
 578 (put 'tex 'math-evalto '("\\evalto " . " \\to "))
 579
 580 (defconst math-tex-ignore-words
 581   '( ("\\hbox") ("\\mbox") ("\\text") ("\\left") ("\\right")
 582      ("\\,") ("\\>") ("\\:") ("\\;") ("\\!") ("\\ ")
 583      ("\\quad") ("\\qquad") ("\\hfil") ("\\hfill")
 584      ("\\displaystyle") ("\\textstyle") ("\\dsize") ("\\tsize")
 585      ("\\scriptstyle") ("\\scriptscriptstyle") ("\\ssize") ("\\sssize")
 586      ("\\rm") ("\\bf") ("\\it") ("\\sl")
 587      ("\\roman") ("\\bold") ("\\italic") ("\\slanted")
 588      ("\\cal") ("\\mit") ("\\Cal") ("\\Bbb") ("\\frak") ("\\goth")
 589      ("\\evalto")
 590      ("\\matrix" mat) ("\\bmatrix" mat) ("\\pmatrix" mat)
 591      ("\\begin" begenv)
 592      ("\\cr" punc ";") ("\\\\" punc ";") ("\\*" punc "*")
 593      ("\\{" punc "[") ("\\}" punc "]")))
 594
 595 (defconst math-latex-ignore-words
 596   (append math-tex-ignore-words
 597           '(("\\begin" begenv))))
 598
 599 (put 'tex 'math-lang-read-symbol
 600      '((?\\
 601         (< math-exp-pos (1- (length math-exp-str)))
 602         (progn
 603           (or (string-match "\\\\hbox *{\\([a-zA-Z0-9]+\\)}"
 604                             math-exp-str math-exp-pos)
 605               (string-match "\\(\\\\\\([a-zA-Z]+\\|[^a-zA-Z]\\)\\)"
 606                             math-exp-str math-exp-pos))
 607           (setq math-exp-token 'symbol
 608                 math-exp-pos (match-end 0)
 609                 math-expr-data (math-restore-dashes
 610                                 (math-match-substring math-exp-str 1)))
 611           (let ((code (assoc math-expr-data math-latex-ignore-words)))
 612             (cond ((null code))
 613                   ((null (cdr code))
 614                    (math-read-token))
 615                   ((eq (nth 1 code) 'punc)
 616                    (setq math-exp-token 'punc
 617                          math-expr-data (nth 2 code)))
 618                   ((and (eq (nth 1 code) 'mat)
 619                         (string-match " *{" math-exp-str math-exp-pos))
 620                    (setq math-exp-pos (match-end 0)
 621                          math-exp-token 'punc
 622                          math-expr-data "[")
 623                    (let ((right (string-match "}" math-exp-str math-exp-pos)))
 624                      (and right
 625                           (setq math-exp-str (copy-sequence math-exp-str))
 626                           (aset math-exp-str right ?\]))))))))))
 627
 628 (defun math-compose-tex-matrix (a &optional ltx)
 629   (if (cdr a)
 630       (cons (append (math-compose-vector (cdr (car a)) " & " 0)
 631                     (if ltx '(" \\\\ ") '(" \\cr ")))
 632             (math-compose-tex-matrix (cdr a) ltx))
 633     (list (math-compose-vector (cdr (car a)) " & " 0))))
 634
 635 (defun math-compose-tex-sum (a fn)
 636   (cond
 637    ((nth 4 a)
 638     (list 'horiz (nth 1 fn)
 639           "_{" (math-compose-expr (nth 2 a) 0)
 640           "=" (math-compose-expr (nth 3 a) 0)
 641           "}^{" (math-compose-expr (nth 4 a) 0)
 642           "}{" (math-compose-expr (nth 1 a) 0) "}"))
 643    ((nth 3 a)
 644     (list 'horiz (nth 1 fn)
 645           "_{" (math-compose-expr (nth 2 a) 0)
 646           "=" (math-compose-expr (nth 3 a) 0)
 647           "}{" (math-compose-expr (nth 1 a) 0) "}"))
 648    (t
 649     (list 'horiz (nth 1 fn)
 650           "_{" (math-compose-expr (nth 2 a) 0)
 651           "}{" (math-compose-expr (nth 1 a) 0) "}"))))
 652
 653 (defun math-parse-tex-sum (f val)
 654   (let (low high save)
 655     (or (equal math-expr-data "_") (throw 'syntax "Expected `_'"))
 656     (math-read-token)
 657     (setq save math-exp-old-pos)
 658     (setq low (math-read-factor))
 659     (or (eq (car-safe low) 'calcFunc-eq)
 660         (progn
 661           (setq math-exp-old-pos (1+ save))
 662           (throw 'syntax "Expected equation")))
 663     (or (equal math-expr-data "^") (throw 'syntax "Expected `^'"))
 664     (math-read-token)
 665     (setq high (math-read-factor))
 666     (list (nth 2 f) (math-read-factor) (nth 1 low) (nth 2 low) high)))
 667
 668 (defun math-tex-input-filter (str)   ; allow parsing of 123\,456\,789.
 669   (while (string-match "[0-9]\\\\,[0-9]" str)
 670     (setq str (concat (substring str 0 (1+ (match-beginning 0)))
 671                       (substring str (1- (match-end 0))))))
 672   str)
 673
 674 ;(defun math-tex-print-sqrt (a)
 675 ;  (list 'horiz
 676 ;        "\\sqrt{"
 677 ;        (math-compose-expr (nth 1 a) 0)
 678 ;        "}"))
 679
 680 (defun math-compose-tex-intv (a)
 681   (list 'horiz
 682         (if (memq (nth 1 a) '(0 1)) "(" "[")
 683         (math-compose-expr (nth 2 a) 0)
 684         " \\ldots "
 685         (math-compose-expr (nth 3 a) 0)
 686         (if (memq (nth 1 a) '(0 2)) ")" "]")))
 687
 688 (defun math-compose-tex-var (a v prec)
 689   (if (and calc-language-option
 690            (not (= calc-language-option 0))
 691            (string-match "\\`[a-zA-Z][a-zA-Z0-9]+\\'"
 692                          (symbol-name (nth 1 a))))
 693       (if (eq calc-language 'latex)
 694           (format "\\text{%s}" (symbol-name (nth 1 a)))
 695         (format "\\hbox{%s}" (symbol-name (nth 1 a))))
 696     (math-compose-var a v)))
 697
 698 (defun math-compose-tex-func (func a)
 699   (let (left right)
 700     (if (and calc-language-option
 701              (not (= calc-language-option 0))
 702              (string-match "\\`[a-zA-Z][a-zA-Z0-9]+\\'" func))
 703         (if (< (prefix-numeric-value calc-language-option) 0)
 704             (setq func (format "\\%s" func))
 705           (setq func (if (eq calc-language 'latex)
 706                          (format "\\text{%s}" func)
 707                        (format "\\hbox{%s}" func)))))
 708     (cond ((or (> (length a) 2)
 709                (not (math-tex-expr-is-flat (nth 1 a))))
 710            (setq left "\\left( "
 711                  right " \\right)"))
 712           ((and (eq (aref func 0) ?\\)
 713                 (not (or
 714                       (string-match "\\hbox{" func)
 715                       (string-match "\\text{" func)))
 716                 (= (length a) 2)
 717                 (or (Math-realp (nth 1 a))
 718                     (memq (car (nth 1 a)) '(var *))))
 719            (setq left "{" right "}"))
 720           (t (setq left calc-function-open
 721                    right calc-function-close)))
 722     (list 'horiz func
 723           left
 724           (math-compose-vector (cdr a) ", " 0)
 725           right)))
 726
 727 (put 'latex 'math-oper-table
 728      (append (get 'tex 'math-oper-table)
 729              '(( "\\Hat"    calcFunc-Hat     -1  950 )
 730                ( "\\Check"  calcFunc-Check   -1  950 )
 731                ( "\\Tilde"  calcFunc-Tilde   -1  950 )
 732                ( "\\Acute"  calcFunc-Acute   -1  950 )
 733                ( "\\Grave"  calcFunc-Grave   -1  950 )
 734                ( "\\Dot"    calcFunc-Dot     -1  950 )
 735                ( "\\Ddot"   calcFunc-Dotdot  -1  950 )
 736                ( "\\Breve"  calcFunc-Breve   -1  950 )
 737                ( "\\Bar"    calcFunc-Bar     -1  950 )
 738                ( "\\Vec"    calcFunc-VEC     -1  950 )
 739                ( "\\dddot"  calcFunc-dddot   -1  950 )
 740                ( "\\ddddot" calcFunc-ddddot  -1  950 )
 741                ( "\\div"     /                170 171 )
 742                ( "\\le"     calcFunc-leq     160 161 )
 743                ( "\\leqq"   calcFunc-leq     160 161 )
 744                ( "\\leqsland" calcFunc-leq   160 161 )
 745                ( "\\ge"     calcFunc-geq     160 161 )
 746                ( "\\geqq"   calcFunc-geq     160 161 )
 747                ( "\\geqslant" calcFunc-geq   160 161 )
 748                ( "="        calcFunc-eq      160 161 )
 749                ( "\\neq"    calcFunc-neq     160 161 )
 750                ( "\\ne"     calcFunc-neq     160 161 )
 751                ( "\\lnot"   calcFunc-lnot     -1 121 )
 752                ( "\\land"   calcFunc-land    110 111 )
 753                ( "\\lor"    calcFunc-lor     100 101 )
 754                ( "?"        (math-read-if)    91  90 )
 755                ( "!!!"      calcFunc-pnot     -1  85 )
 756                ( "&&&"      calcFunc-pand     80  81 )
 757                ( "|||"      calcFunc-por      75  76 )
 758                ( "\\gets"   calcFunc-assign   51  50 )
 759                ( ":="       calcFunc-assign   51  50 )
 760                ( "::"       calcFunc-condition 45 46 )
 761                ( "\\to"     calcFunc-evalto   40  41 )
 762                ( "\\to"     calcFunc-evalto   40  -1 )
 763                ( "=>"       calcFunc-evalto   40  41 )
 764                ( "=>"       calcFunc-evalto   40  -1 ))))
 765
 766 (put 'latex 'math-function-table
 767      (append
 768       (get 'tex 'math-function-table)
 769       '(( \\frac      . (math-latex-parse-frac))
 770         ( \\tfrac     . (math-latex-parse-frac))
 771         ( \\dfrac     . (math-latex-parse-frac))
 772         ( \\binom     . (math-latex-parse-two-args calcFunc-choose))
 773         ( \\tbinom    . (math-latex-parse-two-args calcFunc-choose))
 774         ( \\dbinom    . (math-latex-parse-two-args calcFunc-choose))
 775         ( \\phi       . calcFunc-totient )
 776         ( \\mu        . calcFunc-moebius ))))
 777
 778 (put 'latex 'math-special-function-table
 779      '((/               . (math-compose-latex-frac "\\frac"))
 780        (calcFunc-choose . (math-compose-latex-frac "\\binom"))
 781        (calcFunc-sum . (math-compose-tex-sum "\\sum"))
 782        (calcFunc-prod . (math-compose-tex-sum "\\prod"))
 783        (intv          . math-compose-tex-intv)))
 784
 785 (put 'latex 'math-variable-table
 786      (get 'tex 'math-variable-table))
 787
 788 (put 'latex 'math-punc-table
 789      '((?\{ . ?\()
 790        (?\} . ?\))
 791        (?\& . ?\,)))
 792
 793 (put 'latex 'math-complex-format 'i)
 794
 795 (put 'latex 'math-matrix-formatter
 796      (function
 797       (lambda (a)
 798         (if (and (integerp calc-language-option)
 799                  (or (= calc-language-option 0)
 800                      (> calc-language-option 1)
 801                      (< calc-language-option -1)))
 802             (append '(vleft 0 "\\begin{pmatrix}")
 803                     (math-compose-tex-matrix (cdr a) t)
 804                     '("\\end{pmatrix}"))
 805           (append '(horiz "\\begin{pmatrix} ")
 806                   (math-compose-tex-matrix (cdr a) t)
 807                   '(" \\end{pmatrix}"))))))
 808
 809 (put 'latex 'math-var-formatter 'math-compose-tex-var)
 810
 811 (put 'latex 'math-func-formatter 'math-compose-tex-func)
 812
 813 (put 'latex 'math-dots "\\ldots")
 814
 815 (put 'latex 'math-big-parens '("\\left( " . " \\right)"))
 816
 817 (put 'latex 'math-evalto '("\\evalto " . " \\to "))
 818
 819 (put 'latex 'math-lang-read-symbol
 820      '((?\\
 821         (< math-exp-pos (1- (length math-exp-str)))
 822         (progn
 823           (or (string-match "\\\\hbox *{\\([a-zA-Z0-9]+\\)}"
 824                             math-exp-str math-exp-pos)
 825               (string-match "\\\\text *{\\([a-zA-Z0-9]+\\)}"
 826                             math-exp-str math-exp-pos)
 827               (string-match "\\(\\\\\\([a-zA-Z]+\\|[^a-zA-Z]\\)\\)"
 828                             math-exp-str math-exp-pos))
 829           (setq math-exp-token 'symbol
 830                 math-exp-pos (match-end 0)
 831                 math-expr-data (math-restore-dashes
 832                                 (math-match-substring math-exp-str 1)))
 833           (let ((code (assoc math-expr-data math-tex-ignore-words))
 834                 envname)
 835             (cond ((null code))
 836                   ((null (cdr code))
 837                    (math-read-token))
 838                   ((eq (nth 1 code) 'punc)
 839                    (setq math-exp-token 'punc
 840                          math-expr-data (nth 2 code)))
 841                   ((and (eq (nth 1 code) 'begenv)
 842                         (string-match " *{\\([^}]*\\)}" math-exp-str math-exp-pos))
 843                    (setq math-exp-pos (match-end 0)
 844                          envname (match-string 1 math-exp-str)
 845                          math-exp-token 'punc
 846                          math-expr-data "[")
 847                    (cond ((or (string= envname "matrix")
 848                               (string= envname "bmatrix")
 849                               (string= envname "smallmatrix")
 850                               (string= envname "pmatrix"))
 851                           (if (string-match (concat "\\\\end{" envname "}")
 852                                             math-exp-str math-exp-pos)
 853                               (setq math-exp-str
 854                                     (replace-match "]" t t math-exp-str))
 855                             (error "%s" (concat "No closing \\end{" envname "}"))))))
 856                   ((and (eq (nth 1 code) 'mat)
 857                         (string-match " *{" math-exp-str math-exp-pos))
 858                    (setq math-exp-pos (match-end 0)
 859                          math-exp-token 'punc
 860                          math-expr-data "[")
 861                    (let ((right (string-match "}" math-exp-str math-exp-pos)))
 862                      (and right
 863                           (setq math-exp-str (copy-sequence math-exp-str))
 864                           (aset math-exp-str right ?\]))))))))))
 865
 866 (defun math-latex-parse-frac (f val)
 867   (let (numer denom)
 868     (setq numer (car (math-read-expr-list)))
 869     (math-read-token)
 870     (setq denom (math-read-factor))
 871     (if (and (Math-num-integerp numer)
 872              (Math-num-integerp denom))
 873         (list 'frac numer denom)
 874       (list '/ numer denom))))
 875
 876 (defun math-latex-parse-two-args (f val)
 877   (let (first second)
 878     (setq first (car (math-read-expr-list)))
 879     (math-read-token)
 880     (setq second (math-read-factor))
 881     (list (nth 2 f) first second)))
 882
 883 (defun math-compose-latex-frac (a fn)
 884   (list 'horiz (nth 1 fn) "{" (math-compose-expr (nth 1 a) -1)
 885                "}{"
 886                (math-compose-expr (nth 2 a) -1)
 887                "}"))
 888
 889 (put 'latex 'math-input-filter 'math-tex-input-filter)
 890
 891 (defun calc-eqn-language (n)
 892   (interactive "P")
 893   (calc-wrapper
 894    (calc-set-language 'eqn)
 895    (message "Eqn language mode")))
 896
 897 (put 'eqn 'math-oper-table
 898   '( ( "prime"    (math-parse-eqn-prime) 950  -1 )
 899      ( "prime"    calcFunc-Prime   950  -1 )
 900      ( "dot"      calcFunc-dot     950  -1 )
 901      ( "dotdot"   calcFunc-dotdot  950  -1 )
 902      ( "hat"      calcFunc-hat     950  -1 )
 903      ( "tilde"    calcFunc-tilde   950  -1 )
 904      ( "vec"      calcFunc-Vec     950  -1 )
 905      ( "dyad"     calcFunc-dyad    950  -1 )
 906      ( "bar"      calcFunc-bar     950  -1 )
 907      ( "under"    calcFunc-under   950  -1 )
 908      ( "sub"      calcFunc-subscr  931 930 )
 909      ( "sup"      ^                921 920 )
 910      ( "sqrt"     calcFunc-sqrt    -1  910 )
 911      ( "over"     /                900 901 )
 912      ( "u|"       calcFunc-abs     -1    0 )
 913      ( "|"        closing           0   -1 )
 914      ( "left floor"  calcFunc-floor -1   0 )
 915      ( "right floor" closing        0   -1 )
 916      ( "left ceil"   calcFunc-ceil  -1   0 )
 917      ( "right ceil"  closing        0   -1 )
 918      ( "+-"       sdev             300 300 )
 919      ( "!"        calcFunc-fact    210  -1 )
 920      ( "u+"       ident            -1  197 )
 921      ( "u-"       neg              -1  197 )
 922      ( "times"    *                191 190 )
 923      ( "*"        *                191 190 )
 924      ( "2x"       *                191 190 )
 925      ( "/"        /                180 181 )
 926      ( "%"        %                180 181 )
 927      ( "+"        +                170 171 )
 928      ( "-"        -                170 171 )
 929      ( "<"        calcFunc-lt      160 161 )
 930      ( ">"        calcFunc-gt      160 161 )
 931      ( "<="       calcFunc-leq     160 161 )
 932      ( ">="       calcFunc-geq     160 161 )
 933      ( "="        calcFunc-eq      160 161 )
 934      ( "=="       calcFunc-eq      160 161 )
 935      ( "!="       calcFunc-neq     160 161 )
 936      ( "u!"       calcFunc-lnot     -1 121 )
 937      ( "&&"       calcFunc-land    110 111 )
 938      ( "||"       calcFunc-lor     100 101 )
 939      ( "?"        (math-read-if)    91  90 )
 940      ( "!!!"      calcFunc-pnot     -1  85 )
 941      ( "&&&"      calcFunc-pand     80  81 )
 942      ( "|||"      calcFunc-por      75  76 )
 943      ( "<-"       calcFunc-assign   51  50 )
 944      ( ":="       calcFunc-assign   51  50 )
 945      ( "::"       calcFunc-condition 45 46 )
 946      ( "->"       calcFunc-evalto   40  41 )
 947      ( "->"       calcFunc-evalto   40  -1 )
 948      ( "=>"       calcFunc-evalto   40  41 )
 949      ( "=>"       calcFunc-evalto   40  -1 )))
 950
 951 (put 'eqn 'math-function-table
 952   '( ( arc\ cos    . calcFunc-arccos )
 953      ( arc\ cosh   . calcFunc-arccosh )
 954      ( arc\ sin    . calcFunc-arcsin )
 955      ( arc\ sinh   . calcFunc-arcsinh )
 956      ( arc\ tan    . calcFunc-arctan )
 957      ( arc\ tanh   . calcFunc-arctanh )
 958      ( GAMMA       . calcFunc-gamma )
 959      ( phi         . calcFunc-totient )
 960      ( mu          . calcFunc-moebius )
 961      ( matrix      . (math-parse-eqn-matrix) )))
 962
 963 (put 'eqn 'math-special-function-table
 964      '((intv . math-compose-eqn-intv)))
 965
 966 (put 'eqn 'math-punc-table
 967      '((?\{ . ?\()
 968        (?\} . ?\))))
 969
 970 (put 'eqn 'math-variable-table
 971   '( ( inf         . var-uinf )))
 972
 973 (put 'eqn 'math-complex-format 'i)
 974
 975 (put 'eqn 'math-big-parens '("{left ( " . " right )}"))
 976
 977 (put 'eqn 'math-evalto '("evalto " . " -> "))
 978
 979 (put 'eqn 'math-matrix-formatter
 980      (function
 981       (lambda (a)
 982         (append '(horiz "matrix { ")
 983                 (math-compose-eqn-matrix
 984                  (cdr (math-transpose a)))
 985                 '("}")))))
 986
 987 (put 'eqn 'math-var-formatter
 988      (function
 989       (lambda (a v prec)
 990         (if (and math-compose-hash-args
 991                  (let ((p calc-arg-values))
 992                    (setq v 1)
 993                    (while (and p (not (equal (car p) a)))
 994                      (setq p (and (eq math-compose-hash-args t) (cdr p))
 995                            v (1+ v)))
 996                    p))
 997             (if (eq math-compose-hash-args 1)
 998                 "#"
 999               (format "#%d" v))
1000           (if (string-match ".'\\'" (symbol-name (nth 2 a)))
1001               (math-compose-expr
1002                (list 'calcFunc-Prime
1003                      (list
1004                       'var
1005                       (intern (substring (symbol-name (nth 1 a)) 0 -1))
1006                       (intern (substring (symbol-name (nth 2 a)) 0 -1))))
1007                prec)
1008             (symbol-name (nth 1 a)))))))
1009
1010 (defconst math-eqn-special-funcs
1011   '( calcFunc-log
1012      calcFunc-ln calcFunc-exp
1013      calcFunc-sin calcFunc-cos calcFunc-tan
1014      calcFunc-sec calcFunc-csc calcFunc-cot
1015      calcFunc-sinh calcFunc-cosh calcFunc-tanh
1016      calcFunc-sech calcFunc-csch calcFunc-coth
1017      calcFunc-arcsin calcFunc-arccos calcFunc-arctan
1018      calcFunc-arcsinh calcFunc-arccosh calcFunc-arctanh))
1019
1020 (put 'eqn 'math-func-formatter
1021      (function
1022       (lambda (func a)
1023         (let (left right)
1024           (if (string-match "[^']'+\\'" func)
1025               (let ((n (- (length func) (match-beginning 0) 1)))
1026                 (setq func (substring func 0 (- n)))
1027                 (while (>= (setq n (1- n)) 0)
1028                   (setq func (concat func " prime")))))
1029           (cond ((or (> (length a) 2)
1030                      (not (math-tex-expr-is-flat (nth 1 a))))
1031                  (setq left "{left ( "
1032                        right " right )}"))
1033
1034                 ((and
1035                   (memq (car a) math-eqn-special-funcs)
1036                   (= (length a) 2)
1037                   (or (Math-realp (nth 1 a))
1038                       (memq (car (nth 1 a)) '(var *))))
1039                  (setq left "~{" right "}"))
1040                 (t
1041                  (setq left " ( "
1042                        right " )")))
1043           (list 'horiz func left
1044                 (math-compose-vector (cdr a) " , " 0)
1045                 right)))))
1046
1047 (put 'eqn 'math-lang-read-symbol
1048      '((?\"
1049         (string-match "\\(\"\\([^\"\\]\\|\\\\.\\)*\\)\\(\"\\|\\'\\)"
1050                       math-exp-str math-exp-pos)
1051         (progn
1052           (setq math-exp-str (copy-sequence math-exp-str))
1053           (aset math-exp-str (match-beginning 1) ?\{)
1054           (if (< (match-end 1) (length math-exp-str))
1055               (aset math-exp-str (match-end 1) ?\}))
1056           (math-read-token)))))
1057
1058 (defconst math-eqn-ignore-words
1059   '( ("roman") ("bold") ("italic") ("mark") ("lineup") ("evalto")
1060      ("left" ("floor") ("ceil"))
1061      ("right" ("floor") ("ceil"))
1062      ("arc" ("sin") ("cos") ("tan") ("sinh") ("cosh") ("tanh"))
1063      ("size" n) ("font" n) ("fwd" n) ("back" n) ("up" n) ("down" n)
1064      ("above" punc ",")))
1065
1066 (put 'eqn 'math-lang-adjust-words
1067      (function
1068       (lambda ()
1069         (let ((code (assoc math-expr-data math-eqn-ignore-words)))
1070           (cond ((null code))
1071                 ((null (cdr code))
1072                  (math-read-token))
1073                 ((consp (nth 1 code))
1074                  (math-read-token)
1075                  (if (assoc math-expr-data (cdr code))
1076                      (setq math-expr-data (format "%s %s"
1077                                                   (car code) math-expr-data))))
1078                 ((eq (nth 1 code) 'punc)
1079                  (setq math-exp-token 'punc
1080                        math-expr-data (nth 2 code)))
1081                 (t
1082                  (math-read-token)
1083                  (math-read-token)))))))
1084
1085 (put 'eqn 'math-lang-read
1086      '((eq (string-match "->\\|<-\\|+-\\|\\\\dots\\|~\\|\\^"
1087                          math-exp-str math-exp-pos)
1088            math-exp-pos)
1089        (progn
1090          (setq math-exp-token 'punc
1091                math-expr-data (math-match-substring math-exp-str 0)
1092                math-exp-pos (match-end 0))
1093          (and (eq (string-match "\\\\dots\\." math-exp-str math-exp-pos)
1094                   math-exp-pos)
1095               (setq math-exp-pos (match-end 0)))
1096          (if (memq (aref math-expr-data 0) '(?~ ?^))
1097              (math-read-token)))))
1098
1099
1100 (defun math-compose-eqn-matrix (a)
1101   (if a
1102       (cons
1103        (cond ((eq calc-matrix-just 'right) "rcol ")
1104              ((eq calc-matrix-just 'center) "ccol ")
1105              (t "lcol "))
1106        (cons
1107         (list 'break math-compose-level)
1108         (cons
1109          "{ "
1110          (cons
1111           (let ((math-compose-level (1+ math-compose-level)))
1112             (math-compose-vector (cdr (car a)) " above " 1000))
1113           (cons
1114            " } "
1115            (math-compose-eqn-matrix (cdr a)))))))
1116     nil))
1117
1118 (defun math-parse-eqn-matrix (f sym)
1119   (let ((vec nil))
1120     (while (assoc math-expr-data '(("ccol") ("lcol") ("rcol")))
1121       (math-read-token)
1122       (or (equal math-expr-data calc-function-open)
1123           (throw 'syntax "Expected `{'"))
1124       (math-read-token)
1125       (setq vec (cons (cons 'vec (math-read-expr-list)) vec))
1126       (or (equal math-expr-data calc-function-close)
1127           (throw 'syntax "Expected `}'"))
1128       (math-read-token))
1129     (or (equal math-expr-data calc-function-close)
1130         (throw 'syntax "Expected `}'"))
1131     (math-read-token)
1132     (math-transpose (cons 'vec (nreverse vec)))))
1133
1134 (defun math-parse-eqn-prime (x sym)
1135   (if (eq (car-safe x) 'var)
1136       (if (equal math-expr-data calc-function-open)
1137           (progn
1138             (math-read-token)
1139             (let ((args (if (or (equal math-expr-data calc-function-close)
1140                                 (eq math-exp-token 'end))
1141                             nil
1142                           (math-read-expr-list))))
1143               (if (not (or (equal math-expr-data calc-function-close)
1144                            (eq math-exp-token 'end)))
1145                   (throw 'syntax "Expected `)'"))
1146               (math-read-token)
1147               (cons (intern (format "calcFunc-%s'" (nth 1 x))) args)))
1148         (list 'var
1149               (intern (concat (symbol-name (nth 1 x)) "'"))
1150               (intern (concat (symbol-name (nth 2 x)) "'"))))
1151     (list 'calcFunc-Prime x)))
1152
1153 (defun math-compose-eqn-intv (a)
1154   (list 'horiz
1155         (if (memq (nth 1 a) '(0 1)) "(" "[")
1156         (math-compose-expr (nth 2 a) 0)
1157         " ... "
1158         (math-compose-expr (nth 3 a) 0)
1159         (if (memq (nth 1 a) '(0 2)) ")" "]")))
1160
1161
1162 (defun calc-mathematica-language ()
1163   (interactive)
1164   (calc-wrapper
1165    (calc-set-language 'math)
1166    (message "Mathematica language mode")))
1167
1168 (put 'math 'math-oper-table
1169   '( ( "[["    (math-read-math-subscr) 250 -1 )
1170      ( "!"     calcFunc-fact  210 -1 )
1171      ( "!!"    calcFunc-dfact 210 -1 )
1172      ( "^"     ^             201 200 )
1173      ( "u+"    ident         -1  197 )
1174      ( "u-"    neg           -1  197 )
1175      ( "/"     /             195 196 )
1176      ( "*"     *             190 191 )
1177      ( "2x"    *             190 191 )
1178      ( "+"     +             180 181 )
1179      ( "-"     -             180 181 )
1180      ( "<"     calcFunc-lt   160 161 )
1181      ( ">"     calcFunc-gt   160 161 )
1182      ( "<="    calcFunc-leq  160 161 )
1183      ( ">="    calcFunc-geq  160 161 )
1184      ( "=="    calcFunc-eq   150 151 )
1185      ( "!="    calcFunc-neq  150 151 )
1186      ( "u!"    calcFunc-lnot -1  121 )
1187      ( "&&"    calcFunc-land 110 111 )
1188      ( "||"    calcFunc-lor  100 101 )
1189      ( "!!!"   calcFunc-pnot  -1  85 )
1190      ( "&&&"   calcFunc-pand  80  81 )
1191      ( "|||"   calcFunc-por   75  76 )
1192      ( ":="    calcFunc-assign 51 50 )
1193      ( "="     calcFunc-assign 51 50 )
1194      ( "->"    calcFunc-assign 51 50 )
1195      ( ":>"    calcFunc-assign 51 50 )
1196      ( "::"    calcFunc-condition 45 46 )
1197 ))
1198
1199 (put 'math 'math-function-table
1200   '( ( Abs         . calcFunc-abs )
1201      ( ArcCos      . calcFunc-arccos )
1202      ( ArcCosh     . calcFunc-arccosh )
1203      ( ArcSin      . calcFunc-arcsin )
1204      ( ArcSinh     . calcFunc-arcsinh )
1205      ( ArcTan      . calcFunc-arctan )
1206      ( ArcTanh     . calcFunc-arctanh )
1207      ( Arg         . calcFunc-arg )
1208      ( Binomial    . calcFunc-choose )
1209      ( Ceiling     . calcFunc-ceil )
1210      ( Conjugate   . calcFunc-conj )
1211      ( Cos         . calcFunc-cos )
1212      ( Cosh        . calcFunc-cosh )
1213      ( Cot         . calcFunc-cot )
1214      ( Coth        . calcFunc-coth )
1215      ( Csc         . calcFunc-csc )
1216      ( Csch        . calcFunc-csch )
1217      ( D           . calcFunc-deriv )
1218      ( Dt          . calcFunc-tderiv )
1219      ( Det         . calcFunc-det )
1220      ( Exp         . calcFunc-exp )
1221      ( EulerPhi    . calcFunc-totient )
1222      ( Floor       . calcFunc-floor )
1223      ( Gamma       . calcFunc-gamma )
1224      ( GCD         . calcFunc-gcd )
1225      ( If          . calcFunc-if )
1226      ( Im          . calcFunc-im )
1227      ( Inverse     . calcFunc-inv )
1228      ( Integrate   . calcFunc-integ )
1229      ( Join        . calcFunc-vconcat )
1230      ( LCM         . calcFunc-lcm )
1231      ( Log         . calcFunc-ln )
1232      ( Max         . calcFunc-max )
1233      ( Min         . calcFunc-min )
1234      ( Mod         . calcFunc-mod )
1235      ( MoebiusMu   . calcFunc-moebius )
1236      ( Random      . calcFunc-random )
1237      ( Round       . calcFunc-round )
1238      ( Re          . calcFunc-re )
1239      ( Sec         . calcFunc-sec )
1240      ( Sech        . calcFunc-sech )
1241      ( Sign        . calcFunc-sign )
1242      ( Sin         . calcFunc-sin )
1243      ( Sinh        . calcFunc-sinh )
1244      ( Sqrt        . calcFunc-sqrt )
1245      ( Tan         . calcFunc-tan )
1246      ( Tanh        . calcFunc-tanh )
1247      ( Transpose   . calcFunc-trn )
1248      ( Length      . calcFunc-vlen )
1249 ))
1250
1251 (put 'math 'math-variable-table
1252   '( ( I           . var-i )
1253      ( Pi          . var-pi )
1254      ( E           . var-e )
1255      ( GoldenRatio . var-phi )
1256      ( EulerGamma  . var-gamma )
1257      ( Infinity    . var-inf )
1258      ( ComplexInfinity . var-uinf )
1259      ( Indeterminate . var-nan )
1260 ))
1261
1262 (put 'math 'math-vector-brackets "{}")
1263 (put 'math 'math-complex-format 'I)
1264 (put 'math 'math-function-open "[")
1265 (put 'math 'math-function-close "]")
1266
1267 (put 'math 'math-radix-formatter
1268      (function (lambda (r s) (format "%d^^%s" r s))))
1269
1270 (put 'math 'math-lang-read
1271      '((eq (string-match "\\[\\[\\|->\\|:>" math-exp-str math-exp-pos)
1272            math-exp-pos)
1273        (setq math-exp-token 'punc
1274              math-expr-data (math-match-substring math-exp-str 0)
1275              math-exp-pos (match-end 0))))
1276
1277 (put 'math 'math-compose-subscr
1278      (function
1279       (lambda (a)
1280         (list 'horiz
1281               (math-compose-expr (nth 1 a) 1000)
1282               "[["
1283               (math-compose-expr (nth 2 a) 0)
1284               "]]"))))
1285
1286 (defun math-read-math-subscr (x op)
1287   (let ((idx (math-read-expr-level 0)))
1288     (or (and (equal math-expr-data "]")
1289              (progn
1290                (math-read-token)
1291                (equal math-expr-data "]")))
1292         (throw 'syntax "Expected ']]'"))
1293     (math-read-token)
1294     (list 'calcFunc-subscr x idx)))
1295
1296
1297 (defun calc-maple-language ()
1298   (interactive)
1299   (calc-wrapper
1300    (calc-set-language 'maple)
1301    (message "Maple language mode")))
1302
1303 (put 'maple 'math-oper-table
1304   '( ( "matrix" ident        -1  300 )
1305      ( "MATRIX" ident        -1  300 )
1306      ( "!"     calcFunc-fact  210 -1 )
1307      ( "^"     ^             201 200 )
1308      ( "**"    ^             201 200 )
1309      ( "u+"    ident         -1  197 )
1310      ( "u-"    neg           -1  197 )
1311      ( "/"     /             191 192 )
1312      ( "*"     *             191 192 )
1313      ( "intersect" calcFunc-vint 191 192 )
1314      ( "+"     +             180 181 )
1315      ( "-"     -             180 181 )
1316      ( "union" calcFunc-vunion 180 181 )
1317      ( "minus" calcFunc-vdiff 180 181 )
1318      ( "mod"   %             170 170 )
1319      ( ".."    (math-read-maple-dots) 165 165 )
1320      ( "\\dots" (math-read-maple-dots) 165 165 )
1321      ( "<"     calcFunc-lt   160 160 )
1322      ( ">"     calcFunc-gt   160 160 )
1323      ( "<="    calcFunc-leq  160 160 )
1324      ( ">="    calcFunc-geq  160 160 )
1325      ( "="     calcFunc-eq   160 160 )
1326      ( "<>"    calcFunc-neq  160 160 )
1327      ( "not"   calcFunc-lnot -1  121 )
1328      ( "and"   calcFunc-land 110 111 )
1329      ( "or"    calcFunc-lor  100 101 )
1330      ( "!!!"   calcFunc-pnot  -1  85 )
1331      ( "&&&"   calcFunc-pand  80  81 )
1332      ( "|||"   calcFunc-por   75  76 )
1333      ( ":="    calcFunc-assign 51 50 )
1334      ( "::"    calcFunc-condition 45 46 )
1335 ))
1336
1337 (put 'maple 'math-function-table
1338   '( ( bernoulli   . calcFunc-bern )
1339      ( binomial    . calcFunc-choose )
1340      ( diff        . calcFunc-deriv )
1341      ( GAMMA       . calcFunc-gamma )
1342      ( ifactor     . calcFunc-prfac )
1343      ( igcd        . calcFunc-gcd )
1344      ( ilcm        . calcFunc-lcm )
1345      ( int         . calcFunc-integ )
1346      ( modp        . % )
1347      ( irem        . % )
1348      ( iquo        . calcFunc-idiv )
1349      ( isprime     . calcFunc-prime )
1350      ( length      . calcFunc-vlen )
1351      ( member      . calcFunc-in )
1352      ( crossprod   . calcFunc-cross )
1353      ( inverse     . calcFunc-inv )
1354      ( trace       . calcFunc-tr )
1355      ( transpose   . calcFunc-trn )
1356      ( vectdim     . calcFunc-vlen )
1357 ))
1358
1359 (put 'maple 'math-special-function-table
1360      '((intv . math-compose-maple-intv)))
1361
1362 (put 'maple 'math-variable-table
1363   '( ( I           . var-i )
1364      ( Pi          . var-pi )
1365      ( E           . var-e )
1366      ( infinity    . var-inf )
1367      ( infinity    . var-uinf )
1368      ( infinity    . var-nan )
1369 ))
1370
1371 (put 'maple 'math-complex-format 'I)
1372
1373 (put 'maple 'math-matrix-formatter
1374      (function
1375       (lambda (a)
1376         (list 'horiz
1377               "matrix("
1378               math-comp-left-bracket
1379               (math-compose-vector (cdr a)
1380                                    (concat math-comp-comma " ")
1381                                    math-comp-vector-prec)
1382               math-comp-right-bracket
1383               ")"))))
1384
1385 (put 'maple 'math-compose-subscr
1386      (function
1387       (lambda (a)
1388         (let ((args (cdr (cdr a))))
1389           (list 'horiz
1390                 (math-compose-expr (nth 1 a) 1000)
1391                 "["
1392                 (math-compose-vector args ", " 0)
1393                 "]")))))
1394
1395 (add-to-list 'calc-lang-allow-underscores 'maple)
1396 (add-to-list 'calc-lang-brackets-are-subscripts 'maple)
1397
1398 (defun math-compose-maple-intv (a)
1399   (list 'horiz
1400         (math-compose-expr (nth 2 a) 0)
1401         " .. "
1402         (math-compose-expr (nth 3 a) 0)))
1403
1404 (defun math-read-maple-dots (x op)
1405   (list 'intv 3 x (math-read-expr-level (nth 3 op))))
1406
1407
1408 ;; The variable math-read-big-lines is local to math-read-big-expr in
1409 ;; calc-ext.el, but is used by math-read-big-rec, math-read-big-char,
1410 ;; math-read-big-emptyp, math-read-big-error and math-read-big-balance,
1411 ;; which are called (directly and indirectly) by math-read-big-expr.
1412 ;; It is also local to math-read-big-bigp in calc-ext.el, which calls
1413 ;; math-read-big-balance.
1414 (defvar math-read-big-lines)
1415
1416 ;; The variables math-read-big-baseline and math-read-big-h2 are
1417 ;; local to math-read-big-expr in calc-ext.el, but used by
1418 ;; math-read-big-rec.
1419 (defvar math-read-big-baseline)
1420 (defvar math-read-big-h2)
1421
1422 ;; The variables math-rb-h1, math-rb-h2, math-rb-v1 and math-rb-v2
1423 ;; are local to math-read-big-rec, but are used by math-read-big-char,
1424 ;; math-read-big-emptyp and math-read-big-balance which are called by
1425 ;; math-read-big-rec.
1426 ;; math-rb-h2 is also local to math-read-big-bigp in calc-ext.el,
1427 ;; which calls math-read-big-balance.
1428 (defvar math-rb-h1)
1429 (defvar math-rb-h2)
1430 (defvar math-rb-v1)
1431 (defvar math-rb-v2)
1432
1433 (defun math-read-big-rec (math-rb-h1 math-rb-v1 math-rb-h2 math-rb-v2
1434                                      &optional baseline prec short)
1435   (or prec (setq prec 0))
1436
1437   ;; Clip whitespace above or below.
1438   (while (and (< math-rb-v1 math-rb-v2)
1439               (math-read-big-emptyp math-rb-h1 math-rb-v1 math-rb-h2 (1+ math-rb-v1)))
1440     (setq math-rb-v1 (1+ math-rb-v1)))
1441   (while (and (< math-rb-v1 math-rb-v2)
1442               (math-read-big-emptyp math-rb-h1 (1- math-rb-v2) math-rb-h2 math-rb-v2))
1443     (setq math-rb-v2 (1- math-rb-v2)))
1444
1445   ;; If formula is a single line high, normal parser can handle it.
1446   (if (<= math-rb-v2 (1+ math-rb-v1))
1447       (if (or (<= math-rb-v2 math-rb-v1)
1448               (> math-rb-h1 (length (setq math-rb-v2
1449                                           (nth math-rb-v1 math-read-big-lines)))))
1450           (math-read-big-error math-rb-h1 math-rb-v1)
1451         (setq math-read-big-baseline math-rb-v1
1452               math-read-big-h2 math-rb-h2
1453               math-rb-v2 (nth math-rb-v1 math-read-big-lines)
1454               math-rb-h2 (math-read-expr
1455                           (substring math-rb-v2 math-rb-h1
1456                                      (min math-rb-h2 (length math-rb-v2)))))
1457         (if (eq (car-safe math-rb-h2) 'error)
1458             (math-read-big-error (+ math-rb-h1 (nth 1 math-rb-h2))
1459                                  math-rb-v1 (nth 2 math-rb-h2))
1460           math-rb-h2))
1461
1462     ;; Clip whitespace at left or right.
1463     (while (and (< math-rb-h1 math-rb-h2)
1464                 (math-read-big-emptyp math-rb-h1 math-rb-v1 (1+ math-rb-h1) math-rb-v2))
1465       (setq math-rb-h1 (1+ math-rb-h1)))
1466     (while (and (< math-rb-h1 math-rb-h2)
1467                 (math-read-big-emptyp (1- math-rb-h2) math-rb-v1 math-rb-h2 math-rb-v2))
1468       (setq math-rb-h2 (1- math-rb-h2)))
1469
1470     ;; Scan to find widest left-justified "----" in the region.
1471     (let* ((widest nil)
1472            (widest-h2 0)
1473            (lines-v1 (nthcdr math-rb-v1 math-read-big-lines))
1474            (p lines-v1)
1475            (v math-rb-v1)
1476            (other-v nil)
1477            other-char line len h)
1478       (while (< v math-rb-v2)
1479         (setq line (car p)
1480               len (min math-rb-h2 (length line)))
1481         (and (< math-rb-h1 len)
1482              (/= (aref line math-rb-h1) ?\ )
1483              (if (and (= (aref line math-rb-h1) ?\-)
1484                       ;; Make sure it's not a minus sign.
1485                       (or (and (< (1+ math-rb-h1) len)
1486                                (= (aref line (1+ math-rb-h1)) ?\-))
1487                           (/= (math-read-big-char math-rb-h1 (1- v)) ?\ )
1488                           (/= (math-read-big-char math-rb-h1 (1+ v)) ?\ )))
1489                  (progn
1490                    (setq h math-rb-h1)
1491                    (while (and (< (setq h (1+ h)) len)
1492                                (= (aref line h) ?\-)))
1493                    (if (> h widest-h2)
1494                        (setq widest v
1495                              widest-h2 h)))
1496                (or other-v (setq other-v v other-char (aref line math-rb-h1)))))
1497         (setq v (1+ v)
1498               p (cdr p)))
1499
1500       (cond ((not (setq v other-v))
1501              (math-read-big-error math-rb-h1 math-rb-v1))   ; Should never happen!
1502
1503             ;; Quotient.
1504             (widest
1505              (setq h widest-h2
1506                    v widest)
1507              (let ((num (math-read-big-rec math-rb-h1 math-rb-v1 h v))
1508                    (den (math-read-big-rec math-rb-h1 (1+ v) h math-rb-v2)))
1509                (setq p (if (and (math-integerp num) (math-integerp den))
1510                            (math-make-frac num den)
1511                          (list '/ num den)))))
1512
1513             ;; Big radical sign.
1514             ((= other-char ?\\)
1515              (or (= (math-read-big-char (1+ math-rb-h1) v) ?\|)
1516                  (math-read-big-error (1+ math-rb-h1) v "Malformed root sign"))
1517              (math-read-big-emptyp math-rb-h1 math-rb-v1 (1+ math-rb-h1) v nil t)
1518              (while (= (math-read-big-char (1+ math-rb-h1) (setq v (1- v))) ?\|))
1519              (or (= (math-read-big-char (setq h (+ math-rb-h1 2)) v) ?\_)
1520                  (math-read-big-error h v "Malformed root sign"))
1521              (while (= (math-read-big-char (setq h (1+ h)) v) ?\_))
1522              (math-read-big-emptyp math-rb-h1 math-rb-v1 (1+ math-rb-h1) v nil t)
1523              (math-read-big-emptyp math-rb-h1 (1+ other-v) h math-rb-v2 nil t)
1524              (setq p (list 'calcFunc-sqrt (math-read-big-rec
1525                                            (+ math-rb-h1 2) (1+ v)
1526                                            h (1+ other-v) baseline))
1527                    v math-read-big-baseline))
1528
1529             ;; Small radical sign.
1530             ((and (= other-char ?V)
1531                   (= (math-read-big-char (1+ math-rb-h1) (1- v)) ?\_))
1532              (setq h (1+ math-rb-h1))
1533              (math-read-big-emptyp math-rb-h1 math-rb-v1 h (1- v) nil t)
1534              (math-read-big-emptyp math-rb-h1 (1+ v) h math-rb-v2 nil t)
1535              (math-read-big-emptyp math-rb-h1 math-rb-v1 (1+ math-rb-h1) v nil t)
1536              (while (= (math-read-big-char (setq h (1+ h)) (1- v)) ?\_))
1537              (setq p (list 'calcFunc-sqrt (math-read-big-rec
1538                                            (1+ math-rb-h1) v h (1+ v) t))
1539                    v math-read-big-baseline))
1540
1541             ;; Binomial coefficient.
1542             ((and (= other-char ?\()
1543                   (= (math-read-big-char (1+ math-rb-h1) v) ?\ )
1544                   (= (string-match "( *)" (nth v math-read-big-lines)
1545                                    math-rb-h1) math-rb-h1))
1546              (setq h (match-end 0))
1547              (math-read-big-emptyp math-rb-h1 math-rb-v1 (1+ math-rb-h1) v nil t)
1548              (math-read-big-emptyp math-rb-h1 (1+ v) (1+ math-rb-h1) math-rb-v2 nil t)
1549              (math-read-big-emptyp (1- h) math-rb-v1 h v nil t)
1550              (math-read-big-emptyp (1- h) (1+ v) h math-rb-v2 nil t)
1551              (setq p (list 'calcFunc-choose
1552                            (math-read-big-rec (1+ math-rb-h1) math-rb-v1 (1- h) v)
1553                            (math-read-big-rec (1+ math-rb-h1) (1+ v)
1554                                               (1- h) math-rb-v2))))
1555
1556             ;; Minus sign.
1557             ((= other-char ?\-)
1558              (setq p (list 'neg (math-read-big-rec (1+ math-rb-h1) math-rb-v1
1559                                                    math-rb-h2 math-rb-v2 v 250 t))
1560                    v math-read-big-baseline
1561                    h math-read-big-h2))
1562
1563             ;; Parentheses.
1564             ((= other-char ?\()
1565              (math-read-big-emptyp math-rb-h1 math-rb-v1 (1+ math-rb-h1) v nil t)
1566              (math-read-big-emptyp math-rb-h1 (1+ v) (1+ math-rb-h1) math-rb-v2 nil t)
1567              (setq h (math-read-big-balance (1+ math-rb-h1) v "(" t))
1568              (math-read-big-emptyp (1- h) math-rb-v1 h v nil t)
1569              (math-read-big-emptyp (1- h) (1+ v) h math-rb-v2 nil t)
1570              (let ((sep (math-read-big-char (1- h) v))
1571                    hmid)
1572                (if (= sep ?\.)
1573                    (setq h (1+ h)))
1574                (if (= sep ?\])
1575                    (math-read-big-error (1- h) v "Expected `)'"))
1576                (if (= sep ?\))
1577                    (setq p (math-read-big-rec
1578                             (1+ math-rb-h1) math-rb-v1 (1- h) math-rb-v2 v))
1579                  (setq hmid (math-read-big-balance h v "(")
1580                        p (list p
1581                                (math-read-big-rec h math-rb-v1 (1- hmid) math-rb-v2 v))
1582                        h hmid)
1583                  (cond ((= sep ?\.)
1584                         (setq p (cons 'intv (cons (if (= (math-read-big-char
1585                                                           (1- h) v)
1586                                                          ?\))
1587                                                       0 1)
1588                                                   p))))
1589                        ((= (math-read-big-char (1- h) v) ?\])
1590                         (math-read-big-error (1- h) v "Expected `)'"))
1591                        ((= sep ?\,)
1592                         (or (and (math-realp (car p)) (math-realp (nth 1 p)))
1593                             (math-read-big-error
1594                              math-rb-h1 v "Complex components must be real"))
1595                         (setq p (cons 'cplx p)))
1596                        ((= sep ?\;)
1597                         (or (and (math-realp (car p)) (math-anglep (nth 1 p)))
1598                             (math-read-big-error
1599                              math-rb-h1 v "Complex components must be real"))
1600                         (setq p (cons 'polar p)))))))
1601
1602             ;; Matrix.
1603             ((and (= other-char ?\[)
1604                   (or (= (math-read-big-char (setq h math-rb-h1) (1+ v)) ?\[)
1605                       (= (math-read-big-char (setq h (1+ h)) v) ?\[)
1606                       (and (= (math-read-big-char h v) ?\ )
1607                            (= (math-read-big-char (setq h (1+ h)) v) ?\[)))
1608                   (= (math-read-big-char h (1+ v)) ?\[))
1609              (math-read-big-emptyp math-rb-h1 math-rb-v1 h v nil t)
1610              (let ((vtop v)
1611                    (hleft h)
1612                    (hright nil))
1613                (setq p nil)
1614                (while (progn
1615                         (setq h (math-read-big-balance (1+ hleft) v "["))
1616                         (if hright
1617                             (or (= h hright)
1618                                 (math-read-big-error hright v "Expected `]'"))
1619                           (setq hright h))
1620                         (setq p (cons (math-read-big-rec
1621                                        hleft v h (1+ v)) p))
1622                         (and (memq (math-read-big-char h v) '(?\  ?\,))
1623                              (= (math-read-big-char hleft (1+ v)) ?\[)))
1624                  (setq v (1+ v)))
1625                (or (= hleft math-rb-h1)
1626                    (progn
1627                      (if (= (math-read-big-char h v) ?\ )
1628                          (setq h (1+ h)))
1629                      (and (= (math-read-big-char h v) ?\])
1630                           (setq h (1+ h))))
1631                    (math-read-big-error (1- h) v "Expected `]'"))
1632                (if (= (math-read-big-char h vtop) ?\,)
1633                    (setq h (1+ h)))
1634                (math-read-big-emptyp math-rb-h1 (1+ v) (1- h) math-rb-v2 nil t)
1635                (setq v (+ vtop (/ (- v vtop) 2))
1636                      p (cons 'vec (nreverse p)))))
1637
1638             ;; Square brackets.
1639             ((= other-char ?\[)
1640              (math-read-big-emptyp math-rb-h1 math-rb-v1 (1+ math-rb-h1) v nil t)
1641              (math-read-big-emptyp math-rb-h1 (1+ v) (1+ math-rb-h1) math-rb-v2 nil t)
1642              (setq p nil
1643                    h (1+ math-rb-h1))
1644              (while (progn
1645                       (setq widest (math-read-big-balance h v "[" t))
1646                       (math-read-big-emptyp (1- h) math-rb-v1 h v nil t)
1647                       (math-read-big-emptyp (1- h) (1+ v) h math-rb-v2 nil t)
1648                       (setq p (cons (math-read-big-rec
1649                                      h math-rb-v1 (1- widest) math-rb-v2 v) p)
1650                             h widest)
1651                       (= (math-read-big-char (1- h) v) ?\,)))
1652              (setq widest (math-read-big-char (1- h) v))
1653              (if (or (memq widest '(?\; ?\)))
1654                      (and (eq widest ?\.) (cdr p)))
1655                  (math-read-big-error (1- h) v "Expected `]'"))
1656              (if (= widest ?\.)
1657                  (setq h (1+ h)
1658                        widest (math-read-big-balance h v "[")
1659                        p (nconc p (list (math-read-big-rec
1660                                          h math-rb-v1 (1- widest) math-rb-v2 v)))
1661                        h widest
1662                        p (cons 'intv (cons (if (= (math-read-big-char (1- h) v)
1663                                                   ?\])
1664                                                3 2)
1665                                            p)))
1666                (setq p (cons 'vec (nreverse p)))))
1667
1668             ;; Date form.
1669             ((= other-char ?\<)
1670              (setq line (nth v math-read-big-lines))
1671              (string-match ">" line math-rb-h1)
1672              (setq h (match-end 0))
1673              (math-read-big-emptyp math-rb-h1 math-rb-v1 h v nil t)
1674              (math-read-big-emptyp math-rb-h1 (1+ v) h math-rb-v2 nil t)
1675              (setq p (math-read-big-rec math-rb-h1 v h (1+ v) v)))
1676
1677             ;; Variable name or function call.
1678             ((or (and (>= other-char ?a) (<= other-char ?z))
1679                  (and (>= other-char ?A) (<= other-char ?Z)))
1680              (setq line (nth v math-read-big-lines))
1681              (string-match "\\([a-zA-Z'_]+\\) *" line math-rb-h1)
1682              (setq h (match-end 1)
1683                    widest (match-end 0)
1684                    p (math-match-substring line 1))
1685              (math-read-big-emptyp math-rb-h1 math-rb-v1 h v nil t)
1686              (math-read-big-emptyp math-rb-h1 (1+ v) h math-rb-v2 nil t)
1687              (if (= (math-read-big-char widest v) ?\()
1688                  (progn
1689                    (setq line (if (string-match "-" p)
1690                                   (intern p)
1691                                 (intern (concat "calcFunc-" p)))
1692                          h (1+ widest)
1693                          p nil)
1694                    (math-read-big-emptyp widest math-rb-v1 h v nil t)
1695                    (math-read-big-emptyp widest (1+ v) h math-rb-v2 nil t)
1696                    (while (progn
1697                             (setq widest (math-read-big-balance h v "(" t))
1698                             (math-read-big-emptyp (1- h) math-rb-v1 h v nil t)
1699                             (math-read-big-emptyp (1- h) (1+ v) h math-rb-v2 nil t)
1700                             (setq p (cons (math-read-big-rec
1701                                            h math-rb-v1 (1- widest) math-rb-v2 v) p)
1702                                   h widest)
1703                             (= (math-read-big-char (1- h) v) ?\,)))
1704                    (or (= (math-read-big-char (1- h) v) ?\))
1705                        (math-read-big-error (1- h) v "Expected `)'"))
1706                    (setq p (cons line (nreverse p))))
1707                (setq p (list 'var
1708                              (intern (math-remove-dashes p))
1709                              (if (string-match "-" p)
1710                                  (intern p)
1711                                (intern (concat "var-" p)))))))
1712
1713             ;; Number.
1714             (t
1715              (setq line (nth v math-read-big-lines))
1716              (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)
1717                  (math-read-big-error h v "Expected a number"))
1718              (setq h (match-end 0)
1719                    p (math-read-number (math-match-substring line 0)))
1720              (math-read-big-emptyp math-rb-h1 math-rb-v1 h v nil t)
1721              (math-read-big-emptyp math-rb-h1 (1+ v) h math-rb-v2 nil t)))
1722
1723       ;; Now left term is bounded by math-rb-h1, math-rb-v1, h, math-rb-v2;
1724       ;; baseline = v.
1725       (if baseline
1726           (or (= v baseline)
1727               (math-read-big-error math-rb-h1 v "Inconsistent baseline in formula"))
1728         (setq baseline v))
1729
1730       ;; Look for superscripts or subscripts.
1731       (setq line (nth baseline math-read-big-lines)
1732             len (min math-rb-h2 (length line))
1733             widest h)
1734       (while (and (< widest len)
1735                   (= (aref line widest) ?\ ))
1736         (setq widest (1+ widest)))
1737       (and (>= widest len) (setq widest math-rb-h2))
1738       (if (math-read-big-emptyp h v widest math-rb-v2)
1739           (if (math-read-big-emptyp h math-rb-v1 widest v)
1740               (setq h widest)
1741             (setq p (list '^ p (math-read-big-rec h math-rb-v1 widest v))
1742                   h widest))
1743           (if (math-read-big-emptyp h math-rb-v1 widest v)
1744               (setq p (list 'calcFunc-subscr p
1745                             (math-read-big-rec h v widest math-rb-v2))
1746                     h widest)))
1747
1748       ;; Look for an operator name and grab additional terms.
1749       (while (and (< h len)
1750                   (if (setq widest (and (math-read-big-emptyp
1751                                          h math-rb-v1 (1+ h) v)
1752                                         (math-read-big-emptyp
1753                                          h (1+ v) (1+ h) math-rb-v2)
1754                                         (string-match "<=\\|>=\\|\\+/-\\|!=\\|&&\\|||\\|:=\\|=>\\|." line h)
1755                                         (assoc (math-match-substring line 0)
1756                                                (math-standard-ops))))
1757                       (and (>= (nth 2 widest) prec)
1758                            (setq h (match-end 0)))
1759                     (and (not (eq (string-match ",\\|;\\|\\.\\.\\|)\\|\\]\\|:" line h)
1760                                   h))
1761                          (setq widest '("2x" * 196 195)))))
1762         (cond ((eq (nth 3 widest) -1)
1763                (setq p (list (nth 1 widest) p)))
1764               ((equal (car widest) "?")
1765                (let ((y (math-read-big-rec h math-rb-v1 math-rb-h2
1766                                            math-rb-v2 baseline nil t)))
1767                  (or (= (math-read-big-char math-read-big-h2 baseline) ?\:)
1768                      (math-read-big-error math-read-big-h2 baseline "Expected `:'"))
1769                  (setq p (list (nth 1 widest) p y
1770                                (math-read-big-rec
1771                                 (1+ math-read-big-h2) math-rb-v1 math-rb-h2 math-rb-v2
1772                                 baseline (nth 3 widest) t))
1773                        h math-read-big-h2)))
1774               (t
1775                (setq p (list (nth 1 widest) p
1776                              (math-read-big-rec h math-rb-v1 math-rb-h2 math-rb-v2
1777                                                 baseline (nth 3 widest) t))
1778                      h math-read-big-h2))))
1779
1780       ;; Return all relevant information to caller.
1781       (setq math-read-big-baseline baseline
1782             math-read-big-h2 h)
1783       (or short (= math-read-big-h2 math-rb-h2)
1784           (math-read-big-error h baseline))
1785       p)))
1786
1787 (defun math-read-big-char (h v)
1788   (or (and (>= h math-rb-h1)
1789            (< h math-rb-h2)
1790            (>= v math-rb-v1)
1791            (< v math-rb-v2)
1792            (let ((line (nth v math-read-big-lines)))
1793              (and line
1794                   (< h (length line))
1795                   (aref line h))))
1796       ?\ ))
1797
1798 (defun math-read-big-emptyp (eh1 ev1 eh2 ev2 &optional what error)
1799   (and (< ev1 math-rb-v1) (setq ev1 math-rb-v1))
1800   (and (< eh1 math-rb-h1) (setq eh1 math-rb-h1))
1801   (and (> ev2 math-rb-v2) (setq ev2 math-rb-v2))
1802   (and (> eh2 math-rb-h2) (setq eh2 math-rb-h2))
1803   (or what (setq what ?\ ))
1804   (let ((p (nthcdr ev1 math-read-big-lines))
1805         h)
1806     (while (and (< ev1 ev2)
1807                 (progn
1808                   (setq h (min eh2 (length (car p))))
1809                   (while (and (>= (setq h (1- h)) eh1)
1810                               (= (aref (car p) h) what)))
1811                   (and error (>= h eh1)
1812                        (math-read-big-error h ev1 (if (stringp error)
1813                                                       error
1814                                                     "Whitespace expected")))
1815                   (< h eh1)))
1816       (setq ev1 (1+ ev1)
1817             p (cdr p)))
1818     (>= ev1 ev2)))
1819
1820 ;; math-read-big-err-msg is local to math-read-big-expr in calc-ext.el,
1821 ;; but is used by math-read-big-error which is called (indirectly) by
1822 ;; math-read-big-expr.
1823 (defvar math-read-big-err-msg)
1824
1825 (defun math-read-big-error (h v &optional msg)
1826   (let ((pos 0)
1827         (p math-read-big-lines))
1828     (while (> v 0)
1829       (setq pos (+ pos 1 (length (car p)))
1830             p (cdr p)
1831             v (1- v)))
1832     (setq h (+ pos (min h (length (car p))))
1833           math-read-big-err-msg (list 'error h (or msg "Syntax error")))
1834     (throw 'syntax nil)))
1835
1836 (defun math-read-big-balance (h v what &optional commas)
1837   (let* ((line (nth v math-read-big-lines))
1838          (len (min math-rb-h2 (length line)))
1839          (count 1))
1840     (while (> count 0)
1841       (if (>= h len)
1842           (if what
1843               (math-read-big-error nil v (format "Unmatched `%s'" what))
1844             (setq count 0))
1845         (if (memq (aref line h) '(?\( ?\[))
1846             (setq count (1+ count))
1847           (if (if (and commas (= count 1))
1848                   (or (memq (aref line h) '(?\) ?\] ?\, ?\;))
1849                       (and (eq (aref line h) ?\.)
1850                            (< (1+ h) len)
1851                            (eq (aref line (1+ h)) ?\.)))
1852                 (memq (aref line h) '(?\) ?\])))
1853               (setq count (1- count))))
1854         (setq h (1+ h))))
1855     h))
1856
1857 (provide 'calc-lang)
1858
1859 ;;; arch-tag: 483bfe15-f290-4fef-bb7d-ce65be687f2e
1860 ;;; calc-lang.el ends here