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