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

   1 ;;; calc-lang.el --- calc language functions
   2
   3 ;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc.
   4
   5 ;; Author: David Gillespie <daveg@synaptics.com>
   6
   7 ;; This file is part of GNU Emacs.
   8
   9 ;; GNU Emacs is free software: you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation, either version 3 of the License, or
  12 ;; (at your option) any later version.
  13
  14 ;; GNU Emacs is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  21
  22 ;;; Commentary:
  23
  24 ;;; Code:
  25
  26 ;; This file is autoloaded from calc-ext.el.
  27
  28 (require 'calc-ext)
  29 (require 'calc-macs)
  30
  31
  32 ;; Declare variables which are defined elsewhere.
  33 (defvar calc-lang-slash-idiv)
  34 (defvar calc-lang-allow-underscores)
  35 (defvar calc-lang-allow-percentsigns)
  36 (defvar math-comp-left-bracket)
  37 (defvar math-comp-right-bracket)
  38 (defvar math-comp-comma)
  39 (defvar math-comp-vector-prec)
  40
  41 ;;; Alternate entry/display languages.
  42
  43 (defun calc-set-language (lang &optional option no-refresh)
  44   (setq math-expr-opers (or (get lang 'math-oper-table) (math-standard-ops))
  45         math-expr-function-mapping (get lang 'math-function-table)
  46         math-expr-variable-mapping (get lang 'math-variable-table)
  47         calc-language-input-filter (get lang 'math-input-filter)
  48         calc-language-output-filter (get lang 'math-output-filter)
  49         calc-vector-brackets (or (get lang 'math-vector-brackets) "[]")
  50         calc-complex-format (get lang 'math-complex-format)
  51         calc-radix-formatter (get lang 'math-radix-formatter)
  52         calc-function-open (or (get lang 'math-function-open) "(")
  53         calc-function-close (or (get lang 'math-function-close) ")"))
  54   (if no-refresh
  55       (setq calc-language lang
  56             calc-language-option option)
  57     (calc-change-mode '(calc-language calc-language-option)
  58                       (list lang option) t)))
  59
  60 (defun calc-normal-language ()
  61   (interactive)
  62   (calc-wrapper
  63    (calc-set-language nil)
  64    (message "Normal language mode")))
  65
  66 (defun calc-flat-language ()
  67   (interactive)
  68   (calc-wrapper
  69    (calc-set-language 'flat)
  70    (message "Flat language mode (all stack entries shown on one line)")))
  71
  72 (defun calc-big-language ()
  73   (interactive)
  74   (calc-wrapper
  75    (calc-set-language 'big)
  76    (message "\"Big\" language mode")))
  77
  78 (defun calc-unformatted-language ()
  79   (interactive)
  80   (calc-wrapper
  81    (calc-set-language 'unform)
  82    (message "Unformatted language mode")))
  83
  84
  85 (defun calc-c-language ()
  86   (interactive)
  87   (calc-wrapper
  88    (calc-set-language 'c)
  89    (message "C language mode")))
  90
  91 (put 'c 'math-oper-table
  92   '( ( "u!"    calcFunc-lnot -1 1000 )
  93      ( "~"     calcFunc-not  -1 1000 )
  94      ( "u+"    ident         -1  197 )
  95      ( "u-"    neg           -1  197 )
  96      ( "*"     *             190 191 )
  97      ( "/"     /             190 191 )
  98      ( "%"     %             190 191 )
  99      ( "+"     +             180 181 )
 100      ( "-"     -             180 181 )
 101      ( "<<"    calcFunc-lsh  170 171 )
 102      ( ">>"    calcFunc-rsh  170 171 )
 103      ( "<"     calcFunc-lt   160 161 )
 104      ( ">"     calcFunc-gt   160 161 )
 105      ( "<="    calcFunc-leq  160 161 )
 106      ( ">="    calcFunc-geq  160 161 )
 107      ( "=="    calcFunc-eq   150 151 )
 108      ( "!="    calcFunc-neq  150 151 )
 109      ( "&"     calcFunc-and  140 141 )
 110      ( "^"     calcFunc-xor  131 130 )
 111      ( "|"     calcFunc-or   120 121 )
 112      ( "&&"    calcFunc-land 110 111 )
 113      ( "||"    calcFunc-lor  100 101 )
 114      ( "?"     (math-read-if)  91  90 )
 115      ( "!!!"   calcFunc-pnot  -1  88 )
 116      ( "&&&"   calcFunc-pand  85  86 )
 117      ( "|||"   calcFunc-por   75  76 )
 118      ( "="     calcFunc-assign 51 50 )
 119      ( ":="    calcFunc-assign 51 50 )
 120      ( "::"    calcFunc-condition 45 46 ))) ; should support full assignments
 121
 122 (put 'c 'math-function-table
 123   '( ( acos        . calcFunc-arccos )
 124      ( acosh       . calcFunc-arccosh )
 125      ( asin        . calcFunc-arcsin )
 126      ( asinh       . calcFunc-arcsinh )
 127      ( atan        . calcFunc-arctan )
 128      ( atan2       . calcFunc-arctan2 )
 129      ( atanh       . calcFunc-arctanh )
 130      ( fma         . (math-C-parse-fma))
 131      ( fmax        . calcFunc-max )
 132      ( j0          . (math-C-parse-bess))
 133      ( jn          . calcFunc-besJ )
 134      ( j1          . (math-C-parse-bess))
 135      ( yn          . calcFunc-besY )
 136      ( y0          . (math-C-parse-bess))
 137      ( y1          . (math-C-parse-bess))
 138      ( tgamma      . calcFunc-gamma )))
 139
 140 (defun math-C-parse-bess (f val)
 141   "Parse C's j0, j1, y0, y1 functions."
 142   (let ((args (math-read-expr-list)))
 143     (math-read-token)
 144     (append
 145      (cond ((eq val 'j0) '(calcFunc-besJ 0))
 146            ((eq val 'j1) '(calcFunc-besJ 1))
 147            ((eq val 'y0) '(calcFunc-besY 0))
 148            ((eq val 'y1) '(calcFunc-besY 1)))
 149      args)))
 150
 151 (defun math-C-parse-fma (f val)
 152   "Parse C's fma function fma(x,y,z) => (x * y + z)."
 153   (let ((args (math-read-expr-list)))
 154     (math-read-token)
 155     (list 'calcFunc-add
 156           (list 'calcFunc-mul
 157                 (nth 0 args)
 158                 (nth 1 args))
 159           (nth 2 args))))
 160
 161
 162 (put 'c 'math-variable-table
 163   '( ( M_PI        . var-pi )
 164      ( M_E         . var-e )))
 165
 166 (put 'c 'math-vector-brackets "{}")
 167
 168 (put 'c 'math-radix-formatter
 169      (function (lambda (r s)
 170                  (if (= r 16) (format "0x%s" s)
 171                    (if (= r 8) (format "0%s" s)
 172                      (format "%d#%s" r s))))))
 173
 174 (put 'c 'math-compose-subscr
 175      (function
 176       (lambda (a)
 177         (let ((args (cdr (cdr a))))
 178           (list 'horiz
 179                 (math-compose-expr (nth 1 a) 1000)
 180                 "["
 181                 (math-compose-vector args ", " 0)
 182                 "]")))))
 183
 184 (add-to-list 'calc-lang-slash-idiv 'c)
 185 (add-to-list 'calc-lang-allow-underscores 'c)
 186 (add-to-list 'calc-lang-c-type-hex 'c)
 187 (add-to-list 'calc-lang-brackets-are-subscripts 'c)
 188
 189 (defun calc-pascal-language (n)
 190   (interactive "P")
 191   (calc-wrapper
 192    (and n (setq n (prefix-numeric-value n)))
 193    (calc-set-language 'pascal n)
 194    (message (if (and n (/= n 0))
 195                 (if (> n 0)
 196                     "Pascal language mode (all uppercase)"
 197                   "Pascal language mode (all lowercase)")
 198               "Pascal language mode"))))
 199
 200 (put 'pascal 'math-oper-table
 201   '( ( "not"   calcFunc-lnot -1 1000 )
 202      ( "*"     *             190 191 )
 203      ( "/"     /             190 191 )
 204      ( "and"   calcFunc-and  190 191 )
 205      ( "div"   calcFunc-idiv 190 191 )
 206      ( "mod"   %             190 191 )
 207      ( "u+"    ident         -1  185 )
 208      ( "u-"    neg           -1  185 )
 209      ( "+"     +             180 181 )
 210      ( "-"     -             180 181 )
 211      ( "or"    calcFunc-or   180 181 )
 212      ( "xor"   calcFunc-xor  180 181 )
 213      ( "shl"   calcFunc-lsh  180 181 )
 214      ( "shr"   calcFunc-rsh  180 181 )
 215      ( "in"    calcFunc-in   160 161 )
 216      ( "<"     calcFunc-lt   160 161 )
 217      ( ">"     calcFunc-gt   160 161 )
 218      ( "<="    calcFunc-leq  160 161 )
 219      ( ">="    calcFunc-geq  160 161 )
 220      ( "="     calcFunc-eq   160 161 )
 221      ( "<>"    calcFunc-neq  160 161 )
 222      ( "!!!"   calcFunc-pnot  -1  85 )
 223      ( "&&&"   calcFunc-pand  80  81 )
 224      ( "|||"   calcFunc-por   75  76 )
 225      ( ":="    calcFunc-assign 51 50 )
 226      ( "::"    calcFunc-condition 45 46 )))
 227
 228 (put 'pascal 'math-input-filter 'calc-input-case-filter)
 229 (put 'pascal 'math-output-filter 'calc-output-case-filter)
 230
 231 (put 'pascal 'math-radix-formatter
 232      (function (lambda (r s)
 233                  (if (= r 16) (format "$%s" s)
 234                    (format "%d#%s" r s)))))
 235
 236 (put 'pascal 'math-lang-read-symbol
 237      '((?\$
 238         (eq (string-match
 239              "\\(\\$[0-9a-fA-F]+\\)\\($\\|[^0-9a-zA-Z]\\)"
 240 ;             "\\(\\$[0-9a-fA-F]+\\)\\($\\|[^0-9a-zA-Zα-ωΑ-Ω]\\)"
 241              math-exp-str math-exp-pos)
 242             math-exp-pos)
 243         (setq math-exp-token 'number
 244               math-expr-data (math-match-substring math-exp-str 1)
 245               math-exp-pos (match-end 1)))))
 246
 247 (put 'pascal 'math-compose-subscr
 248      (function
 249       (lambda (a)
 250         (let ((args (cdr (cdr a))))
 251           (while (eq (car-safe (nth 1 a)) 'calcFunc-subscr)
 252             (setq args (append (cdr (cdr (nth 1 a))) args)
 253                   a (nth 1 a)))
 254           (list 'horiz
 255                 (math-compose-expr (nth 1 a) 1000)
 256                 "["
 257                 (math-compose-vector args ", " 0)
 258                 "]")))))
 259
 260 (add-to-list 'calc-lang-allow-underscores 'pascal)
 261 (add-to-list 'calc-lang-brackets-are-subscripts 'pascal)
 262
 263 (defun calc-input-case-filter (str)
 264   (cond ((or (null calc-language-option) (= calc-language-option 0))
 265          str)
 266         (t
 267          (downcase str))))
 268
 269 (defun calc-output-case-filter (str)
 270   (cond ((or (null calc-language-option) (= calc-language-option 0))
 271          str)
 272         ((> calc-language-option 0)
 273          (upcase str))
 274         (t
 275          (downcase str))))
 276
 277
 278 (defun calc-fortran-language (n)
 279   (interactive "P")
 280   (calc-wrapper
 281    (and n (setq n (prefix-numeric-value n)))
 282    (calc-set-language 'fortran n)
 283    (message (if (and n (/= n 0))
 284                 (if (> n 0)
 285                     "FORTRAN language mode (all uppercase)"
 286                   "FORTRAN language mode (all lowercase)")
 287               "FORTRAN language mode"))))
 288
 289 (put 'fortran 'math-oper-table
 290   '( ( "u/"    (math-parse-fortran-vector) -1 1 )
 291      ( "/"     (math-parse-fortran-vector-end) 1 -1 )
 292      ( "**"    ^             201 200 )
 293      ( "u+"    ident         -1  191 )
 294      ( "u-"    neg           -1  191 )
 295      ( "*"     *             190 191 )
 296      ( "/"     /             190 191 )
 297      ( "+"     +             180 181 )
 298      ( "-"     -             180 181 )
 299      ( ".LT."  calcFunc-lt   160 161 )
 300      ( ".GT."  calcFunc-gt   160 161 )
 301      ( ".LE."  calcFunc-leq  160 161 )
 302      ( ".GE."  calcFunc-geq  160 161 )
 303      ( ".EQ."  calcFunc-eq   160 161 )
 304      ( ".NE."  calcFunc-neq  160 161 )
 305      ( ".NOT." calcFunc-lnot -1  121 )
 306      ( ".AND." calcFunc-land 110 111 )
 307      ( ".OR."  calcFunc-lor  100 101 )
 308      ( "!!!"   calcFunc-pnot  -1  85 )
 309      ( "&&&"   calcFunc-pand  80  81 )
 310      ( "|||"   calcFunc-por   75  76 )
 311      ( "="     calcFunc-assign 51 50 )
 312      ( ":="    calcFunc-assign 51 50 )
 313      ( "::"    calcFunc-condition 45 46 )))
 314
 315 (put 'fortran 'math-vector-brackets "//")
 316
 317 (put 'fortran 'math-function-table
 318   '( ( acos        . calcFunc-arccos )
 319      ( acosh       . calcFunc-arccosh )
 320      ( aimag       . calcFunc-im )
 321      ( aint        . calcFunc-ftrunc )
 322      ( asin        . calcFunc-arcsin )
 323      ( asinh       . calcFunc-arcsinh )
 324      ( atan        . calcFunc-arctan )
 325      ( atan2       . calcFunc-arctan2 )
 326      ( atanh       . calcFunc-arctanh )
 327      ( conjg       . calcFunc-conj )
 328      ( log         . calcFunc-ln )
 329      ( nint        . calcFunc-round )
 330      ( real        . calcFunc-re )))
 331
 332 (put 'fortran 'math-input-filter 'calc-input-case-filter)
 333
 334 (put 'fortran 'math-output-filter 'calc-output-case-filter)
 335
 336 (put 'fortran 'math-lang-read-symbol
 337      '((?\.
 338         (eq (string-match "\\.[a-zA-Z][a-zA-Z][a-zA-Z]?\\."
 339 ;        (eq (string-match "\\.[a-zA-Zα-ωΑ-Ω][a-zA-Zα-ωΑ-Ω][a-zA-Zα-ωΑ-Ω]?\\."
 340                           math-exp-str math-exp-pos) math-exp-pos)
 341         (setq math-exp-token 'punc
 342               math-expr-data (upcase (math-match-substring math-exp-str 0))
 343               math-exp-pos (match-end 0)))))
 344
 345 (put 'fortran 'math-compose-subscr
 346      (function
 347       (lambda (a)
 348         (let ((args (cdr (cdr a))))
 349           (while (eq (car-safe (nth 1 a)) 'calcFunc-subscr)
 350             (setq args (append (cdr (cdr (nth 1 a))) args)
 351                   a (nth 1 a)))
 352           (list 'horiz
 353                 (math-compose-expr (nth 1 a) 1000)
 354                 "("
 355                 (math-compose-vector args ", " 0)
 356                 ")")))))
 357
 358 (add-to-list 'calc-lang-slash-idiv 'fortran)
 359 (add-to-list 'calc-lang-allow-underscores 'fortran)
 360 (add-to-list 'calc-lang-parens-are-subscripts 'fortran)
 361
 362 ;; The next few variables are local to math-read-exprs in calc-aent.el
 363 ;; and math-read-expr in calc-ext.el, but are set in functions they call.
 364
 365 (defvar math-exp-token)
 366 (defvar math-expr-data)
 367 (defvar math-exp-old-pos)
 368
 369 (defvar math-parsing-fortran-vector nil)
 370 (defun math-parse-fortran-vector (op)
 371   (let ((math-parsing-fortran-vector '(end . "\000")))
 372     (prog1
 373         (math-read-brackets t "]")
 374       (setq math-exp-token (car math-parsing-fortran-vector)
 375             math-expr-data (cdr math-parsing-fortran-vector)))))
 376
 377 (defun math-parse-fortran-vector-end (x op)
 378   (if math-parsing-fortran-vector
 379       (progn
 380         (setq math-parsing-fortran-vector (cons math-exp-token math-expr-data)
 381               math-exp-token 'end
 382               math-expr-data "\000")
 383         x)
 384     (throw 'syntax "Unmatched closing `/'")))
 385
 386 (defun math-parse-fortran-subscr (sym args)
 387   (setq sym (math-build-var-name sym))
 388   (while args
 389     (setq sym (list 'calcFunc-subscr sym (car args))
 390           args (cdr args)))
 391   sym)
 392
 393
 394 (defun calc-tex-language (n)
 395   (interactive "P")
 396   (calc-wrapper
 397    (and n (setq n (prefix-numeric-value n)))
 398    (calc-set-language 'tex n)
 399    (cond ((not n)
 400           (message "TeX language mode"))
 401          ((= n 0)
 402           (message "TeX language mode with multiline matrices"))
 403          ((= n 1)
 404           (message "TeX language mode with \\hbox{func}(\\hbox{var})"))
 405          ((> n 1)
 406           (message
 407            "TeX language mode with \\hbox{func}(\\hbox{var}) and multiline matrices"))
 408          ((= n -1)
 409           (message "TeX language mode with \\func(\\hbox{var})"))
 410          ((< n -1)
 411           (message
 412            "TeX language mode with \\func(\\hbox{var}) and multiline matrices")))))
 413
 414 (defun calc-latex-language (n)
 415   (interactive "P")
 416   (calc-wrapper
 417    (and n (setq n (prefix-numeric-value n)))
 418    (calc-set-language 'latex n)
 419    (cond ((not n)
 420           (message "LaTeX language mode"))
 421          ((= n 0)
 422           (message "LaTeX language mode with multiline matrices"))
 423          ((= n 1)
 424           (message "LaTeX language mode with \\text{func}(\\text{var})"))
 425          ((> n 1)
 426           (message
 427            "LaTeX language mode with \\text{func}(\\text{var}) and multiline matrices"))
 428          ((= n -1)
 429           (message "LaTeX language mode with \\func(\\text{var})"))
 430          ((< n -1)
 431           (message
 432            "LaTeX language mode with \\func(\\text{var}) and multiline matrices")))))
 433
 434 (put 'tex 'math-lang-name "TeX")
 435 (put 'latex 'math-lang-name "LaTeX")
 436
 437 (put 'tex 'math-oper-table
 438   '( ( "\\hat"    calcFunc-hat     -1  950 )
 439      ( "\\check"  calcFunc-check   -1  950 )
 440      ( "\\tilde"  calcFunc-tilde   -1  950 )
 441      ( "\\acute"  calcFunc-acute   -1  950 )
 442      ( "\\grave"  calcFunc-grave   -1  950 )
 443      ( "\\dot"    calcFunc-dot     -1  950 )
 444      ( "\\ddot"   calcFunc-dotdot  -1  950 )
 445      ( "\\breve"  calcFunc-breve   -1  950 )
 446      ( "\\bar"    calcFunc-bar     -1  950 )
 447      ( "\\vec"    calcFunc-Vec     -1  950 )
 448      ( "\\underline" calcFunc-under -1  950 )
 449      ( "u|"       calcFunc-abs     -1    0 )
 450      ( "|"        closing           0   -1 )
 451      ( "\\lfloor" calcFunc-floor   -1    0 )
 452      ( "\\rfloor" closing           0   -1 )
 453      ( "\\lceil"  calcFunc-ceil    -1    0 )
 454      ( "\\rceil"  closing           0   -1 )
 455      ( "\\pm"     sdev             300 300 )
 456      ( "!"        calcFunc-fact    210  -1 )
 457      ( "^"        ^                201 200 )
 458      ( "_"        calcFunc-subscr  201 200 )
 459      ( "u+"       ident            -1  197 )
 460      ( "u-"       neg              -1  197 )
 461      ( "\\times"  *                191 190 )
 462      ( "*"        *                191 190 )
 463      ( "2x"       *                191 190 )
 464      ( "+"        +                180 181 )
 465      ( "-"        -                180 181 )
 466      ( "\\over"   /                170 171 )
 467      ( "/"        /                170 171 )
 468      ( "\\choose" calcFunc-choose  170 171 )
 469      ( "\\mod"    %                170 171 )
 470      ( "<"        calcFunc-lt      160 161 )
 471      ( ">"        calcFunc-gt      160 161 )
 472      ( "\\leq"    calcFunc-leq     160 161 )
 473      ( "\\geq"    calcFunc-geq     160 161 )
 474      ( "="        calcFunc-eq      160 161 )
 475      ( "\\neq"    calcFunc-neq     160 161 )
 476      ( "\\ne"     calcFunc-neq     160 161 )
 477      ( "\\lnot"   calcFunc-lnot     -1 121 )
 478      ( "\\land"   calcFunc-land    110 111 )
 479      ( "\\lor"    calcFunc-lor     100 101 )
 480      ( "?"        (math-read-if)    91  90 )
 481      ( "!!!"      calcFunc-pnot     -1  85 )
 482      ( "&&&"      calcFunc-pand     80  81 )
 483      ( "|||"      calcFunc-por      75  76 )
 484      ( "\\gets"   calcFunc-assign   51  50 )
 485      ( ":="       calcFunc-assign   51  50 )
 486      ( "::"       calcFunc-condition 45 46 )
 487      ( "\\to"     calcFunc-evalto   40  41 )
 488      ( "\\to"     calcFunc-evalto   40  -1 )
 489      ( "=>"       calcFunc-evalto   40  41 )
 490      ( "=>"       calcFunc-evalto   40  -1 )))
 491
 492 (put 'tex 'math-function-table
 493   '( ( \\arccos    . calcFunc-arccos )
 494      ( \\arcsin    . calcFunc-arcsin )
 495      ( \\arctan    . calcFunc-arctan )
 496      ( \\arg       . calcFunc-arg )
 497      ( \\cos       . calcFunc-cos )
 498      ( \\cosh      . calcFunc-cosh )
 499      ( \\cot       . calcFunc-cot )
 500      ( \\coth      . calcFunc-coth )
 501      ( \\csc       . calcFunc-csc )
 502      ( \\det       . calcFunc-det )
 503      ( \\exp       . calcFunc-exp )
 504      ( \\gcd       . calcFunc-gcd )
 505      ( \\ln        . calcFunc-ln )
 506      ( \\log       . calcFunc-log10 )
 507      ( \\max       . calcFunc-max )
 508      ( \\min       . calcFunc-min )
 509      ( \\sec       . calcFunc-sec )
 510      ( \\sin       . calcFunc-sin )
 511      ( \\sinh      . calcFunc-sinh )
 512      ( \\sqrt      . calcFunc-sqrt )
 513      ( \\tan       . calcFunc-tan )
 514      ( \\tanh      . calcFunc-tanh )
 515      ( \\phi       . calcFunc-totient )
 516      ( \\mu        . calcFunc-moebius )))
 517
 518 (put 'tex 'math-special-function-table
 519      '((calcFunc-sum . (math-compose-tex-sum "\\sum"))
 520        (calcFunc-prod . (math-compose-tex-sum "\\prod"))
 521        (calcFunc-sqrt . math-compose-tex-sqrt)
 522        (intv . math-compose-tex-intv)))
 523
 524 (put 'tex 'math-variable-table
 525   '(
 526     ;; The Greek letters
 527     ( \\alpha      . var-alpha )
 528     ( \\beta       . var-beta  )
 529     ( \\gamma      . var-gamma )
 530     ( \\Gamma      . var-Gamma )
 531     ( \\delta      . var-delta )
 532     ( \\Delta      . var-Delta )
 533     ( \\epsilon    . var-epsilon )
 534     ( \\varepsilon . var-varepsilon)
 535     ( \\zeta       . var-zeta )
 536     ( \\eta        . var-eta  )
 537     ( \\theta      . var-theta )
 538     ( \\vartheta   . var-vartheta )
 539     ( \\Theta      . var-Theta )
 540     ( \\iota       . var-iota )
 541     ( \\kappa      . var-kappa )
 542     ( \\lambda     . var-lambda )
 543     ( \\Lambda     . var-Lambda )
 544     ( \\mu         . var-mu )
 545     ( \\nu         . var-nu )
 546     ( \\xi         . var-xi )
 547     ( \\Xi         . var-Xi )
 548     ( \\pi         . var-pi )
 549     ( \\varpi      . var-varpi )
 550     ( \\Pi         . var-Pi )
 551     ( \\rho        . var-rho )
 552     ( \\varrho     . var-varrho )
 553     ( \\sigma      . var-sigma )
 554     ( \\sigma      . var-varsigma )
 555     ( \\Sigma      . var-Sigma )
 556     ( \\tau        . var-tau )
 557     ( \\upsilon    . var-upsilon )
 558     ( \\Upsilon    . var-Upsilon )
 559     ( \\phi        . var-phi )
 560     ( \\varphi     . var-varphi )
 561     ( \\Phi        . var-Phi )
 562     ( \\chi        . var-chi )
 563     ( \\psi        . var-psi )
 564     ( \\Psi        . var-Psi )
 565     ( \\omega      . var-omega )
 566     ( \\Omega      . var-Omega )
 567     ;; Units
 568     ( pt           . var-texpt )
 569     ( pc           . var-texpc )
 570     ( bp           . var-texbp )
 571     ( dd           . var-texdd )
 572     ( cc           . var-texcc )
 573     ( sp           . var-texsp )
 574     ( pint         . var-pt )
 575     ( parsec       . var-pc)
 576
 577     ;; Others
 578     ( \\ell        . var-ell )
 579     ( \\infty      . var-inf )
 580     ( \\infty      . var-uinf )
 581     ( \\sum        . (math-parse-tex-sum calcFunc-sum) )
 582     ( \\prod       . (math-parse-tex-sum calcFunc-prod) )))
 583
 584 (put 'tex 'math-punc-table
 585      '((?\{ . ?\()
 586        (?\} . ?\))
 587        (?\& . ?\,)))
 588
 589 (put 'tex 'math-complex-format 'i)
 590
 591 (put 'tex 'math-input-filter 'math-tex-input-filter)
 592
 593 (put 'tex 'math-matrix-formatter
 594      (function
 595       (lambda (a)
 596         (if (and (integerp calc-language-option)
 597                  (or (= calc-language-option 0)
 598                      (> calc-language-option 1)
 599                      (< calc-language-option -1)))
 600             (append '(vleft 0 "\\matrix{")
 601                     (math-compose-tex-matrix (cdr a))
 602                     '("}"))
 603           (append '(horiz "\\matrix{ ")
 604                   (math-compose-tex-matrix (cdr a))
 605                   '(" }"))))))
 606
 607 (put 'tex 'math-var-formatter 'math-compose-tex-var)
 608
 609 (put 'tex 'math-func-formatter 'math-compose-tex-func)
 610
 611 (put 'tex 'math-dots "\\ldots")
 612
 613 (put 'tex 'math-big-parens '("\\left( " . " \\right)"))
 614
 615 (put 'tex 'math-evalto '("\\evalto " . " \\to "))
 616
 617 (defconst math-tex-ignore-words
 618   '( ("\\hbox") ("\\mbox") ("\\text") ("\\left") ("\\right")
 619      ("\\,") ("\\>") ("\\:") ("\\;") ("\\!") ("\\ ")
 620      ("\\quad") ("\\qquad") ("\\hfil") ("\\hfill")
 621      ("\\displaystyle") ("\\textstyle") ("\\dsize") ("\\tsize")
 622      ("\\scriptstyle") ("\\scriptscriptstyle") ("\\ssize") ("\\sssize")
 623      ("\\rm") ("\\bf") ("\\it") ("\\sl")
 624      ("\\roman") ("\\bold") ("\\italic") ("\\slanted")
 625      ("\\cal") ("\\mit") ("\\Cal") ("\\Bbb") ("\\frak") ("\\goth")
 626      ("\\evalto")
 627      ("\\matrix" mat) ("\\bmatrix" mat) ("\\pmatrix" mat)
 628      ("\\begin" begenv)
 629      ("\\cr" punc ";") ("\\\\" punc ";") ("\\*" punc "*")
 630      ("\\{" punc "[") ("\\}" punc "]")))
 631
 632 (defconst math-latex-ignore-words
 633   (append math-tex-ignore-words
 634           '(("\\begin" begenv))))
 635
 636 (put 'tex 'math-lang-read-symbol
 637      '((?\\
 638         (< math-exp-pos (1- (length math-exp-str)))
 639         (progn
 640           (or (string-match "\\\\hbox *{\\([a-zA-Z0-9]+\\)}"
 641 ;          (or (string-match "\\\\hbox *{\\([a-zA-Zα-ωΑ-Ω0-9]+\\)}"
 642                             math-exp-str math-exp-pos)
 643               (string-match "\\(\\\\\\([a-zA-Z]+\\|[^a-zA-Z]\\)\\)"
 644 ;              (string-match "\\(\\\\\\([a-zA-Zα-ωΑ-Ω]+\\|[^a-zA-Zα-ωΑ-Ω]\\)\\)"
 645                             math-exp-str math-exp-pos))
 646           (setq math-exp-token 'symbol
 647                 math-exp-pos (match-end 0)
 648                 math-expr-data (math-restore-dashes
 649                                 (math-match-substring math-exp-str 1)))
 650           (let ((code (assoc math-expr-data math-latex-ignore-words)))
 651             (cond ((null code))
 652                   ((null (cdr code))
 653                    (math-read-token))
 654                   ((eq (nth 1 code) 'punc)
 655                    (setq math-exp-token 'punc
 656                          math-expr-data (nth 2 code)))
 657                   ((and (eq (nth 1 code) 'mat)
 658                         (string-match " *{" math-exp-str math-exp-pos))
 659                    (setq math-exp-pos (match-end 0)
 660                          math-exp-token 'punc
 661                          math-expr-data "[")
 662                    (let ((right (string-match "}" math-exp-str math-exp-pos)))
 663                      (and right
 664                           (setq math-exp-str (copy-sequence math-exp-str))
 665                           (aset math-exp-str right ?\]))))))))))
 666
 667 (defun math-compose-tex-matrix (a &optional ltx)
 668   (if (cdr a)
 669       (cons (append (math-compose-vector (cdr (car a)) " & " 0)
 670                     (if ltx '(" \\\\ ") '(" \\cr ")))
 671             (math-compose-tex-matrix (cdr a) ltx))
 672     (list (math-compose-vector (cdr (car a)) " & " 0))))
 673
 674 (defun math-compose-tex-sum (a fn)
 675   (cond
 676    ((nth 4 a)
 677     (list 'horiz (nth 1 fn)
 678           "_{" (math-compose-expr (nth 2 a) 0)
 679           "=" (math-compose-expr (nth 3 a) 0)
 680           "}^{" (math-compose-expr (nth 4 a) 0)
 681           "}{" (math-compose-expr (nth 1 a) 0) "}"))
 682    ((nth 3 a)
 683     (list 'horiz (nth 1 fn)
 684           "_{" (math-compose-expr (nth 2 a) 0)
 685           "=" (math-compose-expr (nth 3 a) 0)
 686           "}{" (math-compose-expr (nth 1 a) 0) "}"))
 687    (t
 688     (list 'horiz (nth 1 fn)
 689           "_{" (math-compose-expr (nth 2 a) 0)
 690           "}{" (math-compose-expr (nth 1 a) 0) "}"))))
 691
 692 (defun math-parse-tex-sum (f val)
 693   (let (low high save)
 694     (or (equal math-expr-data "_") (throw 'syntax "Expected `_'"))
 695     (math-read-token)
 696     (setq save math-exp-old-pos)
 697     (setq low (math-read-factor))
 698     (or (eq (car-safe low) 'calcFunc-eq)
 699         (progn
 700           (setq math-exp-old-pos (1+ save))
 701           (throw 'syntax "Expected equation")))
 702     (or (equal math-expr-data "^") (throw 'syntax "Expected `^'"))
 703     (math-read-token)
 704     (setq high (math-read-factor))
 705     (list (nth 2 f) (math-read-factor) (nth 1 low) (nth 2 low) high)))
 706
 707 (defun math-tex-input-filter (str)   ; allow parsing of 123\,456\,789.
 708   (while (string-match "[0-9]\\\\,[0-9]" str)
 709     (setq str (concat (substring str 0 (1+ (match-beginning 0)))
 710                       (substring str (1- (match-end 0))))))
 711   str)
 712
 713 (defun math-compose-tex-sqrt (a)
 714   (list 'horiz
 715         "\\sqrt{"
 716         (math-compose-expr (nth 1 a) 0)
 717         "}"))
 718
 719 (defun math-compose-tex-intv (a)
 720   (list 'horiz
 721         (if (memq (nth 1 a) '(0 1)) "(" "[")
 722         (math-compose-expr (nth 2 a) 0)
 723         " \\ldots "
 724         (math-compose-expr (nth 3 a) 0)
 725         (if (memq (nth 1 a) '(0 2)) ")" "]")))
 726
 727 (defun math-compose-tex-var (a prec)
 728   (if (and calc-language-option
 729            (not (= calc-language-option 0))
 730            (string-match "\\`[a-zA-Z][a-zA-Z0-9]+\\'"
 731 ;           (string-match "\\`[a-zA-Zα-ωΑ-Ω][a-zA-Zα-ωΑ-Ω0-9]+\\'"
 732                          (symbol-name (nth 1 a))))
 733       (if (eq calc-language 'latex)
 734           (format "\\text{%s}" (symbol-name (nth 1 a)))
 735         (format "\\hbox{%s}" (symbol-name (nth 1 a))))
 736     (math-compose-var a)))
 737
 738 (defun math-compose-tex-func (func a)
 739   (let (left right)
 740     (if (and calc-language-option
 741              (not (= calc-language-option 0))
 742              (string-match "\\`[a-zA-Z][a-zA-Z0-9]+\\'" func))
 743  ;            (string-match "\\`[a-zA-Zα-ωΑ-Ω][a-zA-Zα-ωΑ-Ω0-9]+\\'" func))
 744         (if (< (prefix-numeric-value calc-language-option) 0)
 745             (setq func (format "\\%s" func))
 746           (setq func (if (eq calc-language 'latex)
 747                          (format "\\text{%s}" func)
 748                        (format "\\hbox{%s}" func)))))
 749     (cond ((or (> (length a) 2)
 750                (not (math-tex-expr-is-flat (nth 1 a))))
 751            (setq left "\\left( "
 752                  right " \\right)"))
 753           ((and (eq (aref func 0) ?\\)
 754                 (not (or
 755                       (string-match "\\hbox{" func)
 756                       (string-match "\\text{" func)))
 757                 (= (length a) 2)
 758                 (or (Math-realp (nth 1 a))
 759                     (memq (car (nth 1 a)) '(var *))))
 760            (setq left "{" right "}"))
 761           (t (setq left calc-function-open
 762                    right calc-function-close)))
 763     (list 'horiz func
 764           left
 765           (math-compose-vector (cdr a) ", " 0)
 766           right)))
 767
 768 (put 'latex 'math-oper-table
 769      (append (get 'tex 'math-oper-table)
 770              '(( "\\Hat"    calcFunc-Hat     -1  950 )
 771                ( "\\Check"  calcFunc-Check   -1  950 )
 772                ( "\\Tilde"  calcFunc-Tilde   -1  950 )
 773                ( "\\Acute"  calcFunc-Acute   -1  950 )
 774                ( "\\Grave"  calcFunc-Grave   -1  950 )
 775                ( "\\Dot"    calcFunc-Dot     -1  950 )
 776                ( "\\Ddot"   calcFunc-Dotdot  -1  950 )
 777                ( "\\Breve"  calcFunc-Breve   -1  950 )
 778                ( "\\Bar"    calcFunc-Bar     -1  950 )
 779                ( "\\Vec"    calcFunc-VEC     -1  950 )
 780                ( "\\dddot"  calcFunc-dddot   -1  950 )
 781                ( "\\ddddot" calcFunc-ddddot  -1  950 )
 782                ( "\\div"     /                170 171 )
 783                ( "\\le"     calcFunc-leq     160 161 )
 784                ( "\\leqq"   calcFunc-leq     160 161 )
 785                ( "\\leqsland" calcFunc-leq   160 161 )
 786                ( "\\ge"     calcFunc-geq     160 161 )
 787                ( "\\geqq"   calcFunc-geq     160 161 )
 788                ( "\\geqslant" calcFunc-geq   160 161 )
 789                ( "="        calcFunc-eq      160 161 )
 790                ( "\\neq"    calcFunc-neq     160 161 )
 791                ( "\\ne"     calcFunc-neq     160 161 )
 792                ( "\\lnot"   calcFunc-lnot     -1 121 )
 793                ( "\\land"   calcFunc-land    110 111 )
 794                ( "\\lor"    calcFunc-lor     100 101 )
 795                ( "?"        (math-read-if)    91  90 )
 796                ( "!!!"      calcFunc-pnot     -1  85 )
 797                ( "&&&"      calcFunc-pand     80  81 )
 798                ( "|||"      calcFunc-por      75  76 )
 799                ( "\\gets"   calcFunc-assign   51  50 )
 800                ( ":="       calcFunc-assign   51  50 )
 801                ( "::"       calcFunc-condition 45 46 )
 802                ( "\\to"     calcFunc-evalto   40  41 )
 803                ( "\\to"     calcFunc-evalto   40  -1 )
 804                ( "=>"       calcFunc-evalto   40  41 )
 805                ( "=>"       calcFunc-evalto   40  -1 ))))
 806
 807 (put 'latex 'math-function-table
 808      (append
 809       (get 'tex 'math-function-table)
 810       '(( \\frac      . (math-latex-parse-frac))
 811         ( \\tfrac     . (math-latex-parse-frac))
 812         ( \\dfrac     . (math-latex-parse-frac))
 813         ( \\binom     . (math-latex-parse-two-args calcFunc-choose))
 814         ( \\tbinom    . (math-latex-parse-two-args calcFunc-choose))
 815         ( \\dbinom    . (math-latex-parse-two-args calcFunc-choose))
 816         ( \\phi       . calcFunc-totient )
 817         ( \\mu        . calcFunc-moebius ))))
 818
 819 (put 'latex 'math-special-function-table
 820      '((/               . (math-compose-latex-frac "\\frac"))
 821        (calcFunc-choose . (math-compose-latex-frac "\\binom"))
 822        (calcFunc-sum . (math-compose-tex-sum "\\sum"))
 823        (calcFunc-prod . (math-compose-tex-sum "\\prod"))
 824        (calcFunc-sqrt . math-compose-tex-sqrt)
 825        (intv          . math-compose-tex-intv)))
 826
 827 (put 'latex 'math-variable-table
 828      (get 'tex 'math-variable-table))
 829
 830 (put 'latex 'math-punc-table
 831      '((?\{ . ?\()
 832        (?\} . ?\))
 833        (?\& . ?\,)))
 834
 835 (put 'latex 'math-complex-format 'i)
 836
 837 (put 'latex 'math-matrix-formatter
 838      (function
 839       (lambda (a)
 840         (if (and (integerp calc-language-option)
 841                  (or (= calc-language-option 0)
 842                      (> calc-language-option 1)
 843                      (< calc-language-option -1)))
 844             (append '(vleft 0 "\\begin{pmatrix}")
 845                     (math-compose-tex-matrix (cdr a) t)
 846                     '("\\end{pmatrix}"))
 847           (append '(horiz "\\begin{pmatrix} ")
 848                   (math-compose-tex-matrix (cdr a) t)
 849                   '(" \\end{pmatrix}"))))))
 850
 851 (put 'latex 'math-var-formatter 'math-compose-tex-var)
 852
 853 (put 'latex 'math-func-formatter 'math-compose-tex-func)
 854
 855 (put 'latex 'math-dots "\\ldots")
 856
 857 (put 'latex 'math-big-parens '("\\left( " . " \\right)"))
 858
 859 (put 'latex 'math-evalto '("\\evalto " . " \\to "))
 860
 861 (put 'latex 'math-lang-read-symbol
 862      '((?\\
 863         (< math-exp-pos (1- (length math-exp-str)))
 864         (progn
 865           (or (string-match "\\\\hbox *{\\([a-zA-Z0-9]+\\)}"
 866 ;          (or (string-match "\\\\hbox *{\\([a-zA-Zα-ωΑ-Ω0-9]+\\)}"
 867                             math-exp-str math-exp-pos)
 868               (string-match "\\\\text *{\\([a-zA-Z0-9]+\\)}"
 869 ;              (string-match "\\\\text *{\\([a-zA-Zα-ωΑ-Ω0-9]+\\)}"
 870                             math-exp-str math-exp-pos)
 871               (string-match "\\(\\\\\\([a-zA-Z]+\\|[^a-zA-Z]\\)\\)"
 872 ;              (string-match "\\(\\\\\\([a-zA-Zα-ωΑ-Ω]+\\|[^a-zA-Zα-ωΑ-Ω]\\)\\)"
 873                             math-exp-str math-exp-pos))
 874           (setq math-exp-token 'symbol
 875                 math-exp-pos (match-end 0)
 876                 math-expr-data (math-restore-dashes
 877                                 (math-match-substring math-exp-str 1)))
 878           (let ((code (assoc math-expr-data math-tex-ignore-words))
 879                 envname)
 880             (cond ((null code))
 881                   ((null (cdr code))
 882                    (math-read-token))
 883                   ((eq (nth 1 code) 'punc)
 884                    (setq math-exp-token 'punc
 885                          math-expr-data (nth 2 code)))
 886                   ((and (eq (nth 1 code) 'begenv)
 887                         (string-match " *{\\([^}]*\\)}" math-exp-str math-exp-pos))
 888                    (setq math-exp-pos (match-end 0)
 889                          envname (match-string 1 math-exp-str)
 890                          math-exp-token 'punc
 891                          math-expr-data "[")
 892                    (cond ((or (string= envname "matrix")
 893                               (string= envname "bmatrix")
 894                               (string= envname "smallmatrix")
 895                               (string= envname "pmatrix"))
 896                           (if (string-match (concat "\\\\end{" envname "}")
 897                                             math-exp-str math-exp-pos)
 898                               (setq math-exp-str
 899                                     (replace-match "]" t t math-exp-str))
 900                             (error "%s" (concat "No closing \\end{" envname "}"))))))
 901                   ((and (eq (nth 1 code) 'mat)
 902                         (string-match " *{" math-exp-str math-exp-pos))
 903                    (setq math-exp-pos (match-end 0)
 904                          math-exp-token 'punc
 905                          math-expr-data "[")
 906                    (let ((right (string-match "}" math-exp-str math-exp-pos)))
 907                      (and right
 908                           (setq math-exp-str (copy-sequence math-exp-str))
 909                           (aset math-exp-str right ?\]))))))))))
 910
 911 (defun math-latex-parse-frac (f val)
 912   (let (numer denom)
 913     (setq numer (car (math-read-expr-list)))
 914     (math-read-token)
 915     (setq denom (math-read-factor))
 916     (if (and (Math-num-integerp numer)
 917              (Math-num-integerp denom))
 918         (list 'frac numer denom)
 919       (list '/ numer denom))))
 920
 921 (defun math-latex-parse-two-args (f val)
 922   (let (first second)
 923     (setq first (car (math-read-expr-list)))
 924     (math-read-token)
 925     (setq second (math-read-factor))
 926     (list (nth 2 f) first second)))
 927
 928 (defun math-compose-latex-frac (a fn)
 929   (list 'horiz (nth 1 fn) "{" (math-compose-expr (nth 1 a) -1)
 930                "}{"
 931                (math-compose-expr (nth 2 a) -1)
 932                "}"))
 933
 934 (put 'latex 'math-input-filter 'math-tex-input-filter)
 935
 936 (defun calc-eqn-language (n)
 937   (interactive "P")
 938   (calc-wrapper
 939    (calc-set-language 'eqn)
 940    (message "Eqn language mode")))
 941
 942 (put 'eqn 'math-oper-table
 943   '( ( "prime"    (math-parse-eqn-prime) 950  -1 )
 944      ( "prime"    calcFunc-Prime   950  -1 )
 945      ( "dot"      calcFunc-dot     950  -1 )
 946      ( "dotdot"   calcFunc-dotdot  950  -1 )
 947      ( "hat"      calcFunc-hat     950  -1 )
 948      ( "tilde"    calcFunc-tilde   950  -1 )
 949      ( "vec"      calcFunc-Vec     950  -1 )
 950      ( "dyad"     calcFunc-dyad    950  -1 )
 951      ( "bar"      calcFunc-bar     950  -1 )
 952      ( "under"    calcFunc-under   950  -1 )
 953      ( "sub"      calcFunc-subscr  931 930 )
 954      ( "sup"      ^                921 920 )
 955      ( "sqrt"     calcFunc-sqrt    -1  910 )
 956      ( "over"     /                900 901 )
 957      ( "u|"       calcFunc-abs     -1    0 )
 958      ( "|"        closing           0   -1 )
 959      ( "left floor"  calcFunc-floor -1   0 )
 960      ( "right floor" closing        0   -1 )
 961      ( "left ceil"   calcFunc-ceil  -1   0 )
 962      ( "right ceil"  closing        0   -1 )
 963      ( "+-"       sdev             300 300 )
 964      ( "!"        calcFunc-fact    210  -1 )
 965      ( "u+"       ident            -1  197 )
 966      ( "u-"       neg              -1  197 )
 967      ( "times"    *                191 190 )
 968      ( "*"        *                191 190 )
 969      ( "2x"       *                191 190 )
 970      ( "/"        /                180 181 )
 971      ( "%"        %                180 181 )
 972      ( "+"        +                170 171 )
 973      ( "-"        -                170 171 )
 974      ( "<"        calcFunc-lt      160 161 )
 975      ( ">"        calcFunc-gt      160 161 )
 976      ( "<="       calcFunc-leq     160 161 )
 977      ( ">="       calcFunc-geq     160 161 )
 978      ( "="        calcFunc-eq      160 161 )
 979      ( "=="       calcFunc-eq      160 161 )
 980      ( "!="       calcFunc-neq     160 161 )
 981      ( "u!"       calcFunc-lnot     -1 121 )
 982      ( "&&"       calcFunc-land    110 111 )
 983      ( "||"       calcFunc-lor     100 101 )
 984      ( "?"        (math-read-if)    91  90 )
 985      ( "!!!"      calcFunc-pnot     -1  85 )
 986      ( "&&&"      calcFunc-pand     80  81 )
 987      ( "|||"      calcFunc-por      75  76 )
 988      ( "<-"       calcFunc-assign   51  50 )
 989      ( ":="       calcFunc-assign   51  50 )
 990      ( "::"       calcFunc-condition 45 46 )
 991      ( "->"       calcFunc-evalto   40  41 )
 992      ( "->"       calcFunc-evalto   40  -1 )
 993      ( "=>"       calcFunc-evalto   40  41 )
 994      ( "=>"       calcFunc-evalto   40  -1 )))
 995
 996 (put 'eqn 'math-function-table
 997   '( ( arc\ cos    . calcFunc-arccos )
 998      ( arc\ cosh   . calcFunc-arccosh )
 999      ( arc\ sin    . calcFunc-arcsin )
1000      ( arc\ sinh   . calcFunc-arcsinh )
1001      ( arc\ tan    . calcFunc-arctan )
1002      ( arc\ tanh   . calcFunc-arctanh )
1003      ( GAMMA       . calcFunc-gamma )
1004      ( phi         . calcFunc-totient )
1005      ( mu          . calcFunc-moebius )
1006      ( matrix      . (math-parse-eqn-matrix) )))
1007
1008 (put 'eqn 'math-special-function-table
1009      '((intv . math-compose-eqn-intv)))
1010
1011 (put 'eqn 'math-punc-table
1012      '((?\{ . ?\()
1013        (?\} . ?\))))
1014
1015 (put 'eqn 'math-variable-table
1016   '( ( inf         . var-uinf )))
1017
1018 (put 'eqn 'math-complex-format 'i)
1019
1020 (put 'eqn 'math-big-parens '("{left ( " . " right )}"))
1021
1022 (put 'eqn 'math-evalto '("evalto " . " -> "))
1023
1024 (put 'eqn 'math-matrix-formatter
1025      (function
1026       (lambda (a)
1027         (append '(horiz "matrix { ")
1028                 (math-compose-eqn-matrix
1029                  (cdr (math-transpose a)))
1030                 '("}")))))
1031
1032 (put 'eqn 'math-var-formatter
1033      (function
1034       (lambda (a prec)
1035         (let (v)
1036           (if (and math-compose-hash-args
1037                    (let ((p calc-arg-values))
1038                      (setq v 1)
1039                      (while (and p (not (equal (car p) a)))
1040                        (setq p (and (eq math-compose-hash-args t) (cdr p))
1041                              v (1+ v)))
1042                      p))
1043               (if (eq math-compose-hash-args 1)
1044                   "#"
1045                 (format "#%d" v))
1046             (if (string-match ".'\\'" (symbol-name (nth 2 a)))
1047                 (math-compose-expr
1048                  (list 'calcFunc-Prime
1049                        (list
1050                         'var
1051                         (intern (substring (symbol-name (nth 1 a)) 0 -1))
1052                         (intern (substring (symbol-name (nth 2 a)) 0 -1))))
1053                  prec)
1054               (symbol-name (nth 1 a))))))))
1055
1056 (defconst math-eqn-special-funcs
1057   '( calcFunc-log
1058      calcFunc-ln calcFunc-exp
1059      calcFunc-sin calcFunc-cos calcFunc-tan
1060      calcFunc-sec calcFunc-csc calcFunc-cot
1061      calcFunc-sinh calcFunc-cosh calcFunc-tanh
1062      calcFunc-sech calcFunc-csch calcFunc-coth
1063      calcFunc-arcsin calcFunc-arccos calcFunc-arctan
1064      calcFunc-arcsinh calcFunc-arccosh calcFunc-arctanh))
1065
1066 (put 'eqn 'math-func-formatter
1067      (function
1068       (lambda (func a)
1069         (let (left right)
1070           (if (string-match "[^']'+\\'" func)
1071               (let ((n (- (length func) (match-beginning 0) 1)))
1072                 (setq func (substring func 0 (- n)))
1073                 (while (>= (setq n (1- n)) 0)
1074                   (setq func (concat func " prime")))))
1075           (cond ((or (> (length a) 2)
1076                      (not (math-tex-expr-is-flat (nth 1 a))))
1077                  (setq left "{left ( "
1078                        right " right )}"))
1079
1080                 ((and
1081                   (memq (car a) math-eqn-special-funcs)
1082                   (= (length a) 2)
1083                   (or (Math-realp (nth 1 a))
1084                       (memq (car (nth 1 a)) '(var *))))
1085                  (setq left "~{" right "}"))
1086                 (t
1087                  (setq left " ( "
1088                        right " )")))
1089           (list 'horiz func left
1090                 (math-compose-vector (cdr a) " , " 0)
1091                 right)))))
1092
1093 (put 'eqn 'math-lang-read-symbol
1094      '((?\"
1095         (string-match "\\(\"\\([^\"\\]\\|\\\\.\\)*\\)\\(\"\\|\\'\\)"
1096                       math-exp-str math-exp-pos)
1097         (progn
1098           (setq math-exp-str (copy-sequence math-exp-str))
1099           (aset math-exp-str (match-beginning 1) ?\{)
1100           (if (< (match-end 1) (length math-exp-str))
1101               (aset math-exp-str (match-end 1) ?\}))
1102           (math-read-token)))))
1103
1104 (defconst math-eqn-ignore-words
1105   '( ("roman") ("bold") ("italic") ("mark") ("lineup") ("evalto")
1106      ("left" ("floor") ("ceil"))
1107      ("right" ("floor") ("ceil"))
1108      ("arc" ("sin") ("cos") ("tan") ("sinh") ("cosh") ("tanh"))
1109      ("size" n) ("font" n) ("fwd" n) ("back" n) ("up" n) ("down" n)
1110      ("above" punc ",")))
1111
1112 (put 'eqn 'math-lang-adjust-words
1113      (function
1114       (lambda ()
1115         (let ((code (assoc math-expr-data math-eqn-ignore-words)))
1116           (cond ((null code))
1117                 ((null (cdr code))
1118                  (math-read-token))
1119                 ((consp (nth 1 code))
1120                  (math-read-token)
1121                  (if (assoc math-expr-data (cdr code))
1122                      (setq math-expr-data (format "%s %s"
1123                                                   (car code) math-expr-data))))
1124                 ((eq (nth 1 code) 'punc)
1125                  (setq math-exp-token 'punc
1126                        math-expr-data (nth 2 code)))
1127                 (t
1128                  (math-read-token)
1129                  (math-read-token)))))))
1130
1131 (put 'eqn 'math-lang-read
1132      '((eq (string-match "->\\|<-\\|+-\\|\\\\dots\\|~\\|\\^"
1133                          math-exp-str math-exp-pos)
1134            math-exp-pos)
1135        (progn
1136          (setq math-exp-token 'punc
1137                math-expr-data (math-match-substring math-exp-str 0)
1138                math-exp-pos (match-end 0))
1139          (and (eq (string-match "\\\\dots\\." math-exp-str math-exp-pos)
1140                   math-exp-pos)
1141               (setq math-exp-pos (match-end 0)))
1142          (if (memq (aref math-expr-data 0) '(?~ ?^))
1143              (math-read-token)))))
1144
1145
1146 (defun math-compose-eqn-matrix (a)
1147   (if a
1148       (cons
1149        (cond ((eq calc-matrix-just 'right) "rcol ")
1150              ((eq calc-matrix-just 'center) "ccol ")
1151              (t "lcol "))
1152        (cons
1153         (list 'break math-compose-level)
1154         (cons
1155          "{ "
1156          (cons
1157           (let ((math-compose-level (1+ math-compose-level)))
1158             (math-compose-vector (cdr (car a)) " above " 1000))
1159           (cons
1160            " } "
1161            (math-compose-eqn-matrix (cdr a)))))))
1162     nil))
1163
1164 (defun math-parse-eqn-matrix (f sym)
1165   (let ((vec nil))
1166     (while (assoc math-expr-data '(("ccol") ("lcol") ("rcol")))
1167       (math-read-token)
1168       (or (equal math-expr-data calc-function-open)
1169           (throw 'syntax "Expected `{'"))
1170       (math-read-token)
1171       (setq vec (cons (cons 'vec (math-read-expr-list)) vec))
1172       (or (equal math-expr-data calc-function-close)
1173           (throw 'syntax "Expected `}'"))
1174       (math-read-token))
1175     (or (equal math-expr-data calc-function-close)
1176         (throw 'syntax "Expected `}'"))
1177     (math-read-token)
1178     (math-transpose (cons 'vec (nreverse vec)))))
1179
1180 (defun math-parse-eqn-prime (x sym)
1181   (if (eq (car-safe x) 'var)
1182       (if (equal math-expr-data calc-function-open)
1183           (progn
1184             (math-read-token)
1185             (let ((args (if (or (equal math-expr-data calc-function-close)
1186                                 (eq math-exp-token 'end))
1187                             nil
1188                           (math-read-expr-list))))
1189               (if (not (or (equal math-expr-data calc-function-close)
1190                            (eq math-exp-token 'end)))
1191                   (throw 'syntax "Expected `)'"))
1192               (math-read-token)
1193               (cons (intern (format "calcFunc-%s'" (nth 1 x))) args)))
1194         (list 'var
1195               (intern (concat (symbol-name (nth 1 x)) "'"))
1196               (intern (concat (symbol-name (nth 2 x)) "'"))))
1197     (list 'calcFunc-Prime x)))
1198
1199 (defun math-compose-eqn-intv (a)
1200   (list 'horiz
1201         (if (memq (nth 1 a) '(0 1)) "(" "[")
1202         (math-compose-expr (nth 2 a) 0)
1203         " ... "
1204         (math-compose-expr (nth 3 a) 0)
1205         (if (memq (nth 1 a) '(0 2)) ")" "]")))
1206
1207
1208 ;;; Yacas
1209
1210 (defun calc-yacas-language ()
1211   "Change the Calc language to be Yacas-like."
1212   (interactive)
1213   (calc-wrapper
1214    (calc-set-language 'yacas)
1215    (message "Yacas language mode")))
1216
1217 (put 'yacas 'math-vector-brackets "{}")
1218
1219 (put 'yacas 'math-complex-format 'I)
1220
1221 (add-to-list 'calc-lang-brackets-are-subscripts 'yacas)
1222
1223 (put 'yacas 'math-variable-table
1224      '(( Infinity    . var-inf)
1225        ( Infinity    . var-uinf)
1226        ( Undefined   . var-nan)
1227        ( Pi          . var-pi)
1228        ( E           . var-e) ;; Not really in Yacas
1229        ( GoldenRatio . var-phi)
1230        ( Gamma       . var-gamma)))
1231
1232 (put 'yacas 'math-parse-table
1233      '((("Deriv(" 0 ")" 0)
1234         calcFunc-deriv (var ArgB var-ArgB) (var ArgA var-ArgA))
1235        (("D(" 0 ")" 0)
1236         calcFunc-deriv (var ArgB var-ArgB) (var ArgA var-ArgA))
1237        (("Integrate(" 0 ")" 0)
1238         calcFunc-integ (var ArgB var-ArgB)(var ArgA var-ArgA))
1239        (("Integrate(" 0 "," 0 "," 0 ")" 0)
1240         calcFunc-integ (var ArgD var-ArgD) (var ArgA var-ArgA)
1241         (var ArgB var-ArgB) (var ArgC var-ArgC))
1242        (("Subst(" 0 "," 0 ")" 0)
1243         calcFunc-subst (var ArgC var-ArgC) (var ArgA var-ArgA)
1244         (var ArgB var-ArgB))
1245        (("Taylor(" 0 "," 0 "," 0 ")" 0)
1246         calcFunc-taylor (var ArgD var-ArgD)
1247         (calcFunc-eq (var ArgA var-ArgA) (var ArgB var-ArgB))
1248         (var ArgC var-ArgC))))
1249
1250 (put 'yacas 'math-oper-table
1251      '(("+"    +               30  30)
1252        ("-"    -               30  60)
1253        ("*"    *               60  60)
1254        ("/"    /               70  70)
1255        ("u-"   neg             -1  60)
1256        ("^"    ^               80  80)
1257        ("u+"   ident           -1  30)
1258        ("<<"   calcFunc-lsh    80  80)
1259        (">>"   calcFunc-rsh    80  80)
1260        ("!"    calcFunc-fact   80  -1)
1261        ("!!"   calcFunc-dfact  80  -1)
1262        ("X"    calcFunc-cross  70  70)
1263        ("="    calcFunc-eq     10  10)
1264        ("!="   calcFunc-neq    10  10)
1265        ("<"    calcFunc-lt     10  10)
1266        (">"    calcFunc-gt     10  10)
1267        ("<="   calcFunc-leq    10  10)
1268        (">="   calcFunc-geq    10  10)
1269        ("And"  calcFunc-land    5   5)
1270        ("Or"   calcFunc-or      4   4)
1271        ("Not"  calcFunc-lnot   -1   3)
1272        (":="   calcFunc-assign  1   1)))
1273
1274 (put 'yacas 'math-function-table
1275      '(( Div   .  calcFunc-idiv)
1276        ( Mod   .  calcFunc-mod)
1277        ( Abs   .  calcFunc-abs)
1278        ( Sign  .  calcFunc-sign)
1279        ( Sqrt  .  calcFunc-sqrt)
1280        ( Max   .  calcFunc-max)
1281        ( Min   .  calcFunc-min)
1282        ( Floor .  calcFunc-floor)
1283        ( Ceil  .  calcFunc-ceil)
1284        ( Round .  calcFunc-round)
1285        ( Conjugate . calcFunc-conj)
1286        ( Arg   .  calcFunc-arg)
1287        ( Re    .  calcFunc-re)
1288        ( Im    .  calcFunc-im)
1289        ( Rationalize . calcFunc-pfrac)
1290        ( Sin   .  calcFunc-sin)
1291        ( Cos   .  calcFunc-cos)
1292        ( Tan   .  calcFunc-tan)
1293        ( Sec   .  calcFunc-sec)
1294        ( Csc   .  calcFunc-csc)
1295        ( Cot   .  calcFunc-cot)
1296        ( ArcSin . calcFunc-arcsin)
1297        ( ArcCos . calcFunc-arccos)
1298        ( ArcTan . calcFunc-arctan)
1299        ( Sinh   .  calcFunc-sinh)
1300        ( Cosh   .  calcFunc-cosh)
1301        ( Tanh   .  calcFunc-tanh)
1302        ( Sech   .  calcFunc-sech)
1303        ( Csch   .  calcFunc-csch)
1304        ( Coth   .  calcFunc-coth)
1305        ( ArcSinh . calcFunc-arcsinh)
1306        ( ArcCosh . calcFunc-arccosh)
1307        ( ArcTanh . calcFunc-arctanh)
1308        ( Ln     .  calcFunc-ln)
1309        ( Exp    .  calcFunc-exp)
1310        ( Gamma  .  calcFunc-gamma)
1311        ( Gcd    .  calcFunc-gcd)
1312        ( Lcm    .  calcFunc-lcm)
1313        ( Bin    .  calcFunc-choose)
1314        ( Bernoulli . calcFunc-bern)
1315        ( Euler  .  calcFunc-euler)
1316        ( StirlingNumber1 . calcFunc-stir1)
1317        ( StirlingNumber2 . calcFunc-stir2)
1318        ( IsPrime .  calcFunc-prime)
1319        ( Factors . calcFunc-prfac)
1320        ( NextPrime . calcFunc-nextprime)
1321        ( Moebius . calcFunc-moebius)
1322        ( Random  . calcFunc-random)
1323        ( Concat  . calcFunc-vconcat)
1324        ( Head    . calcFunc-head)
1325        ( Tail    . calcFunc-tail)
1326        ( Length  . calcFunc-vlen)
1327        ( Reverse . calcFunc-rev)
1328        ( CrossProduct . calcFunc-cross)
1329        ( Dot . calcFunc-mul)
1330        ( DiagonalMatrix . calcFunc-diag)
1331        ( Transpose . calcFunc-trn)
1332        ( Inverse . calcFunc-inv)
1333        ( Determinant . calcFunc-det)
1334        ( Trace . calcFunc-tr)
1335        ( RemoveDuplicates . calcFunc-rdup)
1336        ( Union . calcFunc-vunion)
1337        ( Intersection . calcFunc-vint)
1338        ( Difference . calcFunc-vdiff)
1339        ( Apply . calcFunc-apply)
1340        ( Map . calcFunc-map)
1341        ( Simplify . calcFunc-simplify)
1342        ( ExpandBrackets . calcFunc-expand)
1343        ( Solve . calcFunc-solve)
1344        ( Degree . calcFunc-pdeg)
1345        ( If     . calcFunc-if)
1346        ( Contains . (math-lang-switch-args calcFunc-in))
1347        ( Sum . (math-yacas-parse-Sum calcFunc-sum))
1348        ( Factorize . (math-yacas-parse-Sum calcFunc-prod))))
1349
1350 (put 'yacas 'math-special-function-table
1351      '(( calcFunc-sum  . (math-yacas-compose-sum "Sum"))
1352        ( calcFunc-prod . (math-yacas-compose-sum "Factorize"))
1353        ( calcFunc-deriv . (math-yacas-compose-deriv "Deriv"))
1354        ( calcFunc-integ . (math-yacas-compose-deriv "Integrate"))
1355        ( calcFunc-taylor . math-yacas-compose-taylor)
1356        ( calcFunc-in    .  (math-lang-compose-switch-args "Contains"))))
1357
1358 (put 'yacas 'math-compose-subscr
1359      (function
1360       (lambda (a)
1361         (let ((args (cdr (cdr a))))
1362           (list 'horiz
1363                 (math-compose-expr (nth 1 a) 1000)
1364                 "["
1365                 (math-compose-vector args ", " 0)
1366                 "]")))))
1367
1368 (defun math-yacas-parse-Sum (f val)
1369   "Read in the arguments to \"Sum\" in Calc's Yacas mode."
1370   (let ((args (math-read-expr-list)))
1371     (math-read-token)
1372     (list (nth 2 f)
1373           (nth 3 args)
1374           (nth 0 args)
1375           (nth 1 args)
1376           (nth 2 args))))
1377
1378 (defun math-yacas-compose-sum (a fn)
1379   "Compose the \"Sum\" function in Calc's Yacas mode."
1380   (list 'horiz
1381         (nth 1 fn)
1382         "("
1383         (math-compose-expr (nth 2 a) -1)
1384         ","
1385         (math-compose-expr (nth 3 a) -1)
1386         ","
1387         (math-compose-expr (nth 4 a) -1)
1388         ","
1389         (math-compose-expr (nth 1 a) -1)
1390         ")"))
1391
1392 (defun math-yacas-compose-deriv (a fn)
1393   "Compose the \"Deriv\" function in Calc's Yacas mode."
1394   (list 'horiz
1395         (nth 1 fn)
1396         "("
1397         (math-compose-expr (nth 2 a) -1)
1398         (if (not (nth 3 a))
1399             ")"
1400           (concat
1401            ","
1402            (math-compose-expr (nth 3 a) -1)
1403            ","
1404            (math-compose-expr (nth 4 a) -1)
1405            ")"))
1406         " "
1407         (math-compose-expr (nth 1 a) -1)))
1408
1409 (defun math-yacas-compose-taylor (a)
1410   "Compose the \"Taylor\" function in Calc's Yacas mode."
1411   (list 'horiz
1412         "Taylor("
1413         (if (eq (car-safe (nth 2 a)) 'calcFunc-eq)
1414             (concat (math-compose-expr (nth 1 (nth 2 a)) -1)
1415                     ","
1416                     (math-compose-expr (nth 2 (nth 2 a)) -1))
1417           (concat (math-compose-expr (nth 2 a) -1) ",0"))
1418         ","
1419         (math-compose-expr (nth 3 a) -1)
1420         ") "
1421         (math-compose-expr (nth 1 a) -1)))
1422
1423
1424 ;;; Maxima
1425
1426 (defun calc-maxima-language ()
1427   "Change the Calc language to be Maxima-like."
1428   (interactive)
1429   (calc-wrapper
1430    (calc-set-language 'maxima)
1431    (message "Maxima language mode")))
1432
1433 (put 'maxima 'math-oper-table
1434      '(("+"    +               100  100)
1435        ("-"    -               100  134)
1436        ("*"    *               120  120)
1437        ("."    *               130  129)
1438        ("/"    /               120  120)
1439        ("u-"   neg              -1  180)
1440        ("u+"   ident            -1  180)
1441        ("^"    ^               140  139)
1442        ("**"   ^               140  139)
1443        ("!"    calcFunc-fact   160   -1)
1444        ("!!"   calcFunc-dfact  160   -1)
1445        ("="    calcFunc-eq      80   80)
1446        ("#"    calcFunc-neq     80   80)
1447        ("<"    calcFunc-lt      80   80)
1448        (">"    calcFunc-gt      80   80)
1449        ("<="   calcFunc-leq     80   80)
1450        (">="   calcFunc-geq     80   80)
1451        ("and"  calcFunc-land    65   65)
1452        ("or"   calcFunc-or      60   60)
1453        ("not"  calcFunc-lnot    -1   70)
1454        (":"    calcFunc-assign 180   20)))
1455
1456
1457 (put 'maxima 'math-function-table
1458      '(( matrix .  vec)
1459        ( abs    .  calcFunc-abs)
1460        ( cabs   .  calcFunc-abs)
1461        ( signum .  calcFunc-sign)
1462        ( floor  .  calcFunc-floor)
1463        ( entier .  calcFunc-floor)
1464        ( fix    .  calcFunc-floor)
1465        ( conjugate . calcFunc-conj )
1466        ( carg   .  calcFunc-arg)
1467        ( realpart . calcFunc-re)
1468        ( imagpart . calcFunc-im)
1469        ( rationalize . calcFunc-pfrac)
1470        ( asin   .  calcFunc-arcsin)
1471        ( acos   .  calcFunc-arccos)
1472        ( atan   .  calcFunc-arctan)
1473        ( atan2  .  calcFunc-arctan2)
1474        ( asinh  .  calcFunc-arcsinh)
1475        ( acosh  .  calcFunc-arccosh)
1476        ( atanh  .  calcFunc-arctanh)
1477        ( log    .  calcFunc-ln)
1478        ( plog    .  calcFunc-ln)
1479        ( bessel_j . calcFunc-besJ)
1480        ( bessel_y . calcFunc-besY)
1481        ( factorial . calcFunc-fact)
1482        ( binomial . calcFunc-choose)
1483        ( primep  . calcFunc-prime)
1484        ( next_prime . calcFunc-nextprime)
1485        ( prev_prime . calcFunc-prevprime)
1486        ( append  .  calcFunc-vconcat)
1487        ( rest  .  calcFunc-tail)
1488        ( reverse . calcFunc-rev)
1489        ( innerproduct . calcFunc-mul)
1490        ( inprod . calcFunc-mul)
1491        ( row . calcFunc-mrow)
1492        ( columnvector . calcFunc-mcol)
1493        ( covect . calcFunc-mcol)
1494        ( transpose . calcFunc-trn)
1495        ( invert . calcFunc-inv)
1496        ( determinant . calcFunc-det)
1497        ( mattrace . calcFunc-tr)
1498        ( member . calcFunc-in)
1499        ( lmax . calcFunc-vmax)
1500        ( lmin . calcFunc-vmin)
1501        ( distrib . calcFunc-expand)
1502        ( partfrac . calcFunc-apart)
1503        ( rat . calcFunc-nrat)
1504        ( product . calcFunc-prod)
1505        ( diff . calcFunc-deriv)
1506        ( integrate . calcFunc-integ)
1507        ( quotient . calcFunc-pdiv)
1508        ( remainder . calcFunc-prem)
1509        ( divide . calcFunc-pdivrem)
1510        ( equal  . calcFunc-eq)
1511        ( notequal . calcFunc-neq)
1512        ( rhs  . calcFunc-rmeq)
1513        ( subst . (math-maxima-parse-subst))
1514        ( substitute . (math-maxima-parse-subst))
1515        ( taylor . (math-maxima-parse-taylor))))
1516
1517 (defun math-maxima-parse-subst (f val)
1518   "Read in the arguments to \"subst\" in Calc's Maxima mode."
1519   (let ((args (math-read-expr-list)))
1520     (math-read-token)
1521     (list 'calcFunc-subst
1522           (nth 1 args)
1523           (nth 2 args)
1524           (nth 0 args))))
1525
1526 (defun math-maxima-parse-taylor (f val)
1527   "Read in the arguments to \"taylor\" in Calc's Maxima mode."
1528   (let ((args (math-read-expr-list)))
1529     (math-read-token)
1530     (list 'calcFunc-taylor
1531           (nth 0 args)
1532           (list 'calcFunc-eq
1533                 (nth 1 args)
1534                 (nth 2 args))
1535           (nth 3 args))))
1536
1537 (put 'maxima 'math-parse-table
1538      '((("if" 0 "then" 0 "else" 0)
1539         calcFunc-if
1540         (var ArgA var-ArgA)
1541         (var ArgB var-ArgB)
1542         (var ArgC var-ArgC))))
1543
1544 (put 'maxima 'math-special-function-table
1545      '(( calcFunc-taylor . math-maxima-compose-taylor)
1546        ( calcFunc-subst .  math-maxima-compose-subst)
1547        ( calcFunc-if    .  math-maxima-compose-if)))
1548
1549 (defun math-maxima-compose-taylor (a)
1550   "Compose the \"taylor\" function in Calc's Maxima mode."
1551   (list 'horiz
1552         "taylor("
1553         (math-compose-expr (nth 1 a) -1)
1554         ","
1555         (if (eq (car-safe (nth 2 a)) 'calcFunc-eq)
1556             (concat (math-compose-expr (nth 1 (nth 2 a)) -1)
1557                     ","
1558                     (math-compose-expr (nth 2 (nth 2 a)) -1))
1559           (concat (math-compose-expr (nth 2 a) -1) ",0"))
1560         ","
1561         (math-compose-expr (nth 3 a) -1)
1562         ")"))
1563
1564 (defun math-maxima-compose-subst (a)
1565   "Compose the \"subst\" function in Calc's Maxima mode."
1566   (list 'horiz
1567         "substitute("
1568         (math-compose-expr (nth 2 a) -1)
1569         ","
1570         (math-compose-expr (nth 3 a) -1)
1571         ","
1572         (math-compose-expr (nth 1 a) -1)
1573         ")"))
1574
1575 (defun math-maxima-compose-if (a)
1576   "Compose the \"if\" function in Calc's Maxima mode."
1577   (list 'horiz
1578         "if "
1579         (math-compose-expr (nth 1 a) -1)
1580         " then "
1581         (math-compose-expr (nth 2 a) -1)
1582         " else "
1583         (math-compose-expr (nth 3 a) -1)))
1584
1585 (put 'maxima 'math-variable-table
1586      '(( infinity    . var-uinf)
1587        ( %pi         . var-pi)
1588        ( %e          . var-e)
1589        ( %i          . var-i)
1590        ( %phi        . var-phi)
1591        ( %gamma      . var-gamma)))
1592
1593 (put 'maxima 'math-complex-format '%i)
1594
1595 (add-to-list 'calc-lang-allow-underscores 'maxima)
1596
1597 (add-to-list 'calc-lang-allow-percentsigns 'maxima)
1598
1599 (add-to-list 'calc-lang-brackets-are-subscripts 'maxima)
1600
1601 (put 'maxima 'math-compose-subscr
1602      (function
1603       (lambda (a)
1604         (let ((args (cdr (cdr a))))
1605           (list 'horiz
1606                 (math-compose-expr (nth 1 a) 1000)
1607                 "["
1608                 (math-compose-vector args ", " 0)
1609                 "]")))))
1610
1611 (put 'maxima 'math-matrix-formatter
1612      (function
1613       (lambda (a)
1614         (list 'horiz
1615               "matrix("
1616               (math-compose-vector (cdr a)
1617                                    (concat math-comp-comma " ")
1618                                    math-comp-vector-prec)
1619               ")"))))
1620
1621
1622 ;;; Giac
1623
1624 (defun calc-giac-language ()
1625   "Change the Calc language to be Giac-like."
1626   (interactive)
1627   (calc-wrapper
1628    (calc-set-language 'giac)
1629    (message "Giac language mode")))
1630
1631 (put 'giac 'math-oper-table
1632   '( ( "["    (math-read-giac-subscr) 250 -1 )
1633      ( "+"     +             180 181 )
1634      ( "-"     -             180 181 )
1635      ( "/"     /             191 192 )
1636      ( "*"     *             191 192 )
1637      ( "^"     ^             201 200 )
1638      ( "u+"    ident         -1  197 )
1639      ( "u-"    neg           -1  197 )
1640      ( "!"     calcFunc-fact  210 -1 )
1641      ( ".."    (math-read-maple-dots) 165 165 )
1642      ( "\\dots" (math-read-maple-dots) 165 165 )
1643      ( "intersect" calcFunc-vint 191 192 )
1644      ( "union" calcFunc-vunion 180 181 )
1645      ( "minus" calcFunc-vdiff 180 181 )
1646      ( "<"     calcFunc-lt   160 160 )
1647      ( ">"     calcFunc-gt   160 160 )
1648      ( "<="    calcFunc-leq  160 160 )
1649      ( ">="    calcFunc-geq  160 160 )
1650      ( "="     calcFunc-eq   160 160 )
1651      ( "=="    calcFunc-eq   160 160 )
1652      ( "!="    calcFunc-neq  160 160 )
1653      ( "and"   calcFunc-land 110 111 )
1654      ( "or"    calcFunc-lor  100 101 )
1655      ( "&&"    calcFunc-land 110 111 )
1656      ( "||"    calcFunc-lor  100 101 )
1657      ( "not"   calcFunc-lnot -1  121 )
1658      ( ":="    calcFunc-assign 51 50 )))
1659
1660
1661 (put 'giac 'math-function-table
1662      '(( rdiv   .  calcFunc-div)
1663        ( iquo   .  calcFunc-idiv)
1664        ( irem   .  calcFunc-mod)
1665        ( remain .  calcFunc-mod)
1666        ( floor  .  calcFunc-floor)
1667        ( iPart  .  calcFunc-floor)
1668        ( ceil   .  calcFunc-ceil)
1669        ( ceiling .  calcFunc-ceil)
1670        ( re     .  calcFunc-re)
1671        ( real   .  calcFunc-re)
1672        ( im     .  calcFunc-im)
1673        ( imag   .  calcFunc-im)
1674        ( float2rational . calcFunc-pfrac)
1675        ( exact  .  calcFunc-pfrac)
1676        ( evalf  .  calcFunc-pfloat)
1677        ( bitand .  calcFunc-and)
1678        ( bitor  .  calcFunc-or)
1679        ( bitxor .  calcFunc-xor)
1680        ( asin   .  calcFunc-arcsin)
1681        ( acos   .  calcFunc-arccos)
1682        ( atan   .  calcFunc-arctan)
1683        ( asinh  .  calcFunc-arcsinh)
1684        ( acosh  .  calcFunc-arccosh)
1685        ( atanh  .  calcFunc-arctanh)
1686        ( log    .  calcFunc-ln)
1687        ( logb   .  calcFunc-log)
1688        ( factorial . calcFunc-fact)
1689        ( comb   .  calcFunc-choose)
1690        ( binomial . calcFunc-choose)
1691        ( nCr    .  calcFunc-choose)
1692        ( perm   .  calcFunc-perm)
1693        ( nPr    .  calcFunc-perm)
1694        ( bernoulli . calcFunc-bern)
1695        ( is_prime . calcFunc-prime)
1696        ( isprime  . calcFunc-prime)
1697        ( isPrime  . calcFunc-prime)
1698        ( ifactors . calcFunc-prfac)
1699        ( euler    . calcFunc-totient)
1700        ( phi      . calcFunc-totient)
1701        ( rand     . calcFunc-random)
1702        ( concat   . calcFunc-vconcat)
1703        ( augment  . calcFunc-vconcat)
1704        ( mid      . calcFunc-subvec)
1705        ( length   . calcFunc-length)
1706        ( size     . calcFunc-length)
1707        ( nops     . calcFunc-length)
1708        ( SortA    . calcFunc-sort)
1709        ( SortB    . calcFunc-rsort)
1710        ( revlist  . calcFunc-rev)
1711        ( cross    . calcFunc-cross)
1712        ( crossP   . calcFunc-cross)
1713        ( crossproduct . calcFunc-cross)
1714        ( mul      . calcFunc-mul)
1715        ( dot      . calcFunc-mul)
1716        ( dotprod  . calcFunc-mul)
1717        ( dotP     . calcFunc-mul)
1718        ( scalar_product . calcFunc-mul)
1719        ( scalar_Product . calcFunc-mul)
1720        ( row      . calcFunc-mrow)
1721        ( col      . calcFunc-mcol)
1722        ( dim      . calcFunc-mdims)
1723        ( tran     . calcFunc-trn)
1724        ( transpose . calcFunc-trn)
1725        ( lu       . calcFunc-lud)
1726        ( trace    . calcFunc-tr)
1727        ( member   . calcFunc-in)
1728        ( sum      . calcFunc-vsum)
1729        ( add      . calcFunc-vsum)
1730        ( product  . calcFunc-vprod)
1731        ( mean     . calcFunc-vmean)
1732        ( median   . calcFunc-vmedian)
1733        ( stddev   . calcFunc-vsdev)
1734        ( stddevp  . calcFunc-vpsdev)
1735        ( variance . calcFunc-vpvar)
1736        ( map      . calcFunc-map)
1737        ( apply    . calcFunc-map)
1738        ( of       . calcFunc-map)
1739        ( zip      . calcFunc-map)
1740        ( expand   . calcFunc-expand)
1741        ( fdistrib . calcFunc-expand)
1742        ( partfrac . calcFunc-apart)
1743        ( ratnormal . calcFunc-nrat)
1744        ( diff     . calcFunc-deriv)
1745        ( derive   . calcFunc-deriv)
1746        ( integrate . calcFunc-integ)
1747        ( int      . calcFunc-integ)
1748        ( Int      . calcFunc-integ)
1749        ( romberg  . calcFunc-ninteg)
1750        ( nInt     . calcFunc-ninteg)
1751        ( lcoeff   . calcFunc-plead)
1752        ( content  . calcFunc-pcont)
1753        ( primpart . calcFunc-pprim)
1754        ( quo      . calcFunc-pdiv)
1755        ( rem      . calcFunc-prem)
1756        ( quorem   . calcFunc-pdivrem)
1757        ( divide   . calcFunc-pdivrem)
1758        ( equal    . calcFunc-eq)
1759        ( ifte     . calcFunc-if)
1760        ( not      . calcFunc-lnot)
1761        ( rhs      . calcFunc-rmeq)
1762        ( right    . calcFunc-rmeq)
1763        ( prepend  . (math-lang-switch-args calcFunc-cons))
1764        ( contains . (math-lang-switch-args calcFunc-in))
1765        ( has      . (math-lang-switch-args calcFunc-refers))))
1766
1767 (defun math-lang-switch-args (f val)
1768   "Read the arguments to a Calc function in reverse order.
1769 This is used for various language modes which have functions in reverse
1770 order to Calc's."
1771   (let ((args (math-read-expr-list)))
1772     (math-read-token)
1773     (list (nth 2 f)
1774           (nth 1 args)
1775           (nth 0 args))))
1776
1777 (put 'giac 'math-parse-table
1778      '((("set" 0)
1779         calcFunc-rdup
1780         (var ArgA var-ArgA))))
1781
1782 (put 'giac 'math-special-function-table
1783      '((calcFunc-cons . (math-lang-compose-switch-args "prepend"))
1784        (calcFunc-in   . (math-lang-compose-switch-args "contains"))
1785        (calcFunc-refers . (math-lang-compose-switch-args "has"))
1786        (intv . math-compose-maple-intv)))
1787
1788 (defun math-lang-compose-switch-args (a fn)
1789   "Compose the arguments to a Calc function in reverse order.
1790 This is used for various language modes which have functions in reverse
1791 order to Calc's."
1792   (list 'horiz (nth 1 fn)
1793         "("
1794         (math-compose-expr (nth 2 a) 0)
1795         ","
1796         (math-compose-expr (nth 1 a) 0)
1797         ")"))
1798
1799 (put 'giac 'math-variable-table
1800      '(( infinity    . var-inf)
1801        ( infinity    . var-uinf)))
1802
1803 (put 'giac 'math-complex-format 'i)
1804
1805 (add-to-list 'calc-lang-allow-underscores 'giac)
1806
1807 (put 'giac 'math-compose-subscr
1808      (function
1809       (lambda (a)
1810         (list 'horiz
1811               (math-compose-expr (nth 1 a) 1000)
1812               "["
1813               (math-compose-expr
1814                (calc-normalize (list '- (nth 2 a) 1)) 0)
1815               "]"))))
1816
1817 (defun math-read-giac-subscr (x op)
1818   (let ((idx (math-read-expr-level 0)))
1819     (or (equal math-expr-data "]")
1820         (throw 'syntax "Expected `]'"))
1821     (math-read-token)
1822     (list 'calcFunc-subscr x (calc-normalize (list '+ idx 1)))))
1823
1824 (add-to-list 'calc-lang-c-type-hex 'giac)
1825
1826
1827 (defun calc-mathematica-language ()
1828   (interactive)
1829   (calc-wrapper
1830    (calc-set-language 'math)
1831    (message "Mathematica language mode")))
1832
1833 (put 'math 'math-oper-table
1834   '( ( "[["    (math-read-math-subscr) 250 -1 )
1835      ( "!"     calcFunc-fact  210 -1 )
1836      ( "!!"    calcFunc-dfact 210 -1 )
1837      ( "^"     ^             201 200 )
1838      ( "u+"    ident         -1  197 )
1839      ( "u-"    neg           -1  197 )
1840      ( "/"     /             195 196 )
1841      ( "*"     *             190 191 )
1842      ( "2x"    *             190 191 )
1843      ( "+"     +             180 181 )
1844      ( "-"     -             180 181 )
1845      ( "<"     calcFunc-lt   160 161 )
1846      ( ">"     calcFunc-gt   160 161 )
1847      ( "<="    calcFunc-leq  160 161 )
1848      ( ">="    calcFunc-geq  160 161 )
1849      ( "=="    calcFunc-eq   150 151 )
1850      ( "!="    calcFunc-neq  150 151 )
1851      ( "u!"    calcFunc-lnot -1  121 )
1852      ( "&&"    calcFunc-land 110 111 )
1853      ( "||"    calcFunc-lor  100 101 )
1854      ( "!!!"   calcFunc-pnot  -1  85 )
1855      ( "&&&"   calcFunc-pand  80  81 )
1856      ( "|||"   calcFunc-por   75  76 )
1857      ( ":="    calcFunc-assign 51 50 )
1858      ( "="     calcFunc-assign 51 50 )
1859      ( "->"    calcFunc-assign 51 50 )
1860      ( ":>"    calcFunc-assign 51 50 )
1861      ( "::"    calcFunc-condition 45 46 )
1862 ))
1863
1864 (put 'math 'math-function-table
1865   '( ( Abs         . calcFunc-abs )
1866      ( ArcCos      . calcFunc-arccos )
1867      ( ArcCosh     . calcFunc-arccosh )
1868      ( ArcSin      . calcFunc-arcsin )
1869      ( ArcSinh     . calcFunc-arcsinh )
1870      ( ArcTan      . calcFunc-arctan )
1871      ( ArcTanh     . calcFunc-arctanh )
1872      ( Arg         . calcFunc-arg )
1873      ( Binomial    . calcFunc-choose )
1874      ( Ceiling     . calcFunc-ceil )
1875      ( Conjugate   . calcFunc-conj )
1876      ( Cos         . calcFunc-cos )
1877      ( Cosh        . calcFunc-cosh )
1878      ( Cot         . calcFunc-cot )
1879      ( Coth        . calcFunc-coth )
1880      ( Csc         . calcFunc-csc )
1881      ( Csch        . calcFunc-csch )
1882      ( D           . calcFunc-deriv )
1883      ( Dt          . calcFunc-tderiv )
1884      ( Det         . calcFunc-det )
1885      ( Exp         . calcFunc-exp )
1886      ( EulerPhi    . calcFunc-totient )
1887      ( Floor       . calcFunc-floor )
1888      ( Gamma       . calcFunc-gamma )
1889      ( GCD         . calcFunc-gcd )
1890      ( If          . calcFunc-if )
1891      ( Im          . calcFunc-im )
1892      ( Inverse     . calcFunc-inv )
1893      ( Integrate   . calcFunc-integ )
1894      ( Join        . calcFunc-vconcat )
1895      ( LCM         . calcFunc-lcm )
1896      ( Log         . calcFunc-ln )
1897      ( Max         . calcFunc-max )
1898      ( Min         . calcFunc-min )
1899      ( Mod         . calcFunc-mod )
1900      ( MoebiusMu   . calcFunc-moebius )
1901      ( Random      . calcFunc-random )
1902      ( Round       . calcFunc-round )
1903      ( Re          . calcFunc-re )
1904      ( Sec         . calcFunc-sec )
1905      ( Sech        . calcFunc-sech )
1906      ( Sign        . calcFunc-sign )
1907      ( Sin         . calcFunc-sin )
1908      ( Sinh        . calcFunc-sinh )
1909      ( Sqrt        . calcFunc-sqrt )
1910      ( Tan         . calcFunc-tan )
1911      ( Tanh        . calcFunc-tanh )
1912      ( Transpose   . calcFunc-trn )
1913      ( Length      . calcFunc-vlen )
1914 ))
1915
1916 (put 'math 'math-variable-table
1917   '( ( I           . var-i )
1918      ( Pi          . var-pi )
1919      ( E           . var-e )
1920      ( GoldenRatio . var-phi )
1921      ( EulerGamma  . var-gamma )
1922      ( Infinity    . var-inf )
1923      ( ComplexInfinity . var-uinf )
1924      ( Indeterminate . var-nan )
1925 ))
1926
1927 (put 'math 'math-vector-brackets "{}")
1928 (put 'math 'math-complex-format 'I)
1929 (put 'math 'math-function-open "[")
1930 (put 'math 'math-function-close "]")
1931
1932 (put 'math 'math-radix-formatter
1933      (function (lambda (r s) (format "%d^^%s" r s))))
1934
1935 (put 'math 'math-lang-read
1936      '((eq (string-match "\\[\\[\\|->\\|:>" math-exp-str math-exp-pos)
1937            math-exp-pos)
1938        (setq math-exp-token 'punc
1939              math-expr-data (math-match-substring math-exp-str 0)
1940              math-exp-pos (match-end 0))))
1941
1942 (put 'math 'math-compose-subscr
1943      (function
1944       (lambda (a)
1945         (list 'horiz
1946               (math-compose-expr (nth 1 a) 1000)
1947               "[["
1948               (math-compose-expr (nth 2 a) 0)
1949               "]]"))))
1950
1951 (defun math-read-math-subscr (x op)
1952   (let ((idx (math-read-expr-level 0)))
1953     (or (and (equal math-expr-data "]")
1954              (progn
1955                (math-read-token)
1956                (equal math-expr-data "]")))
1957         (throw 'syntax "Expected `]]'"))
1958     (math-read-token)
1959     (list 'calcFunc-subscr x idx)))
1960
1961
1962 (defun calc-maple-language ()
1963   (interactive)
1964   (calc-wrapper
1965    (calc-set-language 'maple)
1966    (message "Maple language mode")))
1967
1968 (put 'maple 'math-oper-table
1969   '( ( "matrix" ident        -1  300 )
1970      ( "MATRIX" ident        -1  300 )
1971      ( "!"     calcFunc-fact  210 -1 )
1972      ( "^"     ^             201 200 )
1973      ( "**"    ^             201 200 )
1974      ( "u+"    ident         -1  197 )
1975      ( "u-"    neg           -1  197 )
1976      ( "/"     /             191 192 )
1977      ( "*"     *             191 192 )
1978      ( "intersect" calcFunc-vint 191 192 )
1979      ( "+"     +             180 181 )
1980      ( "-"     -             180 181 )
1981      ( "union" calcFunc-vunion 180 181 )
1982      ( "minus" calcFunc-vdiff 180 181 )
1983      ( "mod"   %             170 170 )
1984      ( ".."    (math-read-maple-dots) 165 165 )
1985      ( "\\dots" (math-read-maple-dots) 165 165 )
1986      ( "<"     calcFunc-lt   160 160 )
1987      ( ">"     calcFunc-gt   160 160 )
1988      ( "<="    calcFunc-leq  160 160 )
1989      ( ">="    calcFunc-geq  160 160 )
1990      ( "="     calcFunc-eq   160 160 )
1991      ( "<>"    calcFunc-neq  160 160 )
1992      ( "not"   calcFunc-lnot -1  121 )
1993      ( "and"   calcFunc-land 110 111 )
1994      ( "or"    calcFunc-lor  100 101 )
1995      ( "!!!"   calcFunc-pnot  -1  85 )
1996      ( "&&&"   calcFunc-pand  80  81 )
1997      ( "|||"   calcFunc-por   75  76 )
1998      ( ":="    calcFunc-assign 51 50 )
1999      ( "::"    calcFunc-condition 45 46 )
2000 ))
2001
2002 (put 'maple 'math-function-table
2003   '( ( bernoulli   . calcFunc-bern )
2004      ( binomial    . calcFunc-choose )
2005      ( diff        . calcFunc-deriv )
2006      ( GAMMA       . calcFunc-gamma )
2007      ( ifactor     . calcFunc-prfac )
2008      ( igcd        . calcFunc-gcd )
2009      ( ilcm        . calcFunc-lcm )
2010      ( int         . calcFunc-integ )
2011      ( modp        . % )
2012      ( irem        . % )
2013      ( iquo        . calcFunc-idiv )
2014      ( isprime     . calcFunc-prime )
2015      ( length      . calcFunc-vlen )
2016      ( member      . calcFunc-in )
2017      ( crossprod   . calcFunc-cross )
2018      ( inverse     . calcFunc-inv )
2019      ( trace       . calcFunc-tr )
2020      ( transpose   . calcFunc-trn )
2021      ( vectdim     . calcFunc-vlen )
2022 ))
2023
2024 (put 'maple 'math-special-function-table
2025      '((intv . math-compose-maple-intv)))
2026
2027 (put 'maple 'math-variable-table
2028   '( ( I           . var-i )
2029      ( Pi          . var-pi )
2030      ( E           . var-e )
2031      ( infinity    . var-inf )
2032      ( infinity    . var-uinf )
2033      ( infinity    . var-nan )
2034 ))
2035
2036 (put 'maple 'math-complex-format 'I)
2037
2038 (put 'maple 'math-matrix-formatter
2039      (function
2040       (lambda (a)
2041         (list 'horiz
2042               "matrix("
2043               math-comp-left-bracket
2044               (math-compose-vector (cdr a)
2045                                    (concat math-comp-comma " ")
2046                                    math-comp-vector-prec)
2047               math-comp-right-bracket
2048               ")"))))
2049
2050 (put 'maple 'math-compose-subscr
2051      (function
2052       (lambda (a)
2053         (let ((args (cdr (cdr a))))
2054           (list 'horiz
2055                 (math-compose-expr (nth 1 a) 1000)
2056                 "["
2057                 (math-compose-vector args ", " 0)
2058                 "]")))))
2059
2060 (add-to-list 'calc-lang-allow-underscores 'maple)
2061 (add-to-list 'calc-lang-brackets-are-subscripts 'maple)
2062
2063 (defun math-compose-maple-intv (a)
2064   (list 'horiz
2065         (math-compose-expr (nth 2 a) 0)
2066         " .. "
2067         (math-compose-expr (nth 3 a) 0)))
2068
2069 (defun math-read-maple-dots (x op)
2070   (list 'intv 3 x (math-read-expr-level (nth 3 op))))
2071
2072
2073 ;; The variable math-read-big-lines is local to math-read-big-expr in
2074 ;; calc-ext.el, but is used by math-read-big-rec, math-read-big-char,
2075 ;; math-read-big-emptyp, math-read-big-error and math-read-big-balance,
2076 ;; which are called (directly and indirectly) by math-read-big-expr.
2077 ;; It is also local to math-read-big-bigp in calc-ext.el, which calls
2078 ;; math-read-big-balance.
2079 (defvar math-read-big-lines)
2080
2081 ;; The variables math-read-big-baseline and math-read-big-h2 are
2082 ;; local to math-read-big-expr in calc-ext.el, but used by
2083 ;; math-read-big-rec.
2084 (defvar math-read-big-baseline)
2085 (defvar math-read-big-h2)
2086
2087 ;; The variables math-rb-h1, math-rb-h2, math-rb-v1 and math-rb-v2
2088 ;; are local to math-read-big-rec, but are used by math-read-big-char,
2089 ;; math-read-big-emptyp and math-read-big-balance which are called by
2090 ;; math-read-big-rec.
2091 ;; math-rb-h2 is also local to math-read-big-bigp in calc-ext.el,
2092 ;; which calls math-read-big-balance.
2093 (defvar math-rb-h1)
2094 (defvar math-rb-h2)
2095 (defvar math-rb-v1)
2096 (defvar math-rb-v2)
2097
2098 (defun math-read-big-rec (math-rb-h1 math-rb-v1 math-rb-h2 math-rb-v2
2099                                      &optional baseline prec short)
2100   (or prec (setq prec 0))
2101
2102   ;; Clip whitespace above or below.
2103   (while (and (< math-rb-v1 math-rb-v2)
2104               (math-read-big-emptyp math-rb-h1 math-rb-v1 math-rb-h2 (1+ math-rb-v1)))
2105     (setq math-rb-v1 (1+ math-rb-v1)))
2106   (while (and (< math-rb-v1 math-rb-v2)
2107               (math-read-big-emptyp math-rb-h1 (1- math-rb-v2) math-rb-h2 math-rb-v2))
2108     (setq math-rb-v2 (1- math-rb-v2)))
2109
2110   ;; If formula is a single line high, normal parser can handle it.
2111   (if (<= math-rb-v2 (1+ math-rb-v1))
2112       (if (or (<= math-rb-v2 math-rb-v1)
2113               (> math-rb-h1 (length (setq math-rb-v2
2114                                           (nth math-rb-v1 math-read-big-lines)))))
2115           (math-read-big-error math-rb-h1 math-rb-v1)
2116         (setq math-read-big-baseline math-rb-v1
2117               math-read-big-h2 math-rb-h2
2118               math-rb-v2 (nth math-rb-v1 math-read-big-lines)
2119               math-rb-h2 (math-read-expr
2120                           (substring math-rb-v2 math-rb-h1
2121                                      (min math-rb-h2 (length math-rb-v2)))))
2122         (if (eq (car-safe math-rb-h2) 'error)
2123             (math-read-big-error (+ math-rb-h1 (nth 1 math-rb-h2))
2124                                  math-rb-v1 (nth 2 math-rb-h2))
2125           math-rb-h2))
2126
2127     ;; Clip whitespace at left or right.
2128     (while (and (< math-rb-h1 math-rb-h2)
2129                 (math-read-big-emptyp math-rb-h1 math-rb-v1 (1+ math-rb-h1) math-rb-v2))
2130       (setq math-rb-h1 (1+ math-rb-h1)))
2131     (while (and (< math-rb-h1 math-rb-h2)
2132                 (math-read-big-emptyp (1- math-rb-h2) math-rb-v1 math-rb-h2 math-rb-v2))
2133       (setq math-rb-h2 (1- math-rb-h2)))
2134
2135     ;; Scan to find widest left-justified "----" in the region.
2136     (let* ((widest nil)
2137            (widest-h2 0)
2138            (lines-v1 (nthcdr math-rb-v1 math-read-big-lines))
2139            (p lines-v1)
2140            (v math-rb-v1)
2141            (other-v nil)
2142            other-char line len h)
2143       (while (< v math-rb-v2)
2144         (setq line (car p)
2145               len (min math-rb-h2 (length line)))
2146         (and (< math-rb-h1 len)
2147              (/= (aref line math-rb-h1) ?\ )
2148              (if (and (= (aref line math-rb-h1) ?\-)
2149                       ;; Make sure it's not a minus sign.
2150                       (or (and (< (1+ math-rb-h1) len)
2151                                (= (aref line (1+ math-rb-h1)) ?\-))
2152                           (/= (math-read-big-char math-rb-h1 (1- v)) ?\ )
2153                           (/= (math-read-big-char math-rb-h1 (1+ v)) ?\ )))
2154                  (progn
2155                    (setq h math-rb-h1)
2156                    (while (and (< (setq h (1+ h)) len)
2157                                (= (aref line h) ?\-)))
2158                    (if (> h widest-h2)
2159                        (setq widest v
2160                              widest-h2 h)))
2161                (or other-v (setq other-v v other-char (aref line math-rb-h1)))))
2162         (setq v (1+ v)
2163               p (cdr p)))
2164
2165       (cond ((not (setq v other-v))
2166              (math-read-big-error math-rb-h1 math-rb-v1))   ; Should never happen!
2167
2168             ;; Quotient.
2169             (widest
2170              (setq h widest-h2
2171                    v widest)
2172              (let ((num (math-read-big-rec math-rb-h1 math-rb-v1 h v))
2173                    (den (math-read-big-rec math-rb-h1 (1+ v) h math-rb-v2)))
2174                (setq p (if (and (math-integerp num) (math-integerp den))
2175                            (math-make-frac num den)
2176                          (list '/ num den)))))
2177
2178             ;; Big radical sign.
2179             ((= other-char ?\\)
2180              (or (= (math-read-big-char (1+ math-rb-h1) v) ?\|)
2181                  (math-read-big-error (1+ math-rb-h1) v "Malformed root sign"))
2182              (math-read-big-emptyp math-rb-h1 math-rb-v1 (1+ math-rb-h1) v nil t)
2183              (while (= (math-read-big-char (1+ math-rb-h1) (setq v (1- v))) ?\|))
2184              (or (= (math-read-big-char (setq h (+ math-rb-h1 2)) v) ?\_)
2185                  (math-read-big-error h v "Malformed root sign"))
2186              (while (= (math-read-big-char (setq h (1+ h)) v) ?\_))
2187              (math-read-big-emptyp math-rb-h1 math-rb-v1 (1+ math-rb-h1) v nil t)
2188              (math-read-big-emptyp math-rb-h1 (1+ other-v) h math-rb-v2 nil t)
2189              (setq p (list 'calcFunc-sqrt (math-read-big-rec
2190                                            (+ math-rb-h1 2) (1+ v)
2191                                            h (1+ other-v) baseline))
2192                    v math-read-big-baseline))
2193
2194             ;; Small radical sign.
2195             ((and (= other-char ?V)
2196                   (= (math-read-big-char (1+ math-rb-h1) (1- v)) ?\_))
2197              (setq h (1+ math-rb-h1))
2198              (math-read-big-emptyp math-rb-h1 math-rb-v1 h (1- v) nil t)
2199              (math-read-big-emptyp math-rb-h1 (1+ v) h math-rb-v2 nil t)
2200              (math-read-big-emptyp math-rb-h1 math-rb-v1 (1+ math-rb-h1) v nil t)
2201              (while (= (math-read-big-char (setq h (1+ h)) (1- v)) ?\_))
2202              (setq p (list 'calcFunc-sqrt (math-read-big-rec
2203                                            (1+ math-rb-h1) v h (1+ v) t))
2204                    v math-read-big-baseline))
2205
2206             ;; Binomial coefficient.
2207             ((and (= other-char ?\()
2208                   (= (math-read-big-char (1+ math-rb-h1) v) ?\ )
2209                   (= (string-match "( *)" (nth v math-read-big-lines)
2210                                    math-rb-h1) math-rb-h1))
2211              (setq h (match-end 0))
2212              (math-read-big-emptyp math-rb-h1 math-rb-v1 (1+ math-rb-h1) v nil t)
2213              (math-read-big-emptyp math-rb-h1 (1+ v) (1+ math-rb-h1) math-rb-v2 nil t)
2214              (math-read-big-emptyp (1- h) math-rb-v1 h v nil t)
2215              (math-read-big-emptyp (1- h) (1+ v) h math-rb-v2 nil t)
2216              (setq p (list 'calcFunc-choose
2217                            (math-read-big-rec (1+ math-rb-h1) math-rb-v1 (1- h) v)
2218                            (math-read-big-rec (1+ math-rb-h1) (1+ v)
2219                                               (1- h) math-rb-v2))))
2220
2221             ;; Minus sign.
2222             ((= other-char ?\-)
2223              (setq p (list 'neg (math-read-big-rec (1+ math-rb-h1) math-rb-v1
2224                                                    math-rb-h2 math-rb-v2 v 250 t))
2225                    v math-read-big-baseline
2226                    h math-read-big-h2))
2227
2228             ;; Parentheses.
2229             ((= other-char ?\()
2230              (math-read-big-emptyp math-rb-h1 math-rb-v1 (1+ math-rb-h1) v nil t)
2231              (math-read-big-emptyp math-rb-h1 (1+ v) (1+ math-rb-h1) math-rb-v2 nil t)
2232              (setq h (math-read-big-balance (1+ math-rb-h1) v "(" t))
2233              (math-read-big-emptyp (1- h) math-rb-v1 h v nil t)
2234              (math-read-big-emptyp (1- h) (1+ v) h math-rb-v2 nil t)
2235              (let ((sep (math-read-big-char (1- h) v))
2236                    hmid)
2237                (if (= sep ?\.)
2238                    (setq h (1+ h)))
2239                (if (= sep ?\])
2240                    (math-read-big-error (1- h) v "Expected `)'"))
2241                (if (= sep ?\))
2242                    (setq p (math-read-big-rec
2243                             (1+ math-rb-h1) math-rb-v1 (1- h) math-rb-v2 v))
2244                  (setq hmid (math-read-big-balance h v "(")
2245                        p (list p
2246                                (math-read-big-rec h math-rb-v1 (1- hmid) math-rb-v2 v))
2247                        h hmid)
2248                  (cond ((= sep ?\.)
2249                         (setq p (cons 'intv (cons (if (= (math-read-big-char
2250                                                           (1- h) v)
2251                                                          ?\))
2252                                                       0 1)
2253                                                   p))))
2254                        ((= (math-read-big-char (1- h) v) ?\])
2255                         (math-read-big-error (1- h) v "Expected `)'"))
2256                        ((= sep ?\,)
2257                         (or (and (math-realp (car p)) (math-realp (nth 1 p)))
2258                             (math-read-big-error
2259                              math-rb-h1 v "Complex components must be real"))
2260                         (setq p (cons 'cplx p)))
2261                        ((= sep ?\;)
2262                         (or (and (math-realp (car p)) (math-anglep (nth 1 p)))
2263                             (math-read-big-error
2264                              math-rb-h1 v "Complex components must be real"))
2265                         (setq p (cons 'polar p)))))))
2266
2267             ;; Matrix.
2268             ((and (= other-char ?\[)
2269                   (or (= (math-read-big-char (setq h math-rb-h1) (1+ v)) ?\[)
2270                       (= (math-read-big-char (setq h (1+ h)) v) ?\[)
2271                       (and (= (math-read-big-char h v) ?\ )
2272                            (= (math-read-big-char (setq h (1+ h)) v) ?\[)))
2273                   (= (math-read-big-char h (1+ v)) ?\[))
2274              (math-read-big-emptyp math-rb-h1 math-rb-v1 h v nil t)
2275              (let ((vtop v)
2276                    (hleft h)
2277                    (hright nil))
2278                (setq p nil)
2279                (while (progn
2280                         (setq h (math-read-big-balance (1+ hleft) v "["))
2281                         (if hright
2282                             (or (= h hright)
2283                                 (math-read-big-error hright v "Expected `]'"))
2284                           (setq hright h))
2285                         (setq p (cons (math-read-big-rec
2286                                        hleft v h (1+ v)) p))
2287                         (and (memq (math-read-big-char h v) '(?\  ?\,))
2288                              (= (math-read-big-char hleft (1+ v)) ?\[)))
2289                  (setq v (1+ v)))
2290                (or (= hleft math-rb-h1)
2291                    (progn
2292                      (if (= (math-read-big-char h v) ?\ )
2293                          (setq h (1+ h)))
2294                      (and (= (math-read-big-char h v) ?\])
2295                           (setq h (1+ h))))
2296                    (math-read-big-error (1- h) v "Expected `]'"))
2297                (if (= (math-read-big-char h vtop) ?\,)
2298                    (setq h (1+ h)))
2299                (math-read-big-emptyp math-rb-h1 (1+ v) (1- h) math-rb-v2 nil t)
2300                (setq v (+ vtop (/ (- v vtop) 2))
2301                      p (cons 'vec (nreverse p)))))
2302
2303             ;; Square brackets.
2304             ((= other-char ?\[)
2305              (math-read-big-emptyp math-rb-h1 math-rb-v1 (1+ math-rb-h1) v nil t)
2306              (math-read-big-emptyp math-rb-h1 (1+ v) (1+ math-rb-h1) math-rb-v2 nil t)
2307              (setq p nil
2308                    h (1+ math-rb-h1))
2309              (while (progn
2310                       (setq widest (math-read-big-balance h v "[" t))
2311                       (math-read-big-emptyp (1- h) math-rb-v1 h v nil t)
2312                       (math-read-big-emptyp (1- h) (1+ v) h math-rb-v2 nil t)
2313                       (setq p (cons (math-read-big-rec
2314                                      h math-rb-v1 (1- widest) math-rb-v2 v) p)
2315                             h widest)
2316                       (= (math-read-big-char (1- h) v) ?\,)))
2317              (setq widest (math-read-big-char (1- h) v))
2318              (if (or (memq widest '(?\; ?\)))
2319                      (and (eq widest ?\.) (cdr p)))
2320                  (math-read-big-error (1- h) v "Expected `]'"))
2321              (if (= widest ?\.)
2322                  (setq h (1+ h)
2323                        widest (math-read-big-balance h v "[")
2324                        p (nconc p (list (math-read-big-rec
2325                                          h math-rb-v1 (1- widest) math-rb-v2 v)))
2326                        h widest
2327                        p (cons 'intv (cons (if (= (math-read-big-char (1- h) v)
2328                                                   ?\])
2329                                                3 2)
2330                                            p)))
2331                (setq p (cons 'vec (nreverse p)))))
2332
2333             ;; Date form.
2334             ((= other-char ?\<)
2335              (setq line (nth v math-read-big-lines))
2336              (string-match ">" line math-rb-h1)
2337              (setq h (match-end 0))
2338              (math-read-big-emptyp math-rb-h1 math-rb-v1 h v nil t)
2339              (math-read-big-emptyp math-rb-h1 (1+ v) h math-rb-v2 nil t)
2340              (setq p (math-read-big-rec math-rb-h1 v h (1+ v) v)))
2341
2342             ;; Variable name or function call.
2343             ((or (and (>= other-char ?a) (<= other-char ?z))
2344                  (and (>= other-char ?A) (<= other-char ?Z))
2345 ;                (and (>= other-char ?α) (<= other-char ?ω))
2346 ;                (and (>= other-char ?Α) (<= other-char ?Ω))
2347 )
2348              (setq line (nth v math-read-big-lines))
2349              (string-match "\\([a-zA-Z'_]+\\) *" line math-rb-h1)
2350 ;            (string-match "\\([a-zA-Zα-ωΑ-Ω'_]+\\) *" line math-rb-h1)
2351              (setq h (match-end 1)
2352                    widest (match-end 0)
2353                    p (math-match-substring line 1))
2354              (math-read-big-emptyp math-rb-h1 math-rb-v1 h v nil t)
2355              (math-read-big-emptyp math-rb-h1 (1+ v) h math-rb-v2 nil t)
2356              (if (= (math-read-big-char widest v) ?\()
2357                  (progn
2358                    (setq line (if (string-match "-" p)
2359                                   (intern p)
2360                                 (intern (concat "calcFunc-" p)))
2361                          h (1+ widest)
2362                          p nil)
2363                    (math-read-big-emptyp widest math-rb-v1 h v nil t)
2364                    (math-read-big-emptyp widest (1+ v) h math-rb-v2 nil t)
2365                    (while (progn
2366                             (setq widest (math-read-big-balance h v "(" t))
2367                             (math-read-big-emptyp (1- h) math-rb-v1 h v nil t)
2368                             (math-read-big-emptyp (1- h) (1+ v) h math-rb-v2 nil t)
2369                             (setq p (cons (math-read-big-rec
2370                                            h math-rb-v1 (1- widest) math-rb-v2 v) p)
2371                                   h widest)
2372                             (= (math-read-big-char (1- h) v) ?\,)))
2373                    (or (= (math-read-big-char (1- h) v) ?\))
2374                        (math-read-big-error (1- h) v "Expected `)'"))
2375                    (setq p (cons line (nreverse p))))
2376                (setq p (list 'var
2377                              (intern (math-remove-dashes p))
2378                              (if (string-match "-" p)
2379                                  (intern p)
2380                                (intern (concat "var-" p)))))))
2381
2382             ;; Number.
2383             (t
2384              (setq line (nth v math-read-big-lines))
2385              (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)
2386                  (math-read-big-error h v "Expected a number"))
2387              (setq h (match-end 0)
2388                    p (math-read-number (math-match-substring line 0)))
2389              (math-read-big-emptyp math-rb-h1 math-rb-v1 h v nil t)
2390              (math-read-big-emptyp math-rb-h1 (1+ v) h math-rb-v2 nil t)))
2391
2392       ;; Now left term is bounded by math-rb-h1, math-rb-v1, h, math-rb-v2;
2393       ;; baseline = v.
2394       (if baseline
2395           (or (= v baseline)
2396               (math-read-big-error math-rb-h1 v "Inconsistent baseline in formula"))
2397         (setq baseline v))
2398
2399       ;; Look for superscripts or subscripts.
2400       (setq line (nth baseline math-read-big-lines)
2401             len (min math-rb-h2 (length line))
2402             widest h)
2403       (while (and (< widest len)
2404                   (= (aref line widest) ?\ ))
2405         (setq widest (1+ widest)))
2406       (and (>= widest len) (setq widest math-rb-h2))
2407       (if (math-read-big-emptyp h v widest math-rb-v2)
2408           (if (math-read-big-emptyp h math-rb-v1 widest v)
2409               (setq h widest)
2410             (setq p (list '^ p (math-read-big-rec h math-rb-v1 widest v))
2411                   h widest))
2412           (if (math-read-big-emptyp h math-rb-v1 widest v)
2413               (setq p (list 'calcFunc-subscr p
2414                             (math-read-big-rec h v widest math-rb-v2))
2415                     h widest)))
2416
2417       ;; Look for an operator name and grab additional terms.
2418       (while
2419           (and (< h len)
2420                (if (setq widest
2421                          (and (math-read-big-emptyp
2422                                h math-rb-v1 (1+ h) v)
2423                               (math-read-big-emptyp
2424                                h (1+ v) (1+ h) math-rb-v2)
2425                               (string-match
2426                                "<=\\|>=\\|\\+/-\\|!=\\|&&\\|||\\|:=\\|=>\\|." line h)
2427                               (assoc (math-match-substring line 0)
2428                                      (math-standard-ops))))
2429                    (and (>= (nth 2 widest) prec)
2430                         (setq h (match-end 0)))
2431                  (and (not (eq (string-match ",\\|;\\|\\.\\.\\|)\\|\\]\\|:" line h)
2432                                h))
2433                          (setq widest '("2x" * 196 195)))))
2434         (cond ((eq (nth 3 widest) -1)
2435                (setq p (list (nth 1 widest) p)))
2436               ((equal (car widest) "?")
2437                (let ((y (math-read-big-rec h math-rb-v1 math-rb-h2
2438                                            math-rb-v2 baseline nil t)))
2439                  (or (= (math-read-big-char math-read-big-h2 baseline) ?\:)
2440                      (math-read-big-error math-read-big-h2 baseline
2441                                           "Expected `:'"))
2442                  (setq p (list (nth 1 widest) p y
2443                                (math-read-big-rec
2444                                 (1+ math-read-big-h2) math-rb-v1 math-rb-h2 math-rb-v2
2445                                 baseline (nth 3 widest) t))
2446                        h math-read-big-h2)))
2447               (t
2448                (setq p (list (nth 1 widest) p
2449                              (math-read-big-rec h math-rb-v1 math-rb-h2 math-rb-v2
2450                                                 baseline (nth 3 widest) t))
2451                      h math-read-big-h2))))
2452
2453       ;; Return all relevant information to caller.
2454       (setq math-read-big-baseline baseline
2455             math-read-big-h2 h)
2456       (or short (= math-read-big-h2 math-rb-h2)
2457           (math-read-big-error h baseline))
2458       p)))
2459
2460 (defun math-read-big-char (h v)
2461   (or (and (>= h math-rb-h1)
2462            (< h math-rb-h2)
2463            (>= v math-rb-v1)
2464            (< v math-rb-v2)
2465            (let ((line (nth v math-read-big-lines)))
2466              (and line
2467                   (< h (length line))
2468                   (aref line h))))
2469       ?\ ))
2470
2471 (defun math-read-big-emptyp (eh1 ev1 eh2 ev2 &optional what error)
2472   (and (< ev1 math-rb-v1) (setq ev1 math-rb-v1))
2473   (and (< eh1 math-rb-h1) (setq eh1 math-rb-h1))
2474   (and (> ev2 math-rb-v2) (setq ev2 math-rb-v2))
2475   (and (> eh2 math-rb-h2) (setq eh2 math-rb-h2))
2476   (or what (setq what ?\ ))
2477   (let ((p (nthcdr ev1 math-read-big-lines))
2478         h)
2479     (while (and (< ev1 ev2)
2480                 (progn
2481                   (setq h (min eh2 (length (car p))))
2482                   (while (and (>= (setq h (1- h)) eh1)
2483                               (= (aref (car p) h) what)))
2484                   (and error (>= h eh1)
2485                        (math-read-big-error h ev1 (if (stringp error)
2486                                                       error
2487                                                     "Whitespace expected")))
2488                   (< h eh1)))
2489       (setq ev1 (1+ ev1)
2490             p (cdr p)))
2491     (>= ev1 ev2)))
2492
2493 ;; math-read-big-err-msg is local to math-read-big-expr in calc-ext.el,
2494 ;; but is used by math-read-big-error which is called (indirectly) by
2495 ;; math-read-big-expr.
2496 (defvar math-read-big-err-msg)
2497
2498 (defun math-read-big-error (h v &optional msg)
2499   (let ((pos 0)
2500         (p math-read-big-lines))
2501     (while (> v 0)
2502       (setq pos (+ pos 1 (length (car p)))
2503             p (cdr p)
2504             v (1- v)))
2505     (setq h (+ pos (min h (length (car p))))
2506           math-read-big-err-msg (list 'error h (or msg "Syntax error")))
2507     (throw 'syntax nil)))
2508
2509 (defun math-read-big-balance (h v what &optional commas)
2510   (let* ((line (nth v math-read-big-lines))
2511          (len (min math-rb-h2 (length line)))
2512          (count 1))
2513     (while (> count 0)
2514       (if (>= h len)
2515           (if what
2516               (math-read-big-error nil v (format
2517                                           "Unmatched `%s'" what))
2518             (setq count 0))
2519         (if (memq (aref line h) '(?\( ?\[))
2520             (setq count (1+ count))
2521           (if (if (and commas (= count 1))
2522                   (or (memq (aref line h) '(?\) ?\] ?\, ?\;))
2523                       (and (eq (aref line h) ?\.)
2524                            (< (1+ h) len)
2525                            (eq (aref line (1+ h)) ?\.)))
2526                 (memq (aref line h) '(?\) ?\])))
2527               (setq count (1- count))))
2528         (setq h (1+ h))))
2529     h))
2530
2531 (provide 'calc-lang)
2532
2533 ;;; calc-lang.el ends here