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