code.delx.au - gnu-emacs/blob - lisp/calc/calc-aent.el

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