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