1;;; calc-aent.el --- algebraic entry functions for Calc 2 3;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, 4;; 2005, 2006, 2007 Free Software Foundation, Inc. 5 6;; Author: Dave 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.el. 31 32(require 'calc) 33(require 'calc-macs) 34 35(defvar calc-quick-calc-history nil 36 "The history list for quick-calc.") 37 38(defun calc-do-quick-calc () 39 (require 'calc-ext) 40 (calc-check-defines) 41 (if (eq major-mode 'calc-mode) 42 (calc-algebraic-entry t) 43 (let (buf shortbuf) 44 (save-excursion 45 (calc-create-buffer) 46 (let* ((calc-command-flags nil) 47 (calc-dollar-values calc-quick-prev-results) 48 (calc-dollar-used 0) 49 (enable-recursive-minibuffers t) 50 (calc-language (if (memq calc-language '(nil big)) 51 'flat calc-language)) 52 (entry (calc-do-alg-entry "" "Quick calc: " t 'calc-quick-calc-history)) 53 (alg-exp (mapcar 'math-evaluate-expr entry))) 54 (when (and (= (length alg-exp) 1) 55 (eq (car-safe (car alg-exp)) 'calcFunc-assign) 56 (= (length (car alg-exp)) 3) 57 (eq (car-safe (nth 1 (car alg-exp))) 'var)) 58 (set (nth 2 (nth 1 (car alg-exp))) (nth 2 (car alg-exp))) 59 (calc-refresh-evaltos (nth 2 (nth 1 (car alg-exp)))) 60 (setq alg-exp (list (nth 2 (car alg-exp))))) 61 (setq calc-quick-prev-results alg-exp 62 buf (mapconcat (function (lambda (x) 63 (math-format-value x 1000))) 64 alg-exp 65 " ") 66 shortbuf buf) 67 (if (and (= (length alg-exp) 1) 68 (memq (car-safe (car alg-exp)) '(nil bigpos bigneg)) 69 (< (length buf) 20) 70 (= calc-number-radix 10)) 71 (setq buf (concat buf " (" 72 (let ((calc-number-radix 16)) 73 (math-format-value (car alg-exp) 1000)) 74 ", " 75 (let ((calc-number-radix 8)) 76 (math-format-value (car alg-exp) 1000)) 77 (if (and (integerp (car alg-exp)) 78 (> (car alg-exp) 0) 79 (< (car alg-exp) 127)) 80 (format ", \"%c\"" (car alg-exp)) 81 "") 82 ")"))) 83 (if (and (< (length buf) (frame-width)) (= (length entry) 1) 84 (featurep 'calc-ext)) 85 (let ((long (concat (math-format-value (car entry) 1000) 86 " => " buf))) 87 (if (<= (length long) (- (frame-width) 8)) 88 (setq buf long)))) 89 (calc-handle-whys) 90 (message "Result: %s" buf))) 91 (if (eq last-command-char 10) 92 (insert shortbuf) 93 (kill-new shortbuf))))) 94 95(defun calc-do-calc-eval (str separator args) 96 (calc-check-defines) 97 (catch 'calc-error 98 (save-excursion 99 (calc-create-buffer) 100 (cond 101 ((and (consp str) (not (symbolp (car str)))) 102 (let ((calc-language nil) 103 (math-expr-opers math-standard-opers) 104 (calc-internal-prec 12) 105 (calc-word-size 32) 106 (calc-symbolic-mode nil) 107 (calc-matrix-mode nil) 108 (calc-angle-mode 'deg) 109 (calc-number-radix 10) 110 (calc-leading-zeros nil) 111 (calc-group-digits nil) 112 (calc-point-char ".") 113 (calc-frac-format '(":" nil)) 114 (calc-prefer-frac nil) 115 (calc-hms-format "%s@ %s' %s\"") 116 (calc-date-format '((H ":" mm C SS pp " ") 117 Www " " Mmm " " D ", " YYYY)) 118 (calc-float-format '(float 0)) 119 (calc-full-float-format '(float 0)) 120 (calc-complex-format nil) 121 (calc-matrix-just nil) 122 (calc-full-vectors t) 123 (calc-break-vectors nil) 124 (calc-vector-commas ",") 125 (calc-vector-brackets "[]") 126 (calc-matrix-brackets '(R O)) 127 (calc-complex-mode 'cplx) 128 (calc-infinite-mode nil) 129 (calc-display-strings nil) 130 (calc-simplify-mode nil) 131 (calc-display-working-message 'lots) 132 (strp (cdr str))) 133 (while strp 134 (set (car strp) (nth 1 strp)) 135 (setq strp (cdr (cdr strp)))) 136 (calc-do-calc-eval (car str) separator args))) 137 ((eq separator 'eval) 138 (eval str)) 139 ((eq separator 'macro) 140 (require 'calc-ext) 141 (let* ((calc-buffer (current-buffer)) 142 (calc-window (get-buffer-window calc-buffer)) 143 (save-window (selected-window))) 144 (if calc-window 145 (unwind-protect 146 (progn 147 (select-window calc-window) 148 (calc-execute-kbd-macro str nil (car args))) 149 (and (window-point save-window) 150 (select-window save-window))) 151 (save-window-excursion 152 (select-window (get-largest-window)) 153 (switch-to-buffer calc-buffer) 154 (calc-execute-kbd-macro str nil (car args))))) 155 nil) 156 ((eq separator 'pop) 157 (or (not (integerp str)) 158 (= str 0) 159 (calc-pop (min str (calc-stack-size)))) 160 (calc-stack-size)) 161 ((eq separator 'top) 162 (and (integerp str) 163 (> str 0) 164 (<= str (calc-stack-size)) 165 (math-format-value (calc-top-n str (car args)) 1000))) 166 ((eq separator 'rawtop) 167 (and (integerp str) 168 (> str 0) 169 (<= str (calc-stack-size)) 170 (calc-top-n str (car args)))) 171 (t 172 (let* ((calc-command-flags nil) 173 (calc-next-why nil) 174 (calc-language (if (memq calc-language '(nil big)) 175 'flat calc-language)) 176 (calc-dollar-values (mapcar 177 (function 178 (lambda (x) 179 (if (stringp x) 180 (progn 181 (setq x (math-read-exprs x)) 182 (if (eq (car-safe x) 183 'error) 184 (throw 'calc-error 185 (calc-eval-error 186 (cdr x))) 187 (car x))) 188 x))) 189 args)) 190 (calc-dollar-used 0) 191 (res (if (stringp str) 192 (math-read-exprs str) 193 (list str))) 194 buf) 195 (if (eq (car res) 'error) 196 (calc-eval-error (cdr res)) 197 (setq res (mapcar 'calc-normalize res)) 198 (and (memq 'clear-message calc-command-flags) 199 (message "")) 200 (cond ((eq separator 'pred) 201 (require 'calc-ext) 202 (if (= (length res) 1) 203 (math-is-true (car res)) 204 (calc-eval-error '(0 "Single value expected")))) 205 ((eq separator 'raw) 206 (if (= (length res) 1) 207 (car res) 208 (calc-eval-error '(0 "Single value expected")))) 209 ((eq separator 'list) 210 res) 211 ((memq separator '(num rawnum)) 212 (if (= (length res) 1) 213 (if (math-constp (car res)) 214 (if (eq separator 'num) 215 (math-format-value (car res) 1000) 216 (car res)) 217 (calc-eval-error 218 (list 0 219 (if calc-next-why 220 (calc-explain-why (car calc-next-why)) 221 "Number expected")))) 222 (calc-eval-error '(0 "Single value expected")))) 223 ((eq separator 'push) 224 (calc-push-list res) 225 nil) 226 (t (while res 227 (setq buf (concat buf 228 (and buf (or separator ", ")) 229 (math-format-value (car res) 1000)) 230 res (cdr res))) 231 buf))))))))) 232 233(defvar calc-eval-error nil 234 "Determines how calc handles errors. 235If nil, return a list containing the character position of error. 236STRING means return error message as string rather than list. 237The value t means abort and give an error message.") 238 239(defun calc-eval-error (msg) 240 (if calc-eval-error 241 (if (eq calc-eval-error 'string) 242 (nth 1 msg) 243 (error "%s" (nth 1 msg))) 244 msg)) 245 246 247;;;; Reading an expression in algebraic form. 248 249(defun calc-auto-algebraic-entry (&optional prefix) 250 (interactive "P") 251 (calc-algebraic-entry prefix t)) 252 253(defun calc-algebraic-entry (&optional prefix auto) 254 (interactive "P") 255 (calc-wrapper 256 (let ((calc-language (if prefix nil calc-language)) 257 (math-expr-opers (if prefix math-standard-opers math-expr-opers))) 258 (calc-alg-entry (and auto (char-to-string last-command-char)))))) 259 260(defvar calc-alg-entry-history nil 261 "History for algebraic entry.") 262 263(defun calc-alg-entry (&optional initial prompt) 264 (let* ((sel-mode nil) 265 (calc-dollar-values (mapcar 'calc-get-stack-element 266 (nthcdr calc-stack-top calc-stack))) 267 (calc-dollar-used 0) 268 (calc-plain-entry t) 269 (alg-exp (calc-do-alg-entry initial prompt t 'calc-alg-entry-history))) 270 (if (stringp alg-exp) 271 (progn 272 (require 'calc-ext) 273 (calc-alg-edit alg-exp)) 274 (let* ((calc-simplify-mode (if (eq last-command-char ?\C-j) 275 'none 276 calc-simplify-mode)) 277 (nvals (mapcar 'calc-normalize alg-exp))) 278 (while alg-exp 279 (calc-record (if (featurep 'calc-ext) (car alg-exp) (car nvals)) 280 "alg'") 281 (calc-pop-push-record-list calc-dollar-used 282 (and (not (equal (car alg-exp) 283 (car nvals))) 284 (featurep 'calc-ext) 285 "") 286 (list (car nvals))) 287 (setq alg-exp (cdr alg-exp) 288 nvals (cdr nvals) 289 calc-dollar-used 0))) 290 (calc-handle-whys)))) 291 292(defvar calc-alg-ent-map nil 293 "The keymap used for algebraic entry.") 294 295(defvar calc-alg-ent-esc-map nil 296 "The keymap used for escapes in algebraic entry.") 297 298(defvar calc-alg-exp) 299 300(defun calc-do-alg-entry (&optional initial prompt no-normalize history) 301 (let* ((calc-buffer (current-buffer)) 302 (blink-paren-function 'calcAlg-blink-matching-open) 303 (calc-alg-exp 'error)) 304 (unless calc-alg-ent-map 305 (setq calc-alg-ent-map (copy-keymap minibuffer-local-map)) 306 (define-key calc-alg-ent-map "'" 'calcAlg-previous) 307 (define-key calc-alg-ent-map "`" 'calcAlg-edit) 308 (define-key calc-alg-ent-map "\C-m" 'calcAlg-enter) 309 (define-key calc-alg-ent-map "\C-j" 'calcAlg-enter) 310 (let ((i 33)) 311 (setq calc-alg-ent-esc-map (copy-keymap esc-map)) 312 (while (< i 127) 313 (aset (nth 1 calc-alg-ent-esc-map) i 'calcAlg-escape) 314 (setq i (1+ i))))) 315 (define-key calc-alg-ent-map "\e" nil) 316 (if (eq calc-algebraic-mode 'total) 317 (define-key calc-alg-ent-map "\e" calc-alg-ent-esc-map) 318 (define-key calc-alg-ent-map "\e+" 'calcAlg-plus-minus) 319 (define-key calc-alg-ent-map "\em" 'calcAlg-mod) 320 (define-key calc-alg-ent-map "\e=" 'calcAlg-equals) 321 (define-key calc-alg-ent-map "\e\r" 'calcAlg-equals) 322 (define-key calc-alg-ent-map "\ep" 'previous-history-element) 323 (define-key calc-alg-ent-map "\en" 'next-history-element) 324 (define-key calc-alg-ent-map "\e%" 'self-insert-command)) 325 (setq calc-aborted-prefix nil) 326 (let ((buf (read-from-minibuffer (or prompt "Algebraic: ") 327 (or initial "") 328 calc-alg-ent-map nil history))) 329 (when (eq calc-alg-exp 'error) 330 (when (eq (car-safe (setq calc-alg-exp (math-read-exprs buf))) 'error) 331 (setq calc-alg-exp nil))) 332 (setq calc-aborted-prefix "alg'") 333 (or no-normalize 334 (and calc-alg-exp (setq calc-alg-exp (mapcar 'calc-normalize calc-alg-exp)))) 335 calc-alg-exp))) 336 337(defun calcAlg-plus-minus () 338 (interactive) 339 (if (calc-minibuffer-contains ".* \\'") 340 (insert "+/- ") 341 (insert " +/- "))) 342 343(defun calcAlg-mod () 344 (interactive) 345 (if (not (calc-minibuffer-contains ".* \\'")) 346 (insert " ")) 347 (if (calc-minibuffer-contains ".* mod +\\'") 348 (if calc-previous-modulo 349 (insert (math-format-flat-expr calc-previous-modulo 0)) 350 (beep)) 351 (insert "mod "))) 352 353(defun calcAlg-previous () 354 (interactive) 355 (if (calc-minibuffer-contains "\\'") 356 (previous-history-element 1) 357 (insert "'"))) 358 359(defun calcAlg-equals () 360 (interactive) 361 (unwind-protect 362 (calcAlg-enter) 363 (if (consp calc-alg-exp) 364 (progn (setq prefix-arg (length calc-alg-exp)) 365 (calc-unread-command ?=))))) 366 367(defun calcAlg-escape () 368 (interactive) 369 (calc-unread-command) 370 (save-excursion 371 (calc-select-buffer) 372 (use-local-map calc-mode-map)) 373 (calcAlg-enter)) 374 375(defvar calc-plain-entry nil) 376(defun calcAlg-edit () 377 (interactive) 378 (if (or (not calc-plain-entry) 379 (calc-minibuffer-contains 380 "\\`\\([^\"]*\"[^\"]*\"\\)*[^\"]*\"[^\"]*\\'")) 381 (insert "`") 382 (setq calc-alg-exp (minibuffer-contents)) 383 (exit-minibuffer))) 384 385(defvar calc-buffer) 386 387(defun calcAlg-enter () 388 (interactive) 389 (let* ((str (minibuffer-contents)) 390 (exp (and (> (length str) 0) 391 (save-excursion 392 (set-buffer calc-buffer) 393 (math-read-exprs str))))) 394 (if (eq (car-safe exp) 'error) 395 (progn 396 (goto-char (minibuffer-prompt-end)) 397 (forward-char (nth 1 exp)) 398 (beep) 399 (calc-temp-minibuffer-message 400 (concat " [" (or (nth 2 exp) "Error") "]")) 401 (calc-clear-unread-commands)) 402 (setq calc-alg-exp (if (calc-minibuffer-contains "\\` *\\[ *\\'") 403 '((incomplete vec)) 404 exp)) 405 (exit-minibuffer)))) 406 407(defun calcAlg-blink-matching-open () 408 (let ((rightpt (point)) 409 (leftpt nil) 410 (rightchar (preceding-char)) 411 leftchar 412 rightsyntax 413 leftsyntax) 414 (save-excursion 415 (condition-case () 416 (setq leftpt (scan-sexps rightpt -1) 417 leftchar (char-after leftpt)) 418 (error nil))) 419 (if (and leftpt 420 (or (and (= rightchar ?\)) 421 (= leftchar ?\[)) 422 (and (= rightchar ?\]) 423 (= leftchar ?\())) 424 (save-excursion 425 (goto-char leftpt) 426 (looking-at ".+\\(\\.\\.\\|\\\\dots\\|\\\\ldots\\)"))) 427 (let ((leftsaved (aref (syntax-table) leftchar)) 428 (rightsaved (aref (syntax-table) rightchar))) 429 (unwind-protect 430 (progn 431 (cond ((= leftchar ?\[) 432 (aset (syntax-table) leftchar (cons 4 ?\))) 433 (aset (syntax-table) rightchar (cons 5 ?\[))) 434 (t 435 (aset (syntax-table) leftchar (cons 4 ?\])) 436 (aset (syntax-table) rightchar (cons 5 ?\()))) 437 (blink-matching-open)) 438 (aset (syntax-table) leftchar leftsaved) 439 (aset (syntax-table) rightchar rightsaved))) 440 (blink-matching-open)))) 441 442(defun calc-alg-digit-entry () 443 (calc-alg-entry 444 (cond ((eq last-command-char ?e) 445 (if (> calc-number-radix 14) (format "%d.^" calc-number-radix) "1e")) 446 ((eq last-command-char ?#) (format "%d#" calc-number-radix)) 447 ((eq last-command-char ?_) "-") 448 ((eq last-command-char ?@) "0@ ") 449 (t (char-to-string last-command-char))))) 450 451;; The variable calc-digit-value is initially declared in calc.el, 452;; but can be set by calcDigit-algebraic and calcDigit-edit. 453(defvar calc-digit-value) 454 455(defun calcDigit-algebraic () 456 (interactive) 457 (if (calc-minibuffer-contains ".*[@oh] *[^'m ]+[^'m]*\\'") 458 (calcDigit-key) 459 (setq calc-digit-value (minibuffer-contents)) 460 (exit-minibuffer))) 461 462(defun calcDigit-edit () 463 (interactive) 464 (calc-unread-command) 465 (setq calc-digit-value (minibuffer-contents)) 466 (exit-minibuffer)) 467 468 469;;; Algebraic expression parsing. [Public] 470 471(defvar math-read-replacement-list 472 '(;; Misc symbols 473 ("±" "+/-") ; plus or minus 474 ("×" "*") ; multiplication sign 475 ("÷" ":") ; division sign 476 ("−" "-") ; subtraction sign 477 ("∕" "/") ; division sign 478 ("∗" "*") ; asterisk multiplication 479 ("∞" "inf") ; infinity symbol 480 ("≤" "<=") 481 ("≥" ">=") 482 ("≦" "<=") 483 ("≧" ">=") 484 ;; fractions 485 ("¼" "(1:4)") ; 1/4 486 ("½" "(1:2)") ; 1/2 487 ("¾" "(3:4)") ; 3/4 488 ("⅓" "(1:3)") ; 1/3 489 ("⅔" "(2:3)") ; 2/3 490 ("⅕" "(1:5)") ; 1/5 491 ("⅖" "(2:5)") ; 2/5 492 ("⅗" "(3:5)") ; 3/5 493 ("⅘" "(4:5)") ; 4/5 494 ("⅙" "(1:6)") ; 1/6 495 ("⅚" "(5:6)") ; 5/6 496 ("⅛" "(1:8)") ; 1/8 497 ("⅜" "(3:8)") ; 3/8 498 ("⅝" "(5:8)") ; 5/8 499 ("⅞" "(7:8)") ; 7/8 500 ("⅟" "1:") ; 1/... 501 ;; superscripts 502 ("⁰" "0") ; 0 503 ("¹" "1") ; 1 504 ("²" "2") ; 2 505 ("³" "3") ; 3 506 ("⁴" "4") ; 4 507 ("⁵" "5") ; 5 508 ("⁶" "6") ; 6 509 ("⁷" "7") ; 7 510 ("⁸" "8") ; 8 511 ("⁹" "9") ; 9 512 ("⁺" "+") ; + 513 ("⁻" "-") ; - 514 ("⁽" "(") ; ( 515 ("⁾" ")") ; ) 516 ("ⁿ" "n") ; n 517 ("ⁱ" "i") ; i 518 ;; subscripts 519 ("₀" "0") ; 0 520 ("₁" "1") ; 1 521 ("₂" "2") ; 2 522 ("₃" "3") ; 3 523 ("₄" "4") ; 4 524 ("₅" "5") ; 5 525 ("₆" "6") ; 6 526 ("₇" "7") ; 7 527 ("₈" "8") ; 8 528 ("₉" "9") ; 9 529 ("₊" "+") ; + 530 ("₋" "-") ; - 531 ("₍" "(") ; ( 532 ("₎" ")")) ; ) 533 "A list whose elements (old new) indicate replacements to make 534in Calc algebraic input.") 535 536(defvar math-read-superscripts 537 "⁰¹²³⁴⁵⁶⁷⁸⁹⁺⁻⁽⁾ⁿⁱ" ; 0123456789+-()ni 538 "A string consisting of the superscripts allowed by Calc.") 539 540(defvar math-read-subscripts 541 "₀₁₂₃₄₅₆₇₈₉₊₋₍₎" ; 0123456789+-() 542 "A string consisting of the subscripts allowed by Calc.") 543 544(defun math-read-preprocess-string (str) 545 "Replace some substrings of STR by Calc equivalents." 546 (setq str 547 (replace-regexp-in-string (concat "[" math-read-superscripts "]+") 548 "^(\\&)" str)) 549 (setq str 550 (replace-regexp-in-string (concat "[" math-read-subscripts "]+") 551 "_(\\&)" str)) 552 (let ((rep-list math-read-replacement-list)) 553 (while rep-list 554 (setq str 555 (replace-regexp-in-string (nth 0 (car rep-list)) 556 (nth 1 (car rep-list)) str)) 557 (setq rep-list (cdr rep-list)))) 558 str) 559 560;; The next few variables are local to math-read-exprs (and math-read-expr 561;; in calc-ext.el), but are set in functions they call. 562 563(defvar math-exp-pos) 564(defvar math-exp-str) 565(defvar math-exp-old-pos) 566(defvar math-exp-token) 567(defvar math-exp-keep-spaces) 568(defvar math-expr-data) 569 570(defun math-read-exprs (math-exp-str) 571 (let ((math-exp-pos 0) 572 (math-exp-old-pos 0) 573 (math-exp-keep-spaces nil) 574 math-exp-token math-expr-data) 575 (setq math-exp-str (math-read-preprocess-string math-exp-str)) 576 (if calc-language-input-filter 577 (setq math-exp-str (funcall calc-language-input-filter math-exp-str))) 578 (while (setq math-exp-token (string-match "\\.\\.\\([^.]\\|.[^.]\\)" math-exp-str)) 579 (setq math-exp-str (concat (substring math-exp-str 0 math-exp-token) "\\dots" 580 (substring math-exp-str (+ math-exp-token 2))))) 581 (math-build-parse-table) 582 (math-read-token) 583 (let ((val (catch 'syntax (math-read-expr-list)))) 584 (if (stringp val) 585 (list 'error math-exp-old-pos val) 586 (if (equal math-exp-token 'end) 587 val 588 (list 'error math-exp-old-pos "Syntax error")))))) 589 590(defun math-read-expr-list () 591 (let* ((math-exp-keep-spaces nil) 592 (val (list (math-read-expr-level 0))) 593 (last val)) 594 (while (equal math-expr-data ",") 595 (math-read-token) 596 (let ((rest (list (math-read-expr-level 0)))) 597 (setcdr last rest) 598 (setq last rest))) 599 val)) 600 601(defvar calc-user-parse-table nil) 602(defvar calc-last-main-parse-table nil) 603(defvar calc-last-lang-parse-table nil) 604(defvar calc-user-tokens nil) 605(defvar calc-user-token-chars nil) 606 607(defvar math-toks nil 608 "Tokens to pass between math-build-parse-table and math-find-user-tokens.") 609 610(defun math-build-parse-table () 611 (let ((mtab (cdr (assq nil calc-user-parse-tables))) 612 (ltab (cdr (assq calc-language calc-user-parse-tables)))) 613 (or (and (eq mtab calc-last-main-parse-table) 614 (eq ltab calc-last-lang-parse-table)) 615 (let ((p (append mtab ltab)) 616 (math-toks nil)) 617 (setq calc-user-parse-table p) 618 (setq calc-user-token-chars nil) 619 (while p 620 (math-find-user-tokens (car (car p))) 621 (setq p (cdr p))) 622 (setq calc-user-tokens (mapconcat 'identity 623 (sort (mapcar 'car math-toks) 624 (function (lambda (x y) 625 (> (length x) 626 (length y))))) 627 "\\|") 628 calc-last-main-parse-table mtab 629 calc-last-lang-parse-table ltab))))) 630 631(defun math-find-user-tokens (p) 632 (while p 633 (cond ((and (stringp (car p)) 634 (or (> (length (car p)) 1) (equal (car p) "$") 635 (equal (car p) "\"")) 636 (string-match "[^a-zA-Z0-9]" (car p))) 637 (let ((s (regexp-quote (car p)))) 638 (if (string-match "\\`[a-zA-Z0-9]" s) 639 (setq s (concat "\\<" s))) 640 (if (string-match "[a-zA-Z0-9]\\'" s) 641 (setq s (concat s "\\>"))) 642 (or (assoc s math-toks) 643 (progn 644 (setq math-toks (cons (list s) math-toks)) 645 (or (memq (aref (car p) 0) calc-user-token-chars) 646 (setq calc-user-token-chars 647 (cons (aref (car p) 0) 648 calc-user-token-chars))))))) 649 ((consp (car p)) 650 (math-find-user-tokens (nth 1 (car p))) 651 (or (eq (car (car p)) '\?) 652 (math-find-user-tokens (nth 2 (car p)))))) 653 (setq p (cdr p)))) 654 655(defun math-read-token () 656 (if (>= math-exp-pos (length math-exp-str)) 657 (setq math-exp-old-pos math-exp-pos 658 math-exp-token 'end 659 math-expr-data "\000") 660 (let ((ch (aref math-exp-str math-exp-pos))) 661 (setq math-exp-old-pos math-exp-pos) 662 (cond ((memq ch '(32 10 9)) 663 (setq math-exp-pos (1+ math-exp-pos)) 664 (if math-exp-keep-spaces 665 (setq math-exp-token 'space 666 math-expr-data " ") 667 (math-read-token))) 668 ((and (memq ch calc-user-token-chars) 669 (let ((case-fold-search nil)) 670 (eq (string-match calc-user-tokens math-exp-str math-exp-pos) 671 math-exp-pos))) 672 (setq math-exp-token 'punc 673 math-expr-data (math-match-substring math-exp-str 0) 674 math-exp-pos (match-end 0))) 675 ((or (and (>= ch ?a) (<= ch ?z)) 676 (and (>= ch ?A) (<= ch ?Z))) 677 (string-match (if (memq calc-language '(c fortran pascal maple)) 678 "[a-zA-Z0-9_#]*" 679 "[a-zA-Z0-9'#]*") 680 math-exp-str math-exp-pos) 681 (setq math-exp-token 'symbol 682 math-exp-pos (match-end 0) 683 math-expr-data (math-restore-dashes 684 (math-match-substring math-exp-str 0))) 685 (if (eq calc-language 'eqn) 686 (let ((code (assoc math-expr-data math-eqn-ignore-words))) 687 (cond ((null code)) 688 ((null (cdr code)) 689 (math-read-token)) 690 ((consp (nth 1 code)) 691 (math-read-token) 692 (if (assoc math-expr-data (cdr code)) 693 (setq math-expr-data (format "%s %s" 694 (car code) math-expr-data)))) 695 ((eq (nth 1 code) 'punc) 696 (setq math-exp-token 'punc 697 math-expr-data (nth 2 code))) 698 (t 699 (math-read-token) 700 (math-read-token)))))) 701 ((or (and (>= ch ?0) (<= ch ?9)) 702 (and (eq ch '?\.) 703 (eq (string-match "\\.[0-9]" math-exp-str math-exp-pos) 704 math-exp-pos)) 705 (and (eq ch '?_) 706 (eq (string-match "_\\.?[0-9]" math-exp-str math-exp-pos) 707 math-exp-pos) 708 (or (eq math-exp-pos 0) 709 (and (memq calc-language '(nil flat big unform 710 tex latex eqn)) 711 (eq (string-match "[^])}\"a-zA-Z0-9'$]_" 712 math-exp-str (1- math-exp-pos)) 713 (1- math-exp-pos)))))) 714 (or (and (eq calc-language 'c) 715 (string-match "0[xX][0-9a-fA-F]+" math-exp-str math-exp-pos)) 716 (string-match "_?\\([0-9]+.?0*@ *\\)?\\([0-9]+.?0*' *\\)?\\(0*\\([2-9]\\|1[0-4]\\)\\(#\\|\\^\\^\\)[0-9a-dA-D.]+[eE][-+_]?[0-9]+\\|0*\\([2-9]\\|[0-2][0-9]\\|3[0-6]\\)\\(#\\|\\^\\^\\)[0-9a-zA-Z:.]+\\|[0-9]+:[0-9:]+\\|[0-9.]+\\([eE][-+_]?[0-9]+\\)?\"?\\)?" 717 math-exp-str math-exp-pos)) 718 (setq math-exp-token 'number 719 math-expr-data (math-match-substring math-exp-str 0) 720 math-exp-pos (match-end 0))) 721 ((eq ch ?\$) 722 (if (and (eq calc-language 'pascal) 723 (eq (string-match 724 "\\(\\$[0-9a-fA-F]+\\)\\($\\|[^0-9a-zA-Z]\\)" 725 math-exp-str math-exp-pos) 726 math-exp-pos)) 727 (setq math-exp-token 'number 728 math-expr-data (math-match-substring math-exp-str 1) 729 math-exp-pos (match-end 1)) 730 (if (eq (string-match "\\$\\([1-9][0-9]*\\)" math-exp-str math-exp-pos) 731 math-exp-pos) 732 (setq math-expr-data (- (string-to-number (math-match-substring 733 math-exp-str 1)))) 734 (string-match "\\$+" math-exp-str math-exp-pos) 735 (setq math-expr-data (- (match-end 0) (match-beginning 0)))) 736 (setq math-exp-token 'dollar 737 math-exp-pos (match-end 0)))) 738 ((eq ch ?\#) 739 (if (eq (string-match "#\\([1-9][0-9]*\\)" math-exp-str math-exp-pos) 740 math-exp-pos) 741 (setq math-expr-data (string-to-number 742 (math-match-substring math-exp-str 1)) 743 math-exp-pos (match-end 0)) 744 (setq math-expr-data 1 745 math-exp-pos (1+ math-exp-pos))) 746 (setq math-exp-token 'hash)) 747 ((eq (string-match "~=\\|<=\\|>=\\|<>\\|/=\\|\\+/-\\|\\\\dots\\|\\\\ldots\\|\\*\\*\\|<<\\|>>\\|==\\|!=\\|&&&\\||||\\|!!!\\|&&\\|||\\|!!\\|:=\\|::\\|=>" 748 math-exp-str math-exp-pos) 749 math-exp-pos) 750 (setq math-exp-token 'punc 751 math-expr-data (math-match-substring math-exp-str 0) 752 math-exp-pos (match-end 0))) 753 ((and (eq ch ?\") 754 (string-match "\\(\"\\([^\"\\]\\|\\\\.\\)*\\)\\(\"\\|\\'\\)" 755 math-exp-str math-exp-pos)) 756 (if (eq calc-language 'eqn) 757 (progn 758 (setq math-exp-str (copy-sequence math-exp-str)) 759 (aset math-exp-str (match-beginning 1) ?\{) 760 (if (< (match-end 1) (length math-exp-str)) 761 (aset math-exp-str (match-end 1) ?\})) 762 (math-read-token)) 763 (setq math-exp-token 'string 764 math-expr-data (math-match-substring math-exp-str 1) 765 math-exp-pos (match-end 0)))) 766 ((and (= ch ?\\) (eq calc-language 'tex) 767 (< math-exp-pos (1- (length math-exp-str)))) 768 (or (string-match "\\\\hbox *{\\([a-zA-Z0-9]+\\)}" 769 math-exp-str math-exp-pos) 770 (string-match "\\(\\\\\\([a-zA-Z]+\\|[^a-zA-Z]\\)\\)" 771 math-exp-str math-exp-pos)) 772 (setq math-exp-token 'symbol 773 math-exp-pos (match-end 0) 774 math-expr-data (math-restore-dashes 775 (math-match-substring math-exp-str 1))) 776 (let ((code (assoc math-expr-data math-latex-ignore-words))) 777 (cond ((null code)) 778 ((null (cdr code)) 779 (math-read-token)) 780 ((eq (nth 1 code) 'punc) 781 (setq math-exp-token 'punc 782 math-expr-data (nth 2 code))) 783 ((and (eq (nth 1 code) 'mat) 784 (string-match " *{" math-exp-str math-exp-pos)) 785 (setq math-exp-pos (match-end 0) 786 math-exp-token 'punc 787 math-expr-data "[") 788 (let ((right (string-match "}" math-exp-str math-exp-pos))) 789 (and right 790 (setq math-exp-str (copy-sequence math-exp-str)) 791 (aset math-exp-str right ?\]))))))) 792 ((and (= ch ?\\) (eq calc-language 'latex) 793 (< math-exp-pos (1- (length math-exp-str)))) 794 (or (string-match "\\\\hbox *{\\([a-zA-Z0-9]+\\)}" 795 math-exp-str math-exp-pos) 796 (string-match "\\\\text *{\\([a-zA-Z0-9]+\\)}" 797 math-exp-str math-exp-pos) 798 (string-match "\\(\\\\\\([a-zA-Z]+\\|[^a-zA-Z]\\)\\)" 799 math-exp-str math-exp-pos)) 800 (setq math-exp-token 'symbol 801 math-exp-pos (match-end 0) 802 math-expr-data (math-restore-dashes 803 (math-match-substring math-exp-str 1))) 804 (let ((code (assoc math-expr-data math-tex-ignore-words)) 805 envname) 806 (cond ((null code)) 807 ((null (cdr code)) 808 (math-read-token)) 809 ((eq (nth 1 code) 'punc) 810 (setq math-exp-token 'punc 811 math-expr-data (nth 2 code))) 812 ((and (eq (nth 1 code) 'begenv) 813 (string-match " *{\\([^}]*\\)}" math-exp-str math-exp-pos)) 814 (setq math-exp-pos (match-end 0) 815 envname (match-string 1 math-exp-str) 816 math-exp-token 'punc 817 math-expr-data "[") 818 (cond ((or (string= envname "matrix") 819 (string= envname "bmatrix") 820 (string= envname "smallmatrix") 821 (string= envname "pmatrix")) 822 (if (string-match (concat "\\\\end{" envname "}") 823 math-exp-str math-exp-pos) 824 (setq math-exp-str 825 (replace-match "]" t t math-exp-str)) 826 (error "%s" (concat "No closing \\end{" envname "}")))))) 827 ((and (eq (nth 1 code) 'mat) 828 (string-match " *{" math-exp-str math-exp-pos)) 829 (setq math-exp-pos (match-end 0) 830 math-exp-token 'punc 831 math-expr-data "[") 832 (let ((right (string-match "}" math-exp-str math-exp-pos))) 833 (and right 834 (setq math-exp-str (copy-sequence math-exp-str)) 835 (aset math-exp-str right ?\]))))))) 836 ((and (= ch ?\.) (eq calc-language 'fortran) 837 (eq (string-match "\\.[a-zA-Z][a-zA-Z][a-zA-Z]?\\." 838 math-exp-str math-exp-pos) math-exp-pos)) 839 (setq math-exp-token 'punc 840 math-expr-data (upcase (math-match-substring math-exp-str 0)) 841 math-exp-pos (match-end 0))) 842 ((and (eq calc-language 'math) 843 (eq (string-match "\\[\\[\\|->\\|:>" math-exp-str math-exp-pos) 844 math-exp-pos)) 845 (setq math-exp-token 'punc 846 math-expr-data (math-match-substring math-exp-str 0) 847 math-exp-pos (match-end 0))) 848 ((and (eq calc-language 'eqn) 849 (eq (string-match "->\\|<-\\|+-\\|\\\\dots\\|~\\|\\^" 850 math-exp-str math-exp-pos) 851 math-exp-pos)) 852 (setq math-exp-token 'punc 853 math-expr-data (math-match-substring math-exp-str 0) 854 math-exp-pos (match-end 0)) 855 (and (eq (string-match "\\\\dots\\." math-exp-str math-exp-pos) 856 math-exp-pos) 857 (setq math-exp-pos (match-end 0))) 858 (if (memq (aref math-expr-data 0) '(?~ ?^)) 859 (math-read-token))) 860 ((eq (string-match "%%.*$" math-exp-str math-exp-pos) math-exp-pos) 861 (setq math-exp-pos (match-end 0)) 862 (math-read-token)) 863 (t 864 (if (and (eq ch ?\{) (memq calc-language '(tex latex eqn))) 865 (setq ch ?\()) 866 (if (and (eq ch ?\}) (memq calc-language '(tex latex eqn))) 867 (setq ch ?\))) 868 (if (and (eq ch ?\&) (memq calc-language '(tex latex))) 869 (setq ch ?\,)) 870 (setq math-exp-token 'punc 871 math-expr-data (char-to-string ch) 872 math-exp-pos (1+ math-exp-pos))))))) 873 874(defconst math-alg-inequalities 875 '(calcFunc-lt calcFunc-gt calcFunc-leq calcFunc-geq 876 calcFunc-eq calcFunc-neq)) 877 878(defun math-read-expr-level (exp-prec &optional exp-term) 879 (let* ((x (math-read-factor)) (first t) op op2) 880 (while (and (or (and calc-user-parse-table 881 (setq op (calc-check-user-syntax x exp-prec)) 882 (setq x op 883 op '("2x" ident 999999 -1))) 884 (and (setq op (assoc math-expr-data math-expr-opers)) 885 (/= (nth 2 op) -1) 886 (or (and (setq op2 (assoc 887 math-expr-data 888 (cdr (memq op math-expr-opers)))) 889 (eq (= (nth 3 op) -1) 890 (/= (nth 3 op2) -1)) 891 (eq (= (nth 3 op2) -1) 892 (not (math-factor-after))) 893 (setq op op2)) 894 t)) 895 (and (or (eq (nth 2 op) -1) 896 (memq math-exp-token '(symbol number dollar hash)) 897 (equal math-expr-data "(") 898 (and (equal math-expr-data "[") 899 (not (eq calc-language 'math)) 900 (not (and math-exp-keep-spaces 901 (eq (car-safe x) 'vec))))) 902 (or (not (setq op (assoc math-expr-data math-expr-opers))) 903 (/= (nth 2 op) -1)) 904 (or (not calc-user-parse-table) 905 (not (eq math-exp-token 'symbol)) 906 (let ((p calc-user-parse-table)) 907 (while (and p 908 (or (not (integerp 909 (car (car (car p))))) 910 (not (equal 911 (nth 1 (car (car p))) 912 math-expr-data)))) 913 (setq p (cdr p))) 914 (not p))) 915 (setq op (assoc "2x" math-expr-opers)))) 916 (not (and exp-term (equal math-expr-data exp-term))) 917 (>= (nth 2 op) exp-prec)) 918 (if (not (equal (car op) "2x")) 919 (math-read-token)) 920 (and (memq (nth 1 op) '(sdev mod)) 921 (require 'calc-ext)) 922 (setq x (cond ((consp (nth 1 op)) 923 (funcall (car (nth 1 op)) x op)) 924 ((eq (nth 3 op) -1) 925 (if (eq (nth 1 op) 'ident) 926 x 927 (if (eq (nth 1 op) 'closing) 928 (if (eq (nth 2 op) exp-prec) 929 (progn 930 (setq exp-prec 1000) 931 x) 932 (throw 'syntax "Mismatched delimiters")) 933 (list (nth 1 op) x)))) 934 ((and (not first) 935 (memq (nth 1 op) math-alg-inequalities) 936 (memq (car-safe x) math-alg-inequalities)) 937 (require 'calc-ext) 938 (math-composite-inequalities x op)) 939 (t (list (nth 1 op) 940 x 941 (math-read-expr-level (nth 3 op) exp-term)))) 942 first nil)) 943 x)) 944 945;; calc-arg-values is defined in calc-ext.el, but is used here. 946(defvar calc-arg-values) 947 948(defun calc-check-user-syntax (&optional x prec) 949 (let ((p calc-user-parse-table) 950 (matches nil) 951 match rule) 952 (while (and p 953 (or (not (progn 954 (setq rule (car (car p))) 955 (if x 956 (and (integerp (car rule)) 957 (>= (car rule) prec) 958 (equal math-expr-data 959 (car (setq rule (cdr rule))))) 960 (equal math-expr-data (car rule))))) 961 (let ((save-exp-pos math-exp-pos) 962 (save-exp-old-pos math-exp-old-pos) 963 (save-exp-token math-exp-token) 964 (save-exp-data math-expr-data)) 965 (or (not (listp 966 (setq matches (calc-match-user-syntax rule)))) 967 (let ((args (progn 968 (require 'calc-ext) 969 calc-arg-values)) 970 (conds nil) 971 temp) 972 (if x 973 (setq matches (cons x matches))) 974 (setq match (cdr (car p))) 975 (while (and (eq (car-safe match) 976 'calcFunc-condition) 977 (= (length match) 3)) 978 (setq conds (append (math-flatten-lands 979 (nth 2 match)) 980 conds) 981 match (nth 1 match))) 982 (while (and conds match) 983 (require 'calc-ext) 984 (cond ((eq (car-safe (car conds)) 985 'calcFunc-let) 986 (setq temp (car conds)) 987 (or (= (length temp) 3) 988 (and (= (length temp) 2) 989 (eq (car-safe (nth 1 temp)) 990 'calcFunc-assign) 991 (= (length (nth 1 temp)) 3) 992 (setq temp (nth 1 temp))) 993 (setq match nil)) 994 (setq matches (cons 995 (math-normalize 996 (math-multi-subst 997 (nth 2 temp) 998 args matches)) 999 matches) 1000 args (cons (nth 1 temp) 1001 args))) 1002 ((and (eq (car-safe (car conds)) 1003 'calcFunc-matches) 1004 (= (length (car conds)) 3)) 1005 (setq temp (calcFunc-vmatches 1006 (math-multi-subst 1007 (nth 1 (car conds)) 1008 args matches) 1009 (nth 2 (car conds)))) 1010 (if (eq temp 0) 1011 (setq match nil) 1012 (while (setq temp (cdr temp)) 1013 (setq matches (cons (nth 2 (car temp)) 1014 matches) 1015 args (cons (nth 1 (car temp)) 1016 args))))) 1017 (t 1018 (or (math-is-true (math-simplify 1019 (math-multi-subst 1020 (car conds) 1021 args matches))) 1022 (setq match nil)))) 1023 (setq conds (cdr conds))) 1024 (if match 1025 (not (setq match (math-multi-subst 1026 match args matches))) 1027 (setq math-exp-old-pos save-exp-old-pos 1028 math-exp-token save-exp-token 1029 math-expr-data save-exp-data 1030 math-exp-pos save-exp-pos))))))) 1031 (setq p (cdr p))) 1032 (and p match))) 1033 1034(defun calc-match-user-syntax (p &optional term) 1035 (let ((matches nil) 1036 (save-exp-pos math-exp-pos) 1037 (save-exp-old-pos math-exp-old-pos) 1038 (save-exp-token math-exp-token) 1039 (save-exp-data math-expr-data) 1040 m) 1041 (while (and p 1042 (cond ((stringp (car p)) 1043 (and (equal math-expr-data (car p)) 1044 (progn 1045 (math-read-token) 1046 t))) 1047 ((integerp (car p)) 1048 (and (setq m (catch 'syntax 1049 (math-read-expr-level 1050 (car p) 1051 (if (cdr p) 1052 (if (consp (nth 1 p)) 1053 (car (nth 1 (nth 1 p))) 1054 (nth 1 p)) 1055 term)))) 1056 (not (stringp m)) 1057 (setq matches (nconc matches (list m))))) 1058 ((eq (car (car p)) '\?) 1059 (setq m (calc-match-user-syntax (nth 1 (car p)))) 1060 (or (nth 2 (car p)) 1061 (setq matches 1062 (nconc matches 1063 (list 1064 (cons 'vec (and (listp m) m)))))) 1065 (or (listp m) (not (nth 2 (car p))) 1066 (not (eq (aref (car (nth 2 (car p))) 0) ?\$)) 1067 (eq math-exp-token 'end))) 1068 (t 1069 (setq m (calc-match-user-syntax (nth 1 (car p)) 1070 (car (nth 2 (car p))))) 1071 (if (listp m) 1072 (let ((vec (cons 'vec m)) 1073 opos mm) 1074 (while (and (listp 1075 (setq opos math-exp-pos 1076 mm (calc-match-user-syntax 1077 (or (nth 2 (car p)) 1078 (nth 1 (car p))) 1079 (car (nth 2 (car p)))))) 1080 (> math-exp-pos opos)) 1081 (setq vec (nconc vec mm))) 1082 (setq matches (nconc matches (list vec)))) 1083 (and (eq (car (car p)) '*) 1084 (setq matches (nconc matches (list '(vec))))))))) 1085 (setq p (cdr p))) 1086 (if p 1087 (setq math-exp-pos save-exp-pos 1088 math-exp-old-pos save-exp-old-pos 1089 math-exp-token save-exp-token 1090 math-expr-data save-exp-data 1091 matches "Failed")) 1092 matches)) 1093 1094(defun math-remove-dashes (x) 1095 (if (string-match "\\`\\(.*\\)-\\(.*\\)\\'" x) 1096 (math-remove-dashes 1097 (concat (math-match-substring x 1) "#" (math-match-substring x 2))) 1098 x)) 1099 1100(defun math-restore-dashes (x) 1101 (if (string-match "\\`\\(.*\\)[#_]\\(.*\\)\\'" x) 1102 (math-restore-dashes 1103 (concat (math-match-substring x 1) "-" (math-match-substring x 2))) 1104 x)) 1105 1106(defun math-read-if (cond op) 1107 (let ((then (math-read-expr-level 0))) 1108 (or (equal math-expr-data ":") 1109 (throw 'syntax "Expected ':'")) 1110 (math-read-token) 1111 (list 'calcFunc-if cond then (math-read-expr-level (nth 3 op))))) 1112 1113(defun math-factor-after () 1114 (let ((math-exp-pos math-exp-pos) 1115 math-exp-old-pos math-exp-token math-expr-data) 1116 (math-read-token) 1117 (or (memq math-exp-token '(number symbol dollar hash string)) 1118 (and (assoc math-expr-data '(("-") ("+") ("!") ("|") ("/"))) 1119 (assoc (concat "u" math-expr-data) math-expr-opers)) 1120 (eq (nth 2 (assoc math-expr-data math-expr-opers)) -1) 1121 (assoc math-expr-data '(("(") ("[") ("{")))))) 1122 1123(defun math-read-factor () 1124 (let (op) 1125 (cond ((eq math-exp-token 'number) 1126 (let ((num (math-read-number math-expr-data))) 1127 (if (not num) 1128 (progn 1129 (setq math-exp-old-pos math-exp-pos) 1130 (throw 'syntax "Bad format"))) 1131 (math-read-token) 1132 (if (and math-read-expr-quotes 1133 (consp num)) 1134 (list 'quote num) 1135 num))) 1136 ((and calc-user-parse-table 1137 (setq op (calc-check-user-syntax))) 1138 op) 1139 ((or (equal math-expr-data "-") 1140 (equal math-expr-data "+") 1141 (equal math-expr-data "!") 1142 (equal math-expr-data "|") 1143 (equal math-expr-data "/")) 1144 (setq math-expr-data (concat "u" math-expr-data)) 1145 (math-read-factor)) 1146 ((and (setq op (assoc math-expr-data math-expr-opers)) 1147 (eq (nth 2 op) -1)) 1148 (if (consp (nth 1 op)) 1149 (funcall (car (nth 1 op)) op) 1150 (math-read-token) 1151 (let ((val (math-read-expr-level (nth 3 op)))) 1152 (cond ((eq (nth 1 op) 'ident) 1153 val) 1154 ((and (Math-numberp val) 1155 (equal (car op) "u-")) 1156 (math-neg val)) 1157 (t (list (nth 1 op) val)))))) 1158 ((eq math-exp-token 'symbol) 1159 (let ((sym (intern math-expr-data))) 1160 (math-read-token) 1161 (if (equal math-expr-data calc-function-open) 1162 (let ((f (assq sym math-expr-function-mapping))) 1163 (math-read-token) 1164 (if (consp (cdr f)) 1165 (funcall (car (cdr f)) f sym) 1166 (let ((args (if (or (equal math-expr-data calc-function-close) 1167 (eq math-exp-token 'end)) 1168 nil 1169 (math-read-expr-list)))) 1170 (if (not (or (equal math-expr-data calc-function-close) 1171 (eq math-exp-token 'end))) 1172 (throw 'syntax "Expected `)'")) 1173 (math-read-token) 1174 (if (and (eq calc-language 'fortran) args 1175 (require 'calc-ext) 1176 (let ((calc-matrix-mode 'scalar)) 1177 (math-known-matrixp 1178 (list 'var sym 1179 (intern 1180 (concat "var-" 1181 (symbol-name sym))))))) 1182 (math-parse-fortran-subscr sym args) 1183 (if f 1184 (setq sym (cdr f)) 1185 (and (= (aref (symbol-name sym) 0) ?\\) 1186 (< (prefix-numeric-value calc-language-option) 1187 0) 1188 (setq sym (intern (substring (symbol-name sym) 1189 1)))) 1190 (or (string-match "-" (symbol-name sym)) 1191 (setq sym (intern 1192 (concat "calcFunc-" 1193 (symbol-name sym)))))) 1194 (cons sym args))))) 1195 (if math-read-expr-quotes 1196 sym 1197 (let ((val (list 'var 1198 (intern (math-remove-dashes 1199 (symbol-name sym))) 1200 (if (string-match "-" (symbol-name sym)) 1201 sym 1202 (intern (concat "var-" 1203 (symbol-name sym))))))) 1204 (let ((v (assq (nth 1 val) math-expr-variable-mapping))) 1205 (and v (setq val (if (consp (cdr v)) 1206 (funcall (car (cdr v)) v val) 1207 (list 'var 1208 (intern 1209 (substring (symbol-name (cdr v)) 1210 4)) 1211 (cdr v)))))) 1212 (while (and (memq calc-language '(c pascal maple)) 1213 (equal math-expr-data "[")) 1214 (math-read-token) 1215 (setq val (append (list 'calcFunc-subscr val) 1216 (math-read-expr-list))) 1217 (if (equal math-expr-data "]") 1218 (math-read-token) 1219 (throw 'syntax "Expected ']'"))) 1220 val))))) 1221 ((eq math-exp-token 'dollar) 1222 (let ((abs (if (> math-expr-data 0) math-expr-data (- math-expr-data)))) 1223 (if (>= (length calc-dollar-values) abs) 1224 (let ((num math-expr-data)) 1225 (math-read-token) 1226 (setq calc-dollar-used (max calc-dollar-used num)) 1227 (math-check-complete (nth (1- abs) calc-dollar-values))) 1228 (throw 'syntax (if calc-dollar-values 1229 "Too many $'s" 1230 "$'s not allowed in this context"))))) 1231 ((eq math-exp-token 'hash) 1232 (or calc-hashes-used 1233 (throw 'syntax "#'s not allowed in this context")) 1234 (require 'calc-ext) 1235 (if (<= math-expr-data (length calc-arg-values)) 1236 (let ((num math-expr-data)) 1237 (math-read-token) 1238 (setq calc-hashes-used (max calc-hashes-used num)) 1239 (nth (1- num) calc-arg-values)) 1240 (throw 'syntax "Too many # arguments"))) 1241 ((equal math-expr-data "(") 1242 (let* ((exp (let ((math-exp-keep-spaces nil)) 1243 (math-read-token) 1244 (if (or (equal math-expr-data "\\dots") 1245 (equal math-expr-data "\\ldots")) 1246 '(neg (var inf var-inf)) 1247 (math-read-expr-level 0))))) 1248 (let ((math-exp-keep-spaces nil)) 1249 (cond 1250 ((equal math-expr-data ",") 1251 (progn 1252 (math-read-token) 1253 (let ((exp2 (math-read-expr-level 0))) 1254 (setq exp 1255 (if (and exp2 (Math-realp exp) (Math-realp exp2)) 1256 (math-normalize (list 'cplx exp exp2)) 1257 (list '+ exp (list '* exp2 '(var i var-i)))))))) 1258 ((equal math-expr-data ";") 1259 (progn 1260 (math-read-token) 1261 (let ((exp2 (math-read-expr-level 0))) 1262 (setq exp (if (and exp2 (Math-realp exp) 1263 (Math-anglep exp2)) 1264 (math-normalize (list 'polar exp exp2)) 1265 (require 'calc-ext) 1266 (list '* exp 1267 (list 'calcFunc-exp 1268 (list '* 1269 (math-to-radians-2 exp2) 1270 '(var i var-i))))))))) 1271 ((or (equal math-expr-data "\\dots") 1272 (equal math-expr-data "\\ldots")) 1273 (progn 1274 (math-read-token) 1275 (let ((exp2 (if (or (equal math-expr-data ")") 1276 (equal math-expr-data "]") 1277 (eq math-exp-token 'end)) 1278 '(var inf var-inf) 1279 (math-read-expr-level 0)))) 1280 (setq exp 1281 (list 'intv 1282 (if (equal math-expr-data ")") 0 1) 1283 exp 1284 exp2))))))) 1285 (if (not (or (equal math-expr-data ")") 1286 (and (equal math-expr-data "]") (eq (car-safe exp) 'intv)) 1287 (eq math-exp-token 'end))) 1288 (throw 'syntax "Expected `)'")) 1289 (math-read-token) 1290 exp)) 1291 ((eq math-exp-token 'string) 1292 (require 'calc-ext) 1293 (math-read-string)) 1294 ((equal math-expr-data "[") 1295 (require 'calc-ext) 1296 (math-read-brackets t "]")) 1297 ((equal math-expr-data "{") 1298 (require 'calc-ext) 1299 (math-read-brackets nil "}")) 1300 ((equal math-expr-data "<") 1301 (require 'calc-ext) 1302 (math-read-angle-brackets)) 1303 (t (throw 'syntax "Expected a number"))))) 1304 1305(provide 'calc-aent) 1306 1307;;; arch-tag: 5599e45d-e51e-44bb-9a20-9f4ed8c96c32 1308;;; calc-aent.el ends here 1309