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