cgit.sxemacs.org Git - packages/blob - xemacs-packages/calc/calc-aent.el

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