calc-aent.el 43.1 KB
Newer Older
1 2
;;; calc-aent.el --- algebraic entry functions for Calc

Jay Belanger's avatar
Jay Belanger committed
3
;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004,
Glenn Morris's avatar
Glenn Morris committed
4
;;   2005, 2006, 2007 Free Software Foundation, Inc.
5 6

;; Author: Dave Gillespie <daveg@synaptics.com>
Jay Belanger's avatar
Jay Belanger committed
7
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
Eli Zaretskii's avatar
Eli Zaretskii committed
8 9 10

;; This file is part of GNU Emacs.

11 12 13 14 15
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

Eli Zaretskii's avatar
Eli Zaretskii committed
16
;; GNU Emacs is distributed in the hope that it will be useful,
17 18 19 20 21 22 23 24
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
Eli Zaretskii's avatar
Eli Zaretskii committed
25

26
;;; Commentary:
Eli Zaretskii's avatar
Eli Zaretskii committed
27

28
;;; Code:
Eli Zaretskii's avatar
Eli Zaretskii committed
29 30 31

;; This file is autoloaded from calc.el.

32
(require 'calc)
Eli Zaretskii's avatar
Eli Zaretskii committed
33 34
(require 'calc-macs)

35 36 37
(defvar calc-quick-calc-history nil
  "The history list for quick-calc.")

Eli Zaretskii's avatar
Eli Zaretskii committed
38
(defun calc-do-quick-calc ()
39
  (require 'calc-ext)
Eli Zaretskii's avatar
Eli Zaretskii committed
40 41 42 43 44 45 46 47 48 49 50 51
  (calc-check-defines)
  (if (eq major-mode 'calc-mode)
      (calc-algebraic-entry t)
    (let (buf shortbuf)
      (save-excursion
	(calc-create-buffer)
	(let* ((calc-command-flags nil)
	       (calc-dollar-values calc-quick-prev-results)
	       (calc-dollar-used 0)
	       (enable-recursive-minibuffers t)
	       (calc-language (if (memq calc-language '(nil big))
				  'flat calc-language))
52 53
	       (entry (calc-do-alg-entry "" "Quick calc: " t 'calc-quick-calc-history))
	       (alg-exp (mapcar 'math-evaluate-expr entry)))
54 55 56 57 58 59 60
	  (when (and (= (length alg-exp) 1)
		     (eq (car-safe (car alg-exp)) 'calcFunc-assign)
		     (= (length (car alg-exp)) 3)
		     (eq (car-safe (nth 1 (car alg-exp))) 'var))
	    (set (nth 2 (nth 1 (car alg-exp))) (nth 2 (car alg-exp)))
	    (calc-refresh-evaltos (nth 2 (nth 1 (car alg-exp))))
	    (setq alg-exp (list (nth 2 (car alg-exp)))))
Eli Zaretskii's avatar
Eli Zaretskii committed
61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82
	  (setq calc-quick-prev-results alg-exp
		buf (mapconcat (function (lambda (x)
					   (math-format-value x 1000)))
			       alg-exp
			       " ")
		shortbuf buf)
	  (if (and (= (length alg-exp) 1)
		   (memq (car-safe (car alg-exp)) '(nil bigpos bigneg))
		   (< (length buf) 20)
		   (= calc-number-radix 10))
	      (setq buf (concat buf "  ("
				(let ((calc-number-radix 16))
				  (math-format-value (car alg-exp) 1000))
				", "
				(let ((calc-number-radix 8))
				  (math-format-value (car alg-exp) 1000))
				(if (and (integerp (car alg-exp))
					 (> (car alg-exp) 0)
					 (< (car alg-exp) 127))
				    (format ", \"%c\"" (car alg-exp))
				  "")
				")")))
83
	  (if (and (< (length buf) (frame-width)) (= (length entry) 1)
84
		   (featurep 'calc-ext))
Eli Zaretskii's avatar
Eli Zaretskii committed
85 86
	      (let ((long (concat (math-format-value (car entry) 1000)
				  " =>  " buf)))
87
		(if (<= (length long) (- (frame-width) 8))
Eli Zaretskii's avatar
Eli Zaretskii committed
88 89 90 91 92
		    (setq buf long))))
	  (calc-handle-whys)
	  (message "Result: %s" buf)))
      (if (eq last-command-char 10)
	  (insert shortbuf)
93
        (kill-new shortbuf)))))
Eli Zaretskii's avatar
Eli Zaretskii committed
94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139

(defun calc-do-calc-eval (str separator args)
  (calc-check-defines)
  (catch 'calc-error
    (save-excursion
      (calc-create-buffer)
      (cond
       ((and (consp str) (not (symbolp (car str))))
	(let ((calc-language nil)
	      (math-expr-opers math-standard-opers)
	      (calc-internal-prec 12)
	      (calc-word-size 32)
	      (calc-symbolic-mode nil)
	      (calc-matrix-mode nil)
	      (calc-angle-mode 'deg)
	      (calc-number-radix 10)
	      (calc-leading-zeros nil)
	      (calc-group-digits nil)
	      (calc-point-char ".")
	      (calc-frac-format '(":" nil))
	      (calc-prefer-frac nil)
	      (calc-hms-format "%s@ %s' %s\"")
	      (calc-date-format '((H ":" mm C SS pp " ")
				  Www " " Mmm " " D ", " YYYY))
	      (calc-float-format '(float 0))
	      (calc-full-float-format '(float 0))
	      (calc-complex-format nil)
	      (calc-matrix-just nil)
	      (calc-full-vectors t)
	      (calc-break-vectors nil)
	      (calc-vector-commas ",")
	      (calc-vector-brackets "[]")
	      (calc-matrix-brackets '(R O))
	      (calc-complex-mode 'cplx)
	      (calc-infinite-mode nil)
	      (calc-display-strings nil)
	      (calc-simplify-mode nil)
	      (calc-display-working-message 'lots)
	      (strp (cdr str)))
	  (while strp
	    (set (car strp) (nth 1 strp))
	    (setq strp (cdr (cdr strp))))
	  (calc-do-calc-eval (car str) separator args)))
       ((eq separator 'eval)
	(eval str))
       ((eq separator 'macro)
140
	(require 'calc-ext)
Eli Zaretskii's avatar
Eli Zaretskii committed
141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200
	(let* ((calc-buffer (current-buffer))
	       (calc-window (get-buffer-window calc-buffer))
	       (save-window (selected-window)))
	  (if calc-window
	      (unwind-protect
		  (progn
		    (select-window calc-window)
		    (calc-execute-kbd-macro str nil (car args)))
		(and (window-point save-window)
		     (select-window save-window)))
	    (save-window-excursion
	      (select-window (get-largest-window))
	      (switch-to-buffer calc-buffer)
	      (calc-execute-kbd-macro str nil (car args)))))
	nil)
       ((eq separator 'pop)
	(or (not (integerp str))
	    (= str 0)
	    (calc-pop (min str (calc-stack-size))))
	(calc-stack-size))
       ((eq separator 'top)
	(and (integerp str)
	     (> str 0)
	     (<= str (calc-stack-size))
	     (math-format-value (calc-top-n str (car args)) 1000)))
       ((eq separator 'rawtop)
	(and (integerp str)
	     (> str 0)
	     (<= str (calc-stack-size))
	     (calc-top-n str (car args))))
       (t
	(let* ((calc-command-flags nil)
	       (calc-next-why nil)
	       (calc-language (if (memq calc-language '(nil big))
				  'flat calc-language))
	       (calc-dollar-values (mapcar
				    (function
				     (lambda (x)
				       (if (stringp x)
					   (progn
					     (setq x (math-read-exprs x))
					     (if (eq (car-safe x)
						     'error)
						 (throw 'calc-error
							(calc-eval-error
							 (cdr x)))
					       (car x)))
					 x)))
				    args))
	       (calc-dollar-used 0)
	       (res (if (stringp str)
			(math-read-exprs str)
		      (list str)))
	       buf)
	  (if (eq (car res) 'error)
	      (calc-eval-error (cdr res))
	    (setq res (mapcar 'calc-normalize res))
	    (and (memq 'clear-message calc-command-flags)
		 (message ""))
	    (cond ((eq separator 'pred)
201
		   (require 'calc-ext)
Eli Zaretskii's avatar
Eli Zaretskii committed
202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230
		   (if (= (length res) 1)
		       (math-is-true (car res))
		     (calc-eval-error '(0 "Single value expected"))))
		  ((eq separator 'raw)
		   (if (= (length res) 1)
		       (car res)
		     (calc-eval-error '(0 "Single value expected"))))
		  ((eq separator 'list)
		   res)
		  ((memq separator '(num rawnum))
		   (if (= (length res) 1)
		       (if (math-constp (car res))
			   (if (eq separator 'num)
			       (math-format-value (car res) 1000)
			     (car res))
			 (calc-eval-error
			  (list 0
				(if calc-next-why
				    (calc-explain-why (car calc-next-why))
				  "Number expected"))))
		     (calc-eval-error '(0 "Single value expected"))))
		  ((eq separator 'push)
		   (calc-push-list res)
		   nil)
		  (t (while res
		       (setq buf (concat buf
					 (and buf (or separator ", "))
					 (math-format-value (car res) 1000))
			     res (cdr res)))
231
		     buf)))))))))
Eli Zaretskii's avatar
Eli Zaretskii committed
232

233 234
(defvar calc-eval-error nil
  "Determines how calc handles errors.
235
If nil, return a list containing the character position of error.
236
STRING means return error message as string rather than list.
237
The value t means abort and give an error message.")
238

Eli Zaretskii's avatar
Eli Zaretskii committed
239
(defun calc-eval-error (msg)
240
  (if calc-eval-error
Eli Zaretskii's avatar
Eli Zaretskii committed
241 242 243
      (if (eq calc-eval-error 'string)
	  (nth 1 msg)
	(error "%s" (nth 1 msg)))
244
    msg))
Eli Zaretskii's avatar
Eli Zaretskii committed
245 246 247 248 249 250


;;;; Reading an expression in algebraic form.

(defun calc-auto-algebraic-entry (&optional prefix)
  (interactive "P")
251
  (calc-algebraic-entry prefix t))
Eli Zaretskii's avatar
Eli Zaretskii committed
252 253 254 255 256 257

(defun calc-algebraic-entry (&optional prefix auto)
  (interactive "P")
  (calc-wrapper
   (let ((calc-language (if prefix nil calc-language))
	 (math-expr-opers (if prefix math-standard-opers math-expr-opers)))
258
     (calc-alg-entry (and auto (char-to-string last-command-char))))))
Eli Zaretskii's avatar
Eli Zaretskii committed
259

260 261 262
(defvar calc-alg-entry-history nil
  "History for algebraic entry.")

Eli Zaretskii's avatar
Eli Zaretskii committed
263 264 265 266 267 268
(defun calc-alg-entry (&optional initial prompt)
  (let* ((sel-mode nil)
	 (calc-dollar-values (mapcar 'calc-get-stack-element
				     (nthcdr calc-stack-top calc-stack)))
	 (calc-dollar-used 0)
	 (calc-plain-entry t)
269
	 (alg-exp (calc-do-alg-entry initial prompt t 'calc-alg-entry-history)))
Eli Zaretskii's avatar
Eli Zaretskii committed
270 271
    (if (stringp alg-exp)
	(progn
272
	  (require 'calc-ext)
Eli Zaretskii's avatar
Eli Zaretskii committed
273 274 275 276 277 278
	  (calc-alg-edit alg-exp))
      (let* ((calc-simplify-mode (if (eq last-command-char ?\C-j)
				     'none
				   calc-simplify-mode))
	     (nvals (mapcar 'calc-normalize alg-exp)))
	(while alg-exp
279
	  (calc-record (if (featurep 'calc-ext) (car alg-exp) (car nvals))
Eli Zaretskii's avatar
Eli Zaretskii committed
280 281 282 283
		       "alg'")
	  (calc-pop-push-record-list calc-dollar-used
				     (and (not (equal (car alg-exp)
						      (car nvals)))
284
					  (featurep 'calc-ext)
Eli Zaretskii's avatar
Eli Zaretskii committed
285 286 287 288 289
					  "")
				     (list (car nvals)))
	  (setq alg-exp (cdr alg-exp)
		nvals (cdr nvals)
		calc-dollar-used 0)))
290
      (calc-handle-whys))))
Eli Zaretskii's avatar
Eli Zaretskii committed
291

292 293 294 295 296 297
(defvar calc-alg-ent-map nil
  "The keymap used for algebraic entry.")

(defvar calc-alg-ent-esc-map nil
  "The keymap used for escapes in algebraic entry.")

298 299
(defvar calc-alg-exp)

300
(defun calc-do-alg-entry (&optional initial prompt no-normalize history)
Eli Zaretskii's avatar
Eli Zaretskii committed
301
  (let* ((calc-buffer (current-buffer))
Eli Zaretskii's avatar
Eli Zaretskii committed
302
	 (blink-paren-function 'calcAlg-blink-matching-open)
303
	 (calc-alg-exp 'error))
304
    (unless calc-alg-ent-map
Eli Zaretskii's avatar
Eli Zaretskii committed
305 306 307 308 309
      (setq calc-alg-ent-map (copy-keymap minibuffer-local-map))
      (define-key calc-alg-ent-map "'" 'calcAlg-previous)
      (define-key calc-alg-ent-map "`" 'calcAlg-edit)
      (define-key calc-alg-ent-map "\C-m" 'calcAlg-enter)
      (define-key calc-alg-ent-map "\C-j" 'calcAlg-enter)
310 311 312 313 314 315
      (let ((i 33))
        (setq calc-alg-ent-esc-map (copy-keymap esc-map))
        (while (< i 127)
          (aset (nth 1 calc-alg-ent-esc-map) i 'calcAlg-escape)
          (setq i (1+ i)))))
    (define-key calc-alg-ent-map "\e" nil)
Eli Zaretskii's avatar
Eli Zaretskii committed
316 317
    (if (eq calc-algebraic-mode 'total)
	(define-key calc-alg-ent-map "\e" calc-alg-ent-esc-map)
318
      (define-key calc-alg-ent-map "\e+" 'calcAlg-plus-minus)
Eli Zaretskii's avatar
Eli Zaretskii committed
319 320 321
      (define-key calc-alg-ent-map "\em" 'calcAlg-mod)
      (define-key calc-alg-ent-map "\e=" 'calcAlg-equals)
      (define-key calc-alg-ent-map "\e\r" 'calcAlg-equals)
322 323
      (define-key calc-alg-ent-map "\ep" 'previous-history-element)
      (define-key calc-alg-ent-map "\en" 'next-history-element)
Eli Zaretskii's avatar
Eli Zaretskii committed
324 325 326 327
      (define-key calc-alg-ent-map "\e%" 'self-insert-command))
    (setq calc-aborted-prefix nil)
    (let ((buf (read-from-minibuffer (or prompt "Algebraic: ")
				     (or initial "")
328
				     calc-alg-ent-map nil history)))
329 330 331
      (when (eq calc-alg-exp 'error)
	(when (eq (car-safe (setq calc-alg-exp (math-read-exprs buf))) 'error)
	  (setq calc-alg-exp nil)))
Eli Zaretskii's avatar
Eli Zaretskii committed
332 333
      (setq calc-aborted-prefix "alg'")
      (or no-normalize
334 335
	  (and calc-alg-exp (setq calc-alg-exp (mapcar 'calc-normalize calc-alg-exp))))
      calc-alg-exp)))
Eli Zaretskii's avatar
Eli Zaretskii committed
336 337 338 339 340

(defun calcAlg-plus-minus ()
  (interactive)
  (if (calc-minibuffer-contains ".* \\'")
      (insert "+/- ")
341
    (insert " +/- ")))
Eli Zaretskii's avatar
Eli Zaretskii committed
342 343 344 345 346 347 348 349 350

(defun calcAlg-mod ()
  (interactive)
  (if (not (calc-minibuffer-contains ".* \\'"))
      (insert " "))
  (if (calc-minibuffer-contains ".* mod +\\'")
      (if calc-previous-modulo
	  (insert (math-format-flat-expr calc-previous-modulo 0))
	(beep))
351
    (insert "mod ")))
Eli Zaretskii's avatar
Eli Zaretskii committed
352 353 354

(defun calcAlg-previous ()
  (interactive)
355
  (if (calc-minibuffer-contains "\\'")
356
      (previous-history-element 1)
357
    (insert "'")))
Eli Zaretskii's avatar
Eli Zaretskii committed
358 359 360 361 362

(defun calcAlg-equals ()
  (interactive)
  (unwind-protect
      (calcAlg-enter)
363 364
    (if (consp calc-alg-exp)
	(progn (setq prefix-arg (length calc-alg-exp))
365
	       (calc-unread-command ?=)))))
Eli Zaretskii's avatar
Eli Zaretskii committed
366 367 368 369 370 371 372

(defun calcAlg-escape ()
  (interactive)
  (calc-unread-command)
  (save-excursion
    (calc-select-buffer)
    (use-local-map calc-mode-map))
373
  (calcAlg-enter))
Eli Zaretskii's avatar
Eli Zaretskii committed
374

375
(defvar calc-plain-entry nil)
Eli Zaretskii's avatar
Eli Zaretskii committed
376 377 378 379 380 381
(defun calcAlg-edit ()
  (interactive)
  (if (or (not calc-plain-entry)
	  (calc-minibuffer-contains
	   "\\`\\([^\"]*\"[^\"]*\"\\)*[^\"]*\"[^\"]*\\'"))
      (insert "`")
382
    (setq calc-alg-exp (minibuffer-contents))
383
    (exit-minibuffer)))
Eli Zaretskii's avatar
Eli Zaretskii committed
384

385 386
(defvar calc-buffer)

Eli Zaretskii's avatar
Eli Zaretskii committed
387 388
(defun calcAlg-enter ()
  (interactive)
389
  (let* ((str (minibuffer-contents))
Eli Zaretskii's avatar
Eli Zaretskii committed
390 391 392 393 394 395
	 (exp (and (> (length str) 0)
		   (save-excursion
		     (set-buffer calc-buffer)
		     (math-read-exprs str)))))
    (if (eq (car-safe exp) 'error)
	(progn
396
	  (goto-char (minibuffer-prompt-end))
Eli Zaretskii's avatar
Eli Zaretskii committed
397 398 399 400 401
	  (forward-char (nth 1 exp))
	  (beep)
	  (calc-temp-minibuffer-message
	   (concat " [" (or (nth 2 exp) "Error") "]"))
	  (calc-clear-unread-commands))
402
      (setq calc-alg-exp (if (calc-minibuffer-contains "\\` *\\[ *\\'")
Eli Zaretskii's avatar
Eli Zaretskii committed
403 404
			'((incomplete vec))
		      exp))
405
      (exit-minibuffer))))
Eli Zaretskii's avatar
Eli Zaretskii committed
406 407

(defun calcAlg-blink-matching-open ()
408 409 410 411 412 413
  (let ((rightpt (point))
 	(leftpt nil)
        (rightchar (preceding-char))
        leftchar
        rightsyntax
        leftsyntax)
Eli Zaretskii's avatar
Eli Zaretskii committed
414 415
    (save-excursion
      (condition-case ()
416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439
 	  (setq leftpt (scan-sexps rightpt -1)
                leftchar (char-after leftpt))
  	(error nil)))
    (if (and leftpt
 	     (or (and (= rightchar ?\))
 		      (= leftchar ?\[))
 		 (and (= rightchar ?\])
 		      (= leftchar ?\()))
 	     (save-excursion
 	       (goto-char leftpt)
 	       (looking-at ".+\\(\\.\\.\\|\\\\dots\\|\\\\ldots\\)")))
 	(let ((leftsaved (aref (syntax-table) leftchar))
              (rightsaved (aref (syntax-table) rightchar)))
 	  (unwind-protect
 	      (progn
                (cond ((= leftchar ?\[)
                       (aset (syntax-table) leftchar (cons 4 ?\)))
                       (aset (syntax-table) rightchar (cons 5 ?\[)))
                      (t
                       (aset (syntax-table) leftchar (cons 4 ?\]))
                       (aset (syntax-table) rightchar (cons 5 ?\())))
 		(blink-matching-open))
            (aset (syntax-table) leftchar leftsaved)
            (aset (syntax-table) rightchar rightsaved)))
440
      (blink-matching-open))))
Eli Zaretskii's avatar
Eli Zaretskii committed
441 442

(defun calc-alg-digit-entry ()
443
  (calc-alg-entry
Eli Zaretskii's avatar
Eli Zaretskii committed
444 445 446 447 448
   (cond ((eq last-command-char ?e)
	  (if (> calc-number-radix 14) (format "%d.^" calc-number-radix) "1e"))
	 ((eq last-command-char ?#) (format "%d#" calc-number-radix))
	 ((eq last-command-char ?_) "-")
	 ((eq last-command-char ?@) "0@ ")
449
	 (t (char-to-string last-command-char)))))
Eli Zaretskii's avatar
Eli Zaretskii committed
450

451 452 453 454
;; The variable calc-digit-value is initially declared in calc.el,
;; but can be set by calcDigit-algebraic and calcDigit-edit.
(defvar calc-digit-value)

Eli Zaretskii's avatar
Eli Zaretskii committed
455 456 457 458
(defun calcDigit-algebraic ()
  (interactive)
  (if (calc-minibuffer-contains ".*[@oh] *[^'m ]+[^'m]*\\'")
      (calcDigit-key)
459
    (setq calc-digit-value (minibuffer-contents))
460
    (exit-minibuffer)))
Eli Zaretskii's avatar
Eli Zaretskii committed
461 462 463 464

(defun calcDigit-edit ()
  (interactive)
  (calc-unread-command)
465
  (setq calc-digit-value (minibuffer-contents))
466
  (exit-minibuffer))
Eli Zaretskii's avatar
Eli Zaretskii committed
467 468 469 470


;;; Algebraic expression parsing.   [Public]

471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516
(defvar math-read-replacement-list
  '(;; Misc symbols
    ("±" "+/-")  ; plus or minus
    ("×" "*")    ; multiplication sign
    ("÷" ":")    ; division sign
    ("−" "-")    ; subtraction sign
    ("∕" "/")    ; division sign
    ("∗" "*")    ; asterisk multiplication
    ("∞" "inf")  ; infinity symbol
    ("≤" "<=")
    ("≥" ">=")
    ("≦" "<=")
    ("≧" ">=")
    ;; fractions
    ("¼" "(1:4)") ; 1/4
    ("½" "(1:2)") ; 1/2
    ("¾" "(3:4)") ; 3/4
    ("⅓" "(1:3)") ; 1/3
    ("⅔" "(2:3)") ; 2/3
    ("⅕" "(1:5)") ; 1/5
    ("⅖" "(2:5)") ; 2/5
    ("⅗" "(3:5)") ; 3/5
    ("⅘" "(4:5)") ; 4/5
    ("⅙" "(1:6)") ; 1/6
    ("⅚" "(5:6)") ; 5/6
    ("⅛" "(1:8)") ; 1/8
    ("⅜" "(3:8)") ; 3/8
    ("⅝" "(5:8)") ; 5/8
    ("⅞" "(7:8)") ; 7/8
    ("⅟" "1:")    ; 1/...
    ;; superscripts
    ("⁰" "0")  ; 0
    ("¹" "1")  ; 1
    ("²" "2")  ; 2
    ("³" "3")  ; 3
    ("⁴" "4")  ; 4
    ("⁵" "5")  ; 5
    ("⁶" "6")  ; 6
    ("⁷" "7")  ; 7
    ("⁸" "8")  ; 8
    ("⁹" "9")  ; 9
    ("⁺" "+")  ; +
    ("⁻" "-")  ; -
    ("⁽" "(")  ; (
    ("⁾" ")")  ; )
    ("ⁿ" "n")  ; n
517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532
    ("ⁱ" "i")  ; i
    ;; subscripts
    ("₀"  "0")  ; 0
    ("₁"  "1")  ; 1
    ("₂"  "2")  ; 2
    ("₃"  "3")  ; 3
    ("₄"  "4")  ; 4
    ("₅"  "5")  ; 5
    ("₆"  "6")  ; 6
    ("₇"  "7")  ; 7
    ("₈"  "8")  ; 8
    ("₉"  "9")  ; 9
    ("₊"  "+")  ; +
    ("₋"  "-")  ; -
    ("₍"  "(")  ; (
    ("₎"  ")"))  ; )
533 534 535 536 537 538 539
  "A list whose elements (old new) indicate replacements to make
in Calc algebraic input.")

(defvar math-read-superscripts
  "⁰¹²³⁴⁵⁶⁷⁸⁹⁺⁻⁽⁾ⁿⁱ" ; 0123456789+-()ni
  "A string consisting of the superscripts allowed by Calc.")

540 541 542 543
(defvar math-read-subscripts
  "₀₁₂₃₄₅₆₇₈₉₊₋₍₎" ; 0123456789+-()
  "A string consisting of the subscripts allowed by Calc.")

544 545 546 547 548
(defun math-read-preprocess-string (str)
  "Replace some substrings of STR by Calc equivalents."
  (setq str
        (replace-regexp-in-string (concat "[" math-read-superscripts "]+")
                                  "^(\\&)" str))
549 550 551
  (setq str
        (replace-regexp-in-string (concat "[" math-read-subscripts "]+")
                                  "_(\\&)" str))
552 553 554 555 556 557 558 559
  (let ((rep-list math-read-replacement-list))
    (while rep-list
      (setq str
            (replace-regexp-in-string (nth 0 (car rep-list))
                                      (nth 1 (car rep-list)) str))
      (setq rep-list (cdr rep-list))))
  str)

560 561
;; The next few variables are local to math-read-exprs (and math-read-expr
;; in calc-ext.el), but are set in functions they call.
562 563 564 565 566 567

(defvar math-exp-pos)
(defvar math-exp-str)
(defvar math-exp-old-pos)
(defvar math-exp-token)
(defvar math-exp-keep-spaces)
568
(defvar math-expr-data)
569 570 571 572 573 574

(defun math-read-exprs (math-exp-str)
  (let ((math-exp-pos 0)
	(math-exp-old-pos 0)
	(math-exp-keep-spaces nil)
	math-exp-token math-expr-data)
575
    (setq math-exp-str (math-read-preprocess-string math-exp-str))
Eli Zaretskii's avatar
Eli Zaretskii committed
576
    (if calc-language-input-filter
577 578 579 580
	(setq math-exp-str (funcall calc-language-input-filter math-exp-str)))
    (while (setq math-exp-token (string-match "\\.\\.\\([^.]\\|.[^.]\\)" math-exp-str))
      (setq math-exp-str (concat (substring math-exp-str 0 math-exp-token) "\\dots"
			    (substring math-exp-str (+ math-exp-token 2)))))
Eli Zaretskii's avatar
Eli Zaretskii committed
581 582 583 584
    (math-build-parse-table)
    (math-read-token)
    (let ((val (catch 'syntax (math-read-expr-list))))
      (if (stringp val)
585 586
	  (list 'error math-exp-old-pos val)
	(if (equal math-exp-token 'end)
Eli Zaretskii's avatar
Eli Zaretskii committed
587
	    val
588
	  (list 'error math-exp-old-pos "Syntax error"))))))
Eli Zaretskii's avatar
Eli Zaretskii committed
589 590

(defun math-read-expr-list ()
591
  (let* ((math-exp-keep-spaces nil)
Eli Zaretskii's avatar
Eli Zaretskii committed
592 593
	 (val (list (math-read-expr-level 0)))
	 (last val))
594
    (while (equal math-expr-data ",")
Eli Zaretskii's avatar
Eli Zaretskii committed
595 596 597 598
      (math-read-token)
      (let ((rest (list (math-read-expr-level 0))))
	(setcdr last rest)
	(setq last rest)))
599
    val))
Eli Zaretskii's avatar
Eli Zaretskii committed
600

601 602 603 604 605
(defvar calc-user-parse-table nil)
(defvar calc-last-main-parse-table nil)
(defvar calc-last-lang-parse-table nil)
(defvar calc-user-tokens nil)
(defvar calc-user-token-chars nil)
Eli Zaretskii's avatar
Eli Zaretskii committed
606

607 608 609
(defvar math-toks nil
  "Tokens to pass between math-build-parse-table and math-find-user-tokens.")

Eli Zaretskii's avatar
Eli Zaretskii committed
610 611 612 613 614 615
(defun math-build-parse-table ()
  (let ((mtab (cdr (assq nil calc-user-parse-tables)))
	(ltab (cdr (assq calc-language calc-user-parse-tables))))
    (or (and (eq mtab calc-last-main-parse-table)
	     (eq ltab calc-last-lang-parse-table))
	(let ((p (append mtab ltab))
616
	      (math-toks nil))
Eli Zaretskii's avatar
Eli Zaretskii committed
617 618 619 620 621 622
	  (setq calc-user-parse-table p)
	  (setq calc-user-token-chars nil)
	  (while p
	    (math-find-user-tokens (car (car p)))
	    (setq p (cdr p)))
	  (setq calc-user-tokens (mapconcat 'identity
623
					    (sort (mapcar 'car math-toks)
Eli Zaretskii's avatar
Eli Zaretskii committed
624 625 626 627 628
						  (function (lambda (x y)
							      (> (length x)
								 (length y)))))
					    "\\|")
		calc-last-main-parse-table mtab
629
		calc-last-lang-parse-table ltab)))))
Eli Zaretskii's avatar
Eli Zaretskii committed
630

631
(defun math-find-user-tokens (p)
Eli Zaretskii's avatar
Eli Zaretskii committed
632 633 634 635 636 637 638 639 640 641
  (while p
    (cond ((and (stringp (car p))
		(or (> (length (car p)) 1) (equal (car p) "$")
		    (equal (car p) "\""))
		(string-match "[^a-zA-Z0-9]" (car p)))
	   (let ((s (regexp-quote (car p))))
	     (if (string-match "\\`[a-zA-Z0-9]" s)
		 (setq s (concat "\\<" s)))
	     (if (string-match "[a-zA-Z0-9]\\'" s)
		 (setq s (concat s "\\>")))
642
	     (or (assoc s math-toks)
Eli Zaretskii's avatar
Eli Zaretskii committed
643
		 (progn
644
		   (setq math-toks (cons (list s) math-toks))
Eli Zaretskii's avatar
Eli Zaretskii committed
645 646 647 648 649 650 651 652
		   (or (memq (aref (car p) 0) calc-user-token-chars)
		       (setq calc-user-token-chars
			     (cons (aref (car p) 0)
				   calc-user-token-chars)))))))
	  ((consp (car p))
	   (math-find-user-tokens (nth 1 (car p)))
	   (or (eq (car (car p)) '\?)
	       (math-find-user-tokens (nth 2 (car p))))))
653
    (setq p (cdr p))))
Eli Zaretskii's avatar
Eli Zaretskii committed
654 655

(defun math-read-token ()
656 657 658
  (if (>= math-exp-pos (length math-exp-str))
      (setq math-exp-old-pos math-exp-pos
	    math-exp-token 'end
659
	    math-expr-data "\000")
660 661
    (let ((ch (aref math-exp-str math-exp-pos)))
      (setq math-exp-old-pos math-exp-pos)
Eli Zaretskii's avatar
Eli Zaretskii committed
662
      (cond ((memq ch '(32 10 9))
663 664 665
	     (setq math-exp-pos (1+ math-exp-pos))
	     (if math-exp-keep-spaces
		 (setq math-exp-token 'space
666
		       math-expr-data " ")
Eli Zaretskii's avatar
Eli Zaretskii committed
667 668 669
	       (math-read-token)))
	    ((and (memq ch calc-user-token-chars)
		  (let ((case-fold-search nil))
670 671 672 673 674
		    (eq (string-match calc-user-tokens math-exp-str math-exp-pos)
			math-exp-pos)))
	     (setq math-exp-token 'punc
		   math-expr-data (math-match-substring math-exp-str 0)
		   math-exp-pos (match-end 0)))
Eli Zaretskii's avatar
Eli Zaretskii committed
675 676 677 678 679
	    ((or (and (>= ch ?a) (<= ch ?z))
		 (and (>= ch ?A) (<= ch ?Z)))
	     (string-match (if (memq calc-language '(c fortran pascal maple))
			       "[a-zA-Z0-9_#]*"
			     "[a-zA-Z0-9'#]*")
680 681 682
			   math-exp-str math-exp-pos)
	     (setq math-exp-token 'symbol
		   math-exp-pos (match-end 0)
683
		   math-expr-data (math-restore-dashes
684
			     (math-match-substring math-exp-str 0)))
Eli Zaretskii's avatar
Eli Zaretskii committed
685
	     (if (eq calc-language 'eqn)
686
		 (let ((code (assoc math-expr-data math-eqn-ignore-words)))
Eli Zaretskii's avatar
Eli Zaretskii committed
687 688 689 690 691
		   (cond ((null code))
			 ((null (cdr code))
			  (math-read-token))
			 ((consp (nth 1 code))
			  (math-read-token)
692 693 694
			  (if (assoc math-expr-data (cdr code))
			      (setq math-expr-data (format "%s %s"
						     (car code) math-expr-data))))
Eli Zaretskii's avatar
Eli Zaretskii committed
695
			 ((eq (nth 1 code) 'punc)
696
			  (setq math-exp-token 'punc
697
				math-expr-data (nth 2 code)))
Eli Zaretskii's avatar
Eli Zaretskii committed
698 699 700 701 702
			 (t
			  (math-read-token)
			  (math-read-token))))))
	    ((or (and (>= ch ?0) (<= ch ?9))
		 (and (eq ch '?\.)
703
		      (eq (string-match "\\.[0-9]" math-exp-str math-exp-pos)
704
                          math-exp-pos))
Eli Zaretskii's avatar
Eli Zaretskii committed
705
		 (and (eq ch '?_)
706
		      (eq (string-match "_\\.?[0-9]" math-exp-str math-exp-pos)
707 708
                          math-exp-pos)
		      (or (eq math-exp-pos 0)
Eli Zaretskii's avatar
Eli Zaretskii committed
709
			  (and (memq calc-language '(nil flat big unform
710
							 tex latex eqn))
Eli Zaretskii's avatar
Eli Zaretskii committed
711
			       (eq (string-match "[^])}\"a-zA-Z0-9'$]_"
712 713
						 math-exp-str (1- math-exp-pos))
				   (1- math-exp-pos))))))
Eli Zaretskii's avatar
Eli Zaretskii committed
714
	     (or (and (eq calc-language 'c)
715
		      (string-match "0[xX][0-9a-fA-F]+" math-exp-str math-exp-pos))
716
		 (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]+\\)?\"?\\)?"
717 718 719 720
                               math-exp-str math-exp-pos))
	     (setq math-exp-token 'number
		   math-expr-data (math-match-substring math-exp-str 0)
		   math-exp-pos (match-end 0)))
Eli Zaretskii's avatar
Eli Zaretskii committed
721 722 723 724
	    ((eq ch ?\$)
	     (if (and (eq calc-language 'pascal)
		      (eq (string-match
			   "\\(\\$[0-9a-fA-F]+\\)\\($\\|[^0-9a-zA-Z]\\)"
725 726 727 728 729 730 731
			   math-exp-str math-exp-pos)
			  math-exp-pos))
		 (setq math-exp-token 'number
		       math-expr-data (math-match-substring math-exp-str 1)
		       math-exp-pos (match-end 1))
	       (if (eq (string-match "\\$\\([1-9][0-9]*\\)" math-exp-str math-exp-pos)
		       math-exp-pos)
732
		   (setq math-expr-data (- (string-to-number (math-match-substring
733 734
						     math-exp-str 1))))
		 (string-match "\\$+" math-exp-str math-exp-pos)
735
		 (setq math-expr-data (- (match-end 0) (match-beginning 0))))
736 737
	       (setq math-exp-token 'dollar
		     math-exp-pos (match-end 0))))
Eli Zaretskii's avatar
Eli Zaretskii committed
738
	    ((eq ch ?\#)
739 740
	     (if (eq (string-match "#\\([1-9][0-9]*\\)" math-exp-str math-exp-pos)
		     math-exp-pos)
741
		 (setq math-expr-data (string-to-number
742 743
				 (math-match-substring math-exp-str 1))
		       math-exp-pos (match-end 0))
744
	       (setq math-expr-data 1
745 746
		     math-exp-pos (1+ math-exp-pos)))
	     (setq math-exp-token 'hash))
Eli Zaretskii's avatar
Eli Zaretskii committed
747
	    ((eq (string-match "~=\\|<=\\|>=\\|<>\\|/=\\|\\+/-\\|\\\\dots\\|\\\\ldots\\|\\*\\*\\|<<\\|>>\\|==\\|!=\\|&&&\\||||\\|!!!\\|&&\\|||\\|!!\\|:=\\|::\\|=>"
748 749 750 751 752
			       math-exp-str math-exp-pos)
		 math-exp-pos)
	     (setq math-exp-token 'punc
		   math-expr-data (math-match-substring math-exp-str 0)
		   math-exp-pos (match-end 0)))
Eli Zaretskii's avatar
Eli Zaretskii committed
753
	    ((and (eq ch ?\")
754
		  (string-match "\\(\"\\([^\"\\]\\|\\\\.\\)*\\)\\(\"\\|\\'\\)"
755
                                math-exp-str math-exp-pos))
Eli Zaretskii's avatar
Eli Zaretskii committed
756 757
	     (if (eq calc-language 'eqn)
		 (progn
758 759 760 761
		   (setq math-exp-str (copy-sequence math-exp-str))
		   (aset math-exp-str (match-beginning 1) ?\{)
		   (if (< (match-end 1) (length math-exp-str))
		       (aset math-exp-str (match-end 1) ?\}))
Eli Zaretskii's avatar
Eli Zaretskii committed
762
		   (math-read-token))
763 764 765
	       (setq math-exp-token 'string
		     math-expr-data (math-match-substring math-exp-str 1)
		     math-exp-pos (match-end 0))))
766
	    ((and (= ch ?\\) (eq calc-language 'tex)
767
		  (< math-exp-pos (1- (length math-exp-str))))
768
	     (or (string-match "\\\\hbox *{\\([a-zA-Z0-9]+\\)}"
769
                               math-exp-str math-exp-pos)
770
		 (string-match "\\(\\\\\\([a-zA-Z]+\\|[^a-zA-Z]\\)\\)"
771 772 773
                               math-exp-str math-exp-pos))
	     (setq math-exp-token 'symbol
		   math-exp-pos (match-end 0)
774
		   math-expr-data (math-restore-dashes
775
			     (math-match-substring math-exp-str 1)))
776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793
	     (let ((code (assoc math-expr-data math-latex-ignore-words)))
	       (cond ((null code))
		     ((null (cdr code))
		      (math-read-token))
		     ((eq (nth 1 code) 'punc)
		      (setq math-exp-token 'punc
			    math-expr-data (nth 2 code)))
                      ((and (eq (nth 1 code) 'mat)
                            (string-match " *{" math-exp-str math-exp-pos))
		      (setq math-exp-pos (match-end 0)
			    math-exp-token 'punc
			    math-expr-data "[")
		      (let ((right (string-match "}" math-exp-str math-exp-pos)))
			(and right
			     (setq math-exp-str (copy-sequence math-exp-str))
			     (aset math-exp-str right ?\])))))))
	    ((and (= ch ?\\) (eq calc-language 'latex)
		  (< math-exp-pos (1- (length math-exp-str))))
794
	     (or (string-match "\\\\hbox *{\\([a-zA-Z0-9]+\\)}"
795
                               math-exp-str math-exp-pos)
796
                 (string-match "\\\\text *{\\([a-zA-Z0-9]+\\)}"
797
                               math-exp-str math-exp-pos)
798
		 (string-match "\\(\\\\\\([a-zA-Z]+\\|[^a-zA-Z]\\)\\)"
799 800 801 802 803
                               math-exp-str math-exp-pos))
	     (setq math-exp-token 'symbol
		   math-exp-pos (match-end 0)
		   math-expr-data (math-restore-dashes
			     (math-match-substring math-exp-str 1)))
804 805
	     (let ((code (assoc math-expr-data math-tex-ignore-words))
                   envname)
Eli Zaretskii's avatar
Eli Zaretskii committed
806 807 808 809
	       (cond ((null code))
		     ((null (cdr code))
		      (math-read-token))
		     ((eq (nth 1 code) 'punc)
810
		      (setq math-exp-token 'punc
811
			    math-expr-data (nth 2 code)))
812 813 814 815 816 817 818 819
                     ((and (eq (nth 1 code) 'begenv)
                           (string-match " *{\\([^}]*\\)}" math-exp-str math-exp-pos))
                      (setq math-exp-pos (match-end 0)
                            envname (match-string 1 math-exp-str)
                            math-exp-token 'punc
                            math-expr-data "[")
                      (cond ((or (string= envname "matrix")
                                 (string= envname "bmatrix")
820
                                 (string= envname "smallmatrix")
821
                                 (string= envname "pmatrix"))
822 823
                             (if (string-match (concat "\\\\end{" envname "}")
                                               math-exp-str math-exp-pos)
824
                                 (setq math-exp-str
825 826 827 828
                                       (replace-match "]" t t math-exp-str))
                               (error "%s" (concat "No closing \\end{" envname "}"))))))
                      ((and (eq (nth 1 code) 'mat)
                            (string-match " *{" math-exp-str math-exp-pos))
829 830
		      (setq math-exp-pos (match-end 0)
			    math-exp-token 'punc
831
			    math-expr-data "[")
832
		      (let ((right (string-match "}" math-exp-str math-exp-pos)))
Eli Zaretskii's avatar
Eli Zaretskii committed
833
			(and right
834 835
			     (setq math-exp-str (copy-sequence math-exp-str))
			     (aset math-exp-str right ?\])))))))
Eli Zaretskii's avatar
Eli Zaretskii committed
836 837
	    ((and (= ch ?\.) (eq calc-language 'fortran)
		  (eq (string-match "\\.[a-zA-Z][a-zA-Z][a-zA-Z]?\\."
838 839 840 841
				    math-exp-str math-exp-pos) math-exp-pos))
	     (setq math-exp-token 'punc
		   math-expr-data (upcase (math-match-substring math-exp-str 0))
		   math-exp-pos (match-end 0)))
Eli Zaretskii's avatar
Eli Zaretskii committed
842
	    ((and (eq calc-language 'math)
843 844 845 846 847
		  (eq (string-match "\\[\\[\\|->\\|:>" math-exp-str math-exp-pos)
		      math-exp-pos))
	     (setq math-exp-token 'punc
		   math-expr-data (math-match-substring math-exp-str 0)
		   math-exp-pos (match-end 0)))
Eli Zaretskii's avatar
Eli Zaretskii committed
848 849
	    ((and (eq calc-language 'eqn)
		  (eq (string-match "->\\|<-\\|+-\\|\\\\dots\\|~\\|\\^"
850 851 852 853 854
				    math-exp-str math-exp-pos)
		      math-exp-pos))
	     (setq math-exp-token 'punc
		   math-expr-data (math-match-substring math-exp-str 0)
		   math-exp-pos (match-end 0))
855
	     (and (eq (string-match "\\\\dots\\." math-exp-str math-exp-pos)
856 857
                      math-exp-pos)
		  (setq math-exp-pos (match-end 0)))
858
	     (if (memq (aref math-expr-data 0) '(?~ ?^))
Eli Zaretskii's avatar
Eli Zaretskii committed
859
		 (math-read-token)))
860 861
	    ((eq (string-match "%%.*$" math-exp-str math-exp-pos) math-exp-pos)
	     (setq math-exp-pos (match-end 0))
Eli Zaretskii's avatar
Eli Zaretskii committed
862 863
	     (math-read-token))
	    (t
864
	     (if (and (eq ch ?\{) (memq calc-language '(tex latex eqn)))
Eli Zaretskii's avatar
Eli Zaretskii committed
865
		 (setq ch ?\())
866
	     (if (and (eq ch ?\}) (memq calc-language '(tex latex eqn)))
Eli Zaretskii's avatar
Eli Zaretskii committed
867
		 (setq ch ?\)))
868
	     (if (and (eq ch ?\&) (memq calc-language '(tex latex)))
Eli Zaretskii's avatar
Eli Zaretskii committed
869
		 (setq ch ?\,))
870
	     (setq math-exp-token 'punc
871
		   math-expr-data (char-to-string ch)
872
		   math-exp-pos (1+ math-exp-pos)))))))
Eli Zaretskii's avatar
Eli Zaretskii committed
873

874 875 876
(defconst math-alg-inequalities
  '(calcFunc-lt calcFunc-gt calcFunc-leq calcFunc-geq
		calcFunc-eq calcFunc-neq))
Eli Zaretskii's avatar
Eli Zaretskii committed
877 878 879 880 881 882 883

(defun math-read-expr-level (exp-prec &optional exp-term)
  (let* ((x (math-read-factor)) (first t) op op2)
    (while (and (or (and calc-user-parse-table
			 (setq op (calc-check-user-syntax x exp-prec))
			 (setq x op
			       op '("2x" ident 999999 -1)))
884
		    (and (setq op (assoc math-expr-data math-expr-opers))
Eli Zaretskii's avatar
Eli Zaretskii committed
885 886
			 (/= (nth 2 op) -1)
			 (or (and (setq op2 (assoc
887
					     math-expr-data
Eli Zaretskii's avatar
Eli Zaretskii committed
888 889 890 891 892 893 894 895
					     (cdr (memq op math-expr-opers))))
				  (eq (= (nth 3 op) -1)
				      (/= (nth 3 op2) -1))
				  (eq (= (nth 3 op2) -1)
				      (not (math-factor-after)))
				  (setq op op2))
			     t))
		    (and (or (eq (nth 2 op) -1)
896
			     (memq math-exp-token '(symbol number dollar hash))
897 898
			     (equal math-expr-data "(")
			     (and (equal math-expr-data "[")
Eli Zaretskii's avatar
Eli Zaretskii committed
899
				  (not (eq calc-language 'math))
900
				  (not (and math-exp-keep-spaces
Eli Zaretskii's avatar
Eli Zaretskii committed
901
					    (eq (car-safe x) 'vec)))))
902
			 (or (not (setq op (assoc math-expr-data math-expr-opers)))
Eli Zaretskii's avatar
Eli Zaretskii committed
903 904
			     (/= (nth 2 op) -1))
			 (or (not calc-user-parse-table)
905
			     (not (eq math-exp-token 'symbol))
Eli Zaretskii's avatar
Eli Zaretskii committed
906 907 908 909 910 911
			     (let ((p calc-user-parse-table))
			       (while (and p
					   (or (not (integerp
						     (car (car (car p)))))
					       (not (equal
						     (nth 1 (car (car p)))
912
						     math-expr-data))))
Eli Zaretskii's avatar
Eli Zaretskii committed
913 914 915
				 (setq p (cdr p)))
			       (not p)))
			 (setq op (assoc "2x" math-expr-opers))))
916
		(not (and exp-term (equal math-expr-data exp-term)))
Eli Zaretskii's avatar
Eli Zaretskii committed
917 918 919 920
		(>= (nth 2 op) exp-prec))
      (if (not (equal (car op) "2x"))
	  (math-read-token))
      (and (memq (nth 1 op) '(sdev mod))
921
	   (require 'calc-ext))
Eli Zaretskii's avatar
Eli Zaretskii committed
922 923 924 925 926 927 928 929 930 931 932 933 934 935 936
      (setq x (cond ((consp (nth 1 op))
		     (funcall (car (nth 1 op)) x op))
		    ((eq (nth 3 op) -1)
		     (if (eq (nth 1 op) 'ident)
			 x
		       (if (eq (nth 1 op) 'closing)
			   (if (eq (nth 2 op) exp-prec)
			       (progn
				 (setq exp-prec 1000)
				 x)
			     (throw 'syntax "Mismatched delimiters"))
			 (list (nth 1 op) x))))
		    ((and (not first)
			  (memq (nth 1 op) math-alg-inequalities)
			  (memq (car-safe x) math-alg-inequalities))
937
		     (require 'calc-ext)
Eli Zaretskii's avatar
Eli Zaretskii committed
938 939 940 941 942
		     (math-composite-inequalities x op))
		    (t (list (nth 1 op)
			     x
			     (math-read-expr-level (nth 3 op) exp-term))))
	    first nil))
943
    x))
Eli Zaretskii's avatar
Eli Zaretskii committed
944

Jay Belanger's avatar
Jay Belanger committed
945 946 947
;; calc-arg-values is defined in calc-ext.el, but is used here.
(defvar calc-arg-values)

Eli Zaretskii's avatar
Eli Zaretskii committed
948 949 950 951 952 953 954 955 956 957
(defun calc-check-user-syntax (&optional x prec)
  (let ((p calc-user-parse-table)
	(matches nil)
	match rule)
    (while (and p
		(or (not (progn
			   (setq rule (car (car p)))
			   (if x
			       (and (integerp (car rule))
				    (>= (car rule) prec)
958
				    (equal math-expr-data
Eli Zaretskii's avatar
Eli Zaretskii committed
959
					   (car (setq rule (cdr rule)))))
960
			     (equal math-expr-data (car rule)))))
961 962 963
		    (let ((save-exp-pos math-exp-pos)
			  (save-exp-old-pos math-exp-old-pos)
			  (save-exp-token math-exp-token)
964
			  (save-exp-data math-expr-data))
Eli Zaretskii's avatar
Eli Zaretskii committed
965 966 967
		      (or (not (listp
				(setq matches (calc-match-user-syntax rule))))
			  (let ((args (progn
968
					(require 'calc-ext)
Eli Zaretskii's avatar
Eli Zaretskii committed
969 970 971 972 973 974 975 976 977 978 979 980 981 982
					calc-arg-values))
				(conds nil)
				temp)
			    (if x
				(setq matches (cons x matches)))
			    (setq match (cdr (car p)))
			    (while (and (eq (car-safe match)
					    'calcFunc-condition)
					(= (length match) 3))
			      (setq conds (append (math-flatten-lands
						   (nth 2 match))
						  conds)
				    match (nth 1 match)))
			    (while (and conds match)
983
			      (require 'calc-ext)
Eli Zaretskii's avatar
Eli Zaretskii committed
984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026
			      (cond ((eq (car-safe (car conds))
					 'calcFunc-let)
				     (setq temp (car conds))
				     (or (= (length temp) 3)
					 (and (= (length temp) 2)
					      (eq (car-safe (nth 1 temp))
						  'calcFunc-assign)
					      (= (length (nth 1 temp)) 3)
					      (setq temp (nth 1 temp)))
					 (setq match nil))
				     (setq matches (cons
						    (math-normalize
						     (math-multi-subst
						      (nth 2 temp)
						      args matches))
						    matches)
					   args (cons (nth 1 temp)
						      args)))
				    ((and (eq (car-safe (car conds))
					      'calcFunc-matches)
					  (= (length (car conds)) 3))
				     (setq temp (calcFunc-vmatches
						 (math-multi-subst
						  (nth 1 (car conds))
						  args matches)
						 (nth 2 (car conds))))
				     (if (eq temp 0)
					 (setq match nil)
				       (while (setq temp (cdr temp))
					 (setq matches (cons (nth 2 (car temp))
							     matches)
					       args (cons (nth 1 (car temp))
							  args)))))
				    (t
				     (or (math-is-true (math-simplify
							(math-multi-subst
							 (car conds)
							 args matches)))
					 (setq match nil))))
			      (setq conds (cdr conds)))
			    (if match
				(not (setq match (math-multi-subst
						  match args matches)))
1027 1028
			      (setq math-exp-old-pos save-exp-old-pos
				    math-exp-token save-exp-token
1029
				    math-expr-data save-exp-data
1030
				    math-exp-pos