lisp/calc/calc-aent.el

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