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