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