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