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