lisp/calc/calc-lang.el

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