(calc-user-invocation): Check if calc-invocation-macro is non-nil.
[bpt/emacs.git] / lisp / calc / calc-lang.el
CommitLineData
3132f345
CW
1;;; calc-lang.el --- calc language functions
2
a42e94ca 3;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2005 Free Software Foundation, Inc.
3132f345
CW
4
5;; Author: David Gillespie <daveg@synaptics.com>
8cd2540e 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
CW
25;;; Commentary:
26
27;;; Code:
136211a9 28
136211a9 29;; This file is autoloaded from calc-ext.el.
136211a9 30
4b37638f 31(require 'calc-ext)
136211a9
EZ
32(require 'calc-macs)
33
136211a9
EZ
34;;; Alternate entry/display languages.
35
36(defun calc-set-language (lang &optional option no-refresh)
37 (setq math-expr-opers (or (get lang 'math-oper-table) math-standard-opers)
38 math-expr-function-mapping (get lang 'math-function-table)
2d3ce3f2 39 math-expr-special-function-mapping (get lang 'math-special-function-table)
136211a9
EZ
40 math-expr-variable-mapping (get lang 'math-variable-table)
41 calc-language-input-filter (get lang 'math-input-filter)
42 calc-language-output-filter (get lang 'math-output-filter)
43 calc-vector-brackets (or (get lang 'math-vector-brackets) "[]")
44 calc-complex-format (get lang 'math-complex-format)
45 calc-radix-formatter (get lang 'math-radix-formatter)
46 calc-function-open (or (get lang 'math-function-open) "(")
47 calc-function-close (or (get lang 'math-function-close) ")"))
48 (if no-refresh
49 (setq calc-language lang
50 calc-language-option option)
51 (calc-change-mode '(calc-language calc-language-option)
bf77c646 52 (list lang option) t)))
136211a9
EZ
53
54(defun calc-normal-language ()
55 (interactive)
56 (calc-wrapper
57 (calc-set-language nil)
3132f345 58 (message "Normal language mode")))
136211a9
EZ
59
60(defun calc-flat-language ()
61 (interactive)
62 (calc-wrapper
63 (calc-set-language 'flat)
3132f345 64 (message "Flat language mode (all stack entries shown on one line)")))
136211a9
EZ
65
66(defun calc-big-language ()
67 (interactive)
68 (calc-wrapper
69 (calc-set-language 'big)
3132f345 70 (message "\"Big\" language mode")))
136211a9
EZ
71
72(defun calc-unformatted-language ()
73 (interactive)
74 (calc-wrapper
75 (calc-set-language 'unform)
3132f345 76 (message "Unformatted language mode")))
136211a9
EZ
77
78
79(defun calc-c-language ()
80 (interactive)
81 (calc-wrapper
82 (calc-set-language 'c)
3132f345 83 (message "`C' language mode")))
136211a9
EZ
84
85(put 'c 'math-oper-table
86 '( ( "u+" ident -1 1000 )
87 ( "u-" neg -1 1000 )
88 ( "u!" calcFunc-lnot -1 1000 )
89 ( "~" calcFunc-not -1 1000 )
90 ( "*" * 190 191 )
91 ( "/" / 190 191 )
92 ( "%" % 190 191 )
93 ( "+" + 180 181 )
94 ( "-" - 180 181 )
95 ( "<<" calcFunc-lsh 170 171 )
96 ( ">>" calcFunc-rsh 170 171 )
97 ( "<" calcFunc-lt 160 161 )
98 ( ">" calcFunc-gt 160 161 )
99 ( "<=" calcFunc-leq 160 161 )
100 ( ">=" calcFunc-geq 160 161 )
101 ( "==" calcFunc-eq 150 151 )
102 ( "!=" calcFunc-neq 150 151 )
103 ( "&" calcFunc-and 140 141 )
104 ( "^" calcFunc-xor 131 130 )
105 ( "|" calcFunc-or 120 121 )
106 ( "&&" calcFunc-land 110 111 )
107 ( "||" calcFunc-lor 100 101 )
108 ( "?" (math-read-if) 91 90 )
109 ( "!!!" calcFunc-pnot -1 88 )
110 ( "&&&" calcFunc-pand 85 86 )
111 ( "|||" calcFunc-por 75 76 )
112 ( "=" calcFunc-assign 51 50 )
113 ( ":=" calcFunc-assign 51 50 )
bf77c646 114 ( "::" calcFunc-condition 45 46 ))) ; should support full assignments
136211a9
EZ
115
116(put 'c 'math-function-table
117 '( ( acos . calcFunc-arccos )
118 ( acosh . calcFunc-arccosh )
119 ( asin . calcFunc-arcsin )
120 ( asinh . calcFunc-arcsinh )
121 ( atan . calcFunc-arctan )
122 ( atan2 . calcFunc-arctan2 )
bf77c646 123 ( atanh . calcFunc-arctanh )))
136211a9
EZ
124
125(put 'c 'math-variable-table
126 '( ( M_PI . var-pi )
bf77c646 127 ( M_E . var-e )))
136211a9
EZ
128
129(put 'c 'math-vector-brackets "{}")
130
131(put 'c 'math-radix-formatter
132 (function (lambda (r s)
133 (if (= r 16) (format "0x%s" s)
134 (if (= r 8) (format "0%s" s)
135 (format "%d#%s" r s))))))
136
137
138(defun calc-pascal-language (n)
139 (interactive "P")
140 (calc-wrapper
141 (and n (setq n (prefix-numeric-value n)))
142 (calc-set-language 'pascal n)
143 (message (if (and n (/= n 0))
144 (if (> n 0)
3132f345
CW
145 "Pascal language mode (all uppercase)"
146 "Pascal language mode (all lowercase)")
147 "Pascal language mode"))))
136211a9
EZ
148
149(put 'pascal 'math-oper-table
150 '( ( "not" calcFunc-lnot -1 1000 )
151 ( "*" * 190 191 )
152 ( "/" / 190 191 )
153 ( "and" calcFunc-and 190 191 )
154 ( "div" calcFunc-idiv 190 191 )
155 ( "mod" % 190 191 )
156 ( "u+" ident -1 185 )
157 ( "u-" neg -1 185 )
158 ( "+" + 180 181 )
159 ( "-" - 180 181 )
160 ( "or" calcFunc-or 180 181 )
161 ( "xor" calcFunc-xor 180 181 )
162 ( "shl" calcFunc-lsh 180 181 )
163 ( "shr" calcFunc-rsh 180 181 )
164 ( "in" calcFunc-in 160 161 )
165 ( "<" calcFunc-lt 160 161 )
166 ( ">" calcFunc-gt 160 161 )
167 ( "<=" calcFunc-leq 160 161 )
168 ( ">=" calcFunc-geq 160 161 )
169 ( "=" calcFunc-eq 160 161 )
170 ( "<>" calcFunc-neq 160 161 )
171 ( "!!!" calcFunc-pnot -1 85 )
172 ( "&&&" calcFunc-pand 80 81 )
173 ( "|||" calcFunc-por 75 76 )
174 ( ":=" calcFunc-assign 51 50 )
bf77c646 175 ( "::" calcFunc-condition 45 46 )))
136211a9
EZ
176
177(put 'pascal 'math-input-filter 'calc-input-case-filter)
178(put 'pascal 'math-output-filter 'calc-output-case-filter)
179
180(put 'pascal 'math-radix-formatter
181 (function (lambda (r s)
182 (if (= r 16) (format "$%s" s)
183 (format "%d#%s" r s)))))
184
185(defun calc-input-case-filter (str)
186 (cond ((or (null calc-language-option) (= calc-language-option 0))
187 str)
188 (t
bf77c646 189 (downcase str))))
136211a9
EZ
190
191(defun calc-output-case-filter (str)
192 (cond ((or (null calc-language-option) (= calc-language-option 0))
193 str)
194 ((> calc-language-option 0)
195 (upcase str))
196 (t
bf77c646 197 (downcase str))))
136211a9
EZ
198
199
200(defun calc-fortran-language (n)
201 (interactive "P")
202 (calc-wrapper
203 (and n (setq n (prefix-numeric-value n)))
204 (calc-set-language 'fortran n)
205 (message (if (and n (/= n 0))
206 (if (> n 0)
3132f345
CW
207 "FORTRAN language mode (all uppercase)"
208 "FORTRAN language mode (all lowercase)")
209 "FORTRAN language mode"))))
136211a9
EZ
210
211(put 'fortran 'math-oper-table
212 '( ( "u/" (math-parse-fortran-vector) -1 1 )
213 ( "/" (math-parse-fortran-vector-end) 1 -1 )
214 ( "**" ^ 201 200 )
215 ( "u+" ident -1 191 )
216 ( "u-" neg -1 191 )
217 ( "*" * 190 191 )
218 ( "/" / 190 191 )
219 ( "+" + 180 181 )
220 ( "-" - 180 181 )
221 ( ".LT." calcFunc-lt 160 161 )
222 ( ".GT." calcFunc-gt 160 161 )
223 ( ".LE." calcFunc-leq 160 161 )
224 ( ".GE." calcFunc-geq 160 161 )
225 ( ".EQ." calcFunc-eq 160 161 )
226 ( ".NE." calcFunc-neq 160 161 )
227 ( ".NOT." calcFunc-lnot -1 121 )
228 ( ".AND." calcFunc-land 110 111 )
229 ( ".OR." calcFunc-lor 100 101 )
230 ( "!!!" calcFunc-pnot -1 85 )
231 ( "&&&" calcFunc-pand 80 81 )
232 ( "|||" calcFunc-por 75 76 )
233 ( "=" calcFunc-assign 51 50 )
234 ( ":=" calcFunc-assign 51 50 )
bf77c646 235 ( "::" calcFunc-condition 45 46 )))
136211a9
EZ
236
237(put 'fortran 'math-vector-brackets "//")
238
239(put 'fortran 'math-function-table
240 '( ( acos . calcFunc-arccos )
241 ( acosh . calcFunc-arccosh )
242 ( aimag . calcFunc-im )
243 ( aint . calcFunc-ftrunc )
244 ( asin . calcFunc-arcsin )
245 ( asinh . calcFunc-arcsinh )
246 ( atan . calcFunc-arctan )
247 ( atan2 . calcFunc-arctan2 )
248 ( atanh . calcFunc-arctanh )
249 ( conjg . calcFunc-conj )
250 ( log . calcFunc-ln )
251 ( nint . calcFunc-round )
a1506d29 252 ( real . calcFunc-re )))
136211a9
EZ
253
254(put 'fortran 'math-input-filter 'calc-input-case-filter)
255(put 'fortran 'math-output-filter 'calc-output-case-filter)
256
0aba68f8
JB
257;; The next few variables are local to math-read-exprs in calc-aent.el
258;; and math-read-expr in calc-ext.el, but are set in functions they call.
259
260(defvar math-exp-token)
261(defvar math-expr-data)
262(defvar math-exp-old-pos)
263
3132f345 264(defvar math-parsing-fortran-vector nil)
136211a9
EZ
265(defun math-parse-fortran-vector (op)
266 (let ((math-parsing-fortran-vector '(end . "\000")))
267 (prog1
268 (math-read-brackets t "]")
679e2630 269 (setq math-exp-token (car math-parsing-fortran-vector)
54961aa0 270 math-expr-data (cdr math-parsing-fortran-vector)))))
136211a9
EZ
271
272(defun math-parse-fortran-vector-end (x op)
273 (if math-parsing-fortran-vector
274 (progn
679e2630
JB
275 (setq math-parsing-fortran-vector (cons math-exp-token math-expr-data)
276 math-exp-token 'end
54961aa0 277 math-expr-data "\000")
136211a9 278 x)
bf77c646 279 (throw 'syntax "Unmatched closing `/'")))
136211a9
EZ
280
281(defun math-parse-fortran-subscr (sym args)
282 (setq sym (math-build-var-name sym))
283 (while args
284 (setq sym (list 'calcFunc-subscr sym (car args))
285 args (cdr args)))
bf77c646 286 sym)
136211a9
EZ
287
288
289(defun calc-tex-language (n)
290 (interactive "P")
291 (calc-wrapper
292 (and n (setq n (prefix-numeric-value n)))
293 (calc-set-language 'tex n)
61983af0
JB
294 (cond ((not n)
295 (message "TeX language mode"))
296 ((= n 0)
297 (message "TeX language mode with multiline matrices"))
298 ((= n 1)
299 (message "TeX language mode with \\hbox{func}(\\hbox{var})"))
300 ((> n 1)
301 (message
302 "TeX language mode with \\hbox{func}(\\hbox{var}) and multiline matrices"))
303 ((= n -1)
304 (message "TeX language mode with \\func(\\hbox{var})"))
305 ((< n -1)
306 (message
307 "TeX language mode with \\func(\\hbox{var}) and multiline matrices")))))
136211a9 308
2d3ce3f2
JB
309(defun calc-latex-language (n)
310 (interactive "P")
311 (calc-wrapper
312 (and n (setq n (prefix-numeric-value n)))
313 (calc-set-language 'latex n)
314 (cond ((not n)
315 (message "LaTeX language mode"))
316 ((= n 0)
317 (message "LaTeX language mode with multiline matrices"))
318 ((= n 1)
319 (message "LaTeX language mode with \\text{func}(\\text{var})"))
320 ((> n 1)
321 (message
322 "LaTeX language mode with \\text{func}(\\text{var}) and multiline matrices"))
323 ((= n -1)
324 (message "LaTeX language mode with \\func(\\text{var})"))
325 ((< n -1)
326 (message
327 "LaTeX language mode with \\func(\\text{var}) and multiline matrices")))))
328
136211a9
EZ
329(put 'tex 'math-oper-table
330 '( ( "u+" ident -1 1000 )
331 ( "u-" neg -1 1000 )
332 ( "\\hat" calcFunc-hat -1 950 )
333 ( "\\check" calcFunc-check -1 950 )
334 ( "\\tilde" calcFunc-tilde -1 950 )
335 ( "\\acute" calcFunc-acute -1 950 )
336 ( "\\grave" calcFunc-grave -1 950 )
337 ( "\\dot" calcFunc-dot -1 950 )
338 ( "\\ddot" calcFunc-dotdot -1 950 )
339 ( "\\breve" calcFunc-breve -1 950 )
340 ( "\\bar" calcFunc-bar -1 950 )
341 ( "\\vec" calcFunc-Vec -1 950 )
342 ( "\\underline" calcFunc-under -1 950 )
343 ( "u|" calcFunc-abs -1 0 )
344 ( "|" closing 0 -1 )
345 ( "\\lfloor" calcFunc-floor -1 0 )
346 ( "\\rfloor" closing 0 -1 )
347 ( "\\lceil" calcFunc-ceil -1 0 )
348 ( "\\rceil" closing 0 -1 )
349 ( "\\pm" sdev 300 300 )
350 ( "!" calcFunc-fact 210 -1 )
351 ( "^" ^ 201 200 )
352 ( "_" calcFunc-subscr 201 200 )
353 ( "\\times" * 191 190 )
354 ( "*" * 191 190 )
355 ( "2x" * 191 190 )
356 ( "+" + 180 181 )
357 ( "-" - 180 181 )
358 ( "\\over" / 170 171 )
359 ( "/" / 170 171 )
360 ( "\\choose" calcFunc-choose 170 171 )
361 ( "\\mod" % 170 171 )
362 ( "<" calcFunc-lt 160 161 )
363 ( ">" calcFunc-gt 160 161 )
364 ( "\\leq" calcFunc-leq 160 161 )
365 ( "\\geq" calcFunc-geq 160 161 )
366 ( "=" calcFunc-eq 160 161 )
367 ( "\\neq" calcFunc-neq 160 161 )
368 ( "\\ne" calcFunc-neq 160 161 )
369 ( "\\lnot" calcFunc-lnot -1 121 )
370 ( "\\land" calcFunc-land 110 111 )
371 ( "\\lor" calcFunc-lor 100 101 )
372 ( "?" (math-read-if) 91 90 )
373 ( "!!!" calcFunc-pnot -1 85 )
374 ( "&&&" calcFunc-pand 80 81 )
375 ( "|||" calcFunc-por 75 76 )
376 ( "\\gets" calcFunc-assign 51 50 )
377 ( ":=" calcFunc-assign 51 50 )
378 ( "::" calcFunc-condition 45 46 )
379 ( "\\to" calcFunc-evalto 40 41 )
380 ( "\\to" calcFunc-evalto 40 -1 )
381 ( "=>" calcFunc-evalto 40 41 )
bf77c646 382 ( "=>" calcFunc-evalto 40 -1 )))
136211a9
EZ
383
384(put 'tex 'math-function-table
385 '( ( \\arccos . calcFunc-arccos )
386 ( \\arcsin . calcFunc-arcsin )
387 ( \\arctan . calcFunc-arctan )
388 ( \\arg . calcFunc-arg )
389 ( \\cos . calcFunc-cos )
390 ( \\cosh . calcFunc-cosh )
671dfbd8
JB
391 ( \\cot . calcFunc-cot )
392 ( \\coth . calcFunc-coth )
393 ( \\csc . calcFunc-csc )
136211a9
EZ
394 ( \\det . calcFunc-det )
395 ( \\exp . calcFunc-exp )
396 ( \\gcd . calcFunc-gcd )
397 ( \\ln . calcFunc-ln )
398 ( \\log . calcFunc-log10 )
399 ( \\max . calcFunc-max )
400 ( \\min . calcFunc-min )
671dfbd8 401 ( \\sec . calcFunc-sec )
136211a9
EZ
402 ( \\sin . calcFunc-sin )
403 ( \\sinh . calcFunc-sinh )
404 ( \\sqrt . calcFunc-sqrt )
671dfbd8 405 ( \\tan . calcFunc-tan )
136211a9
EZ
406 ( \\tanh . calcFunc-tanh )
407 ( \\phi . calcFunc-totient )
bf77c646 408 ( \\mu . calcFunc-moebius )))
136211a9
EZ
409
410(put 'tex 'math-variable-table
411 '( ( \\pi . var-pi )
412 ( \\infty . var-inf )
413 ( \\infty . var-uinf )
414 ( \\phi . var-phi )
415 ( \\gamma . var-gamma )
416 ( \\sum . (math-parse-tex-sum calcFunc-sum) )
bf77c646 417 ( \\prod . (math-parse-tex-sum calcFunc-prod) )))
136211a9
EZ
418
419(put 'tex 'math-complex-format 'i)
420
421(defun math-parse-tex-sum (f val)
422 (let (low high save)
54961aa0 423 (or (equal math-expr-data "_") (throw 'syntax "Expected `_'"))
136211a9 424 (math-read-token)
679e2630 425 (setq save math-exp-old-pos)
136211a9
EZ
426 (setq low (math-read-factor))
427 (or (eq (car-safe low) 'calcFunc-eq)
428 (progn
679e2630 429 (setq math-exp-old-pos (1+ save))
136211a9 430 (throw 'syntax "Expected equation")))
54961aa0 431 (or (equal math-expr-data "^") (throw 'syntax "Expected `^'"))
136211a9
EZ
432 (math-read-token)
433 (setq high (math-read-factor))
bf77c646 434 (list (nth 2 f) (math-read-factor) (nth 1 low) (nth 2 low) high)))
136211a9
EZ
435
436(defun math-tex-input-filter (str) ; allow parsing of 123\,456\,789.
437 (while (string-match "[0-9]\\\\,[0-9]" str)
438 (setq str (concat (substring str 0 (1+ (match-beginning 0)))
439 (substring str (1- (match-end 0))))))
bf77c646 440 str)
136211a9
EZ
441(put 'tex 'math-input-filter 'math-tex-input-filter)
442
2d3ce3f2 443(put 'latex 'math-oper-table
62a54f6c
JB
444 (append (get 'tex 'math-oper-table)
445 '(( "\\Hat" calcFunc-Hat -1 950 )
446 ( "\\Check" calcFunc-Check -1 950 )
447 ( "\\Tilde" calcFunc-Tilde -1 950 )
448 ( "\\Acute" calcFunc-Acute -1 950 )
449 ( "\\Grave" calcFunc-Grave -1 950 )
450 ( "\\Dot" calcFunc-Dot -1 950 )
451 ( "\\Ddot" calcFunc-Dotdot -1 950 )
452 ( "\\Breve" calcFunc-Breve -1 950 )
453 ( "\\Bar" calcFunc-Bar -1 950 )
454 ( "\\Vec" calcFunc-VEC -1 950 )
455 ( "\\dddot" calcFunc-dddot -1 950 )
456 ( "\\ddddot" calcFunc-ddddot -1 950 )
457 ( "\div" / 170 171 )
458 ( "\\le" calcFunc-leq 160 161 )
459 ( "\\leqq" calcFunc-leq 160 161 )
460 ( "\\leqsland" calcFunc-leq 160 161 )
461 ( "\\ge" calcFunc-geq 160 161 )
462 ( "\\geqq" calcFunc-geq 160 161 )
463 ( "\\geqslant" calcFunc-geq 160 161 )
464 ( "=" calcFunc-eq 160 161 )
465 ( "\\neq" calcFunc-neq 160 161 )
466 ( "\\ne" calcFunc-neq 160 161 )
467 ( "\\lnot" calcFunc-lnot -1 121 )
468 ( "\\land" calcFunc-land 110 111 )
469 ( "\\lor" calcFunc-lor 100 101 )
470 ( "?" (math-read-if) 91 90 )
471 ( "!!!" calcFunc-pnot -1 85 )
472 ( "&&&" calcFunc-pand 80 81 )
473 ( "|||" calcFunc-por 75 76 )
474 ( "\\gets" calcFunc-assign 51 50 )
475 ( ":=" calcFunc-assign 51 50 )
476 ( "::" calcFunc-condition 45 46 )
477 ( "\\to" calcFunc-evalto 40 41 )
478 ( "\\to" calcFunc-evalto 40 -1 )
479 ( "=>" calcFunc-evalto 40 41 )
480 ( "=>" calcFunc-evalto 40 -1 ))))
2d3ce3f2
JB
481
482(put 'latex 'math-function-table
62a54f6c
JB
483 (append
484 (get 'tex 'math-function-table)
7592e970
JB
485 '(( \\frac . (math-latex-parse-frac))
486 ( \\tfrac . (math-latex-parse-frac))
487 ( \\dfrac . (math-latex-parse-frac))
488 ( \\binom . (math-latex-parse-two-args calcFunc-choose))
489 ( \\tbinom . (math-latex-parse-two-args calcFunc-choose))
490 ( \\dbinom . (math-latex-parse-two-args calcFunc-choose))
62a54f6c
JB
491 ( \\phi . calcFunc-totient )
492 ( \\mu . calcFunc-moebius ))))
2d3ce3f2
JB
493
494(put 'latex 'math-special-function-table
495 '((/ . (math-latex-print-frac "\\frac"))
496 (calcFunc-choose . (math-latex-print-frac "\\binom"))))
497
498(put 'latex 'math-variable-table
62a54f6c 499 (get 'tex 'math-variable-table))
2d3ce3f2
JB
500
501(put 'latex 'math-complex-format 'i)
502
7592e970 503
2d3ce3f2
JB
504(defun math-latex-parse-frac (f val)
505 (let (numer denom)
7592e970
JB
506 (setq numer (car (math-read-expr-list)))
507 (math-read-token)
508 (setq denom (math-read-factor))
509 (if (and (Math-num-integerp numer)
510 (Math-num-integerp denom))
511 (list 'frac numer denom)
512 (list '/ numer denom))))
513
514(defun math-latex-parse-two-args (f val)
515 (let (first second)
516 (setq first (car (math-read-expr-list)))
2d3ce3f2 517 (math-read-token)
7592e970
JB
518 (setq second (math-read-factor))
519 (list (nth 2 f) first second)))
2d3ce3f2
JB
520
521(defun math-latex-print-frac (a fn)
522 (list 'horiz (nth 1 fn) "{" (math-compose-expr (nth 1 a) -1)
523 "}{"
524 (math-compose-expr (nth 2 a) -1)
525 "}"))
526
cfa08316 527(put 'latex 'math-input-filter 'math-tex-input-filter)
136211a9
EZ
528
529(defun calc-eqn-language (n)
530 (interactive "P")
531 (calc-wrapper
532 (calc-set-language 'eqn)
3132f345 533 (message "Eqn language mode")))
136211a9
EZ
534
535(put 'eqn 'math-oper-table
536 '( ( "u+" ident -1 1000 )
537 ( "u-" neg -1 1000 )
538 ( "prime" (math-parse-eqn-prime) 950 -1 )
539 ( "prime" calcFunc-Prime 950 -1 )
540 ( "dot" calcFunc-dot 950 -1 )
541 ( "dotdot" calcFunc-dotdot 950 -1 )
542 ( "hat" calcFunc-hat 950 -1 )
543 ( "tilde" calcFunc-tilde 950 -1 )
544 ( "vec" calcFunc-Vec 950 -1 )
545 ( "dyad" calcFunc-dyad 950 -1 )
546 ( "bar" calcFunc-bar 950 -1 )
547 ( "under" calcFunc-under 950 -1 )
548 ( "sub" calcFunc-subscr 931 930 )
549 ( "sup" ^ 921 920 )
550 ( "sqrt" calcFunc-sqrt -1 910 )
551 ( "over" / 900 901 )
552 ( "u|" calcFunc-abs -1 0 )
553 ( "|" closing 0 -1 )
554 ( "left floor" calcFunc-floor -1 0 )
555 ( "right floor" closing 0 -1 )
556 ( "left ceil" calcFunc-ceil -1 0 )
557 ( "right ceil" closing 0 -1 )
558 ( "+-" sdev 300 300 )
559 ( "!" calcFunc-fact 210 -1 )
560 ( "times" * 191 190 )
561 ( "*" * 191 190 )
562 ( "2x" * 191 190 )
563 ( "/" / 180 181 )
564 ( "%" % 180 181 )
565 ( "+" + 170 171 )
566 ( "-" - 170 171 )
567 ( "<" calcFunc-lt 160 161 )
568 ( ">" calcFunc-gt 160 161 )
569 ( "<=" calcFunc-leq 160 161 )
570 ( ">=" calcFunc-geq 160 161 )
571 ( "=" calcFunc-eq 160 161 )
572 ( "==" calcFunc-eq 160 161 )
573 ( "!=" calcFunc-neq 160 161 )
574 ( "u!" calcFunc-lnot -1 121 )
575 ( "&&" calcFunc-land 110 111 )
576 ( "||" calcFunc-lor 100 101 )
577 ( "?" (math-read-if) 91 90 )
578 ( "!!!" calcFunc-pnot -1 85 )
579 ( "&&&" calcFunc-pand 80 81 )
580 ( "|||" calcFunc-por 75 76 )
581 ( "<-" calcFunc-assign 51 50 )
582 ( ":=" calcFunc-assign 51 50 )
583 ( "::" calcFunc-condition 45 46 )
584 ( "->" calcFunc-evalto 40 41 )
585 ( "->" calcFunc-evalto 40 -1 )
586 ( "=>" calcFunc-evalto 40 41 )
bf77c646 587 ( "=>" calcFunc-evalto 40 -1 )))
136211a9
EZ
588
589(put 'eqn 'math-function-table
590 '( ( arc\ cos . calcFunc-arccos )
591 ( arc\ cosh . calcFunc-arccosh )
592 ( arc\ sin . calcFunc-arcsin )
593 ( arc\ sinh . calcFunc-arcsinh )
594 ( arc\ tan . calcFunc-arctan )
595 ( arc\ tanh . calcFunc-arctanh )
596 ( GAMMA . calcFunc-gamma )
597 ( phi . calcFunc-totient )
598 ( mu . calcFunc-moebius )
bf77c646 599 ( matrix . (math-parse-eqn-matrix) )))
136211a9
EZ
600
601(put 'eqn 'math-variable-table
bf77c646 602 '( ( inf . var-uinf )))
136211a9
EZ
603
604(put 'eqn 'math-complex-format 'i)
605
606(defun math-parse-eqn-matrix (f sym)
607 (let ((vec nil))
54961aa0 608 (while (assoc math-expr-data '(("ccol") ("lcol") ("rcol")))
136211a9 609 (math-read-token)
54961aa0 610 (or (equal math-expr-data calc-function-open)
136211a9
EZ
611 (throw 'syntax "Expected `{'"))
612 (math-read-token)
613 (setq vec (cons (cons 'vec (math-read-expr-list)) vec))
54961aa0 614 (or (equal math-expr-data calc-function-close)
136211a9
EZ
615 (throw 'syntax "Expected `}'"))
616 (math-read-token))
54961aa0 617 (or (equal math-expr-data calc-function-close)
136211a9
EZ
618 (throw 'syntax "Expected `}'"))
619 (math-read-token)
bf77c646 620 (math-transpose (cons 'vec (nreverse vec)))))
136211a9
EZ
621
622(defun math-parse-eqn-prime (x sym)
623 (if (eq (car-safe x) 'var)
54961aa0 624 (if (equal math-expr-data calc-function-open)
136211a9
EZ
625 (progn
626 (math-read-token)
54961aa0 627 (let ((args (if (or (equal math-expr-data calc-function-close)
679e2630 628 (eq math-exp-token 'end))
136211a9
EZ
629 nil
630 (math-read-expr-list))))
54961aa0 631 (if (not (or (equal math-expr-data calc-function-close)
679e2630 632 (eq math-exp-token 'end)))
136211a9
EZ
633 (throw 'syntax "Expected `)'"))
634 (math-read-token)
635 (cons (intern (format "calcFunc-%s'" (nth 1 x))) args)))
636 (list 'var
637 (intern (concat (symbol-name (nth 1 x)) "'"))
638 (intern (concat (symbol-name (nth 2 x)) "'"))))
bf77c646 639 (list 'calcFunc-Prime x)))
136211a9
EZ
640
641
642(defun calc-mathematica-language ()
643 (interactive)
644 (calc-wrapper
645 (calc-set-language 'math)
3132f345 646 (message "Mathematica language mode")))
136211a9
EZ
647
648(put 'math 'math-oper-table
649 '( ( "[[" (math-read-math-subscr) 250 -1 )
650 ( "!" calcFunc-fact 210 -1 )
651 ( "!!" calcFunc-dfact 210 -1 )
652 ( "^" ^ 201 200 )
653 ( "u+" ident -1 197 )
654 ( "u-" neg -1 197 )
655 ( "/" / 195 196 )
656 ( "*" * 190 191 )
657 ( "2x" * 190 191 )
658 ( "+" + 180 181 )
659 ( "-" - 180 181 )
660 ( "<" calcFunc-lt 160 161 )
661 ( ">" calcFunc-gt 160 161 )
662 ( "<=" calcFunc-leq 160 161 )
663 ( ">=" calcFunc-geq 160 161 )
664 ( "==" calcFunc-eq 150 151 )
665 ( "!=" calcFunc-neq 150 151 )
666 ( "u!" calcFunc-lnot -1 121 )
667 ( "&&" calcFunc-land 110 111 )
668 ( "||" calcFunc-lor 100 101 )
669 ( "!!!" calcFunc-pnot -1 85 )
670 ( "&&&" calcFunc-pand 80 81 )
671 ( "|||" calcFunc-por 75 76 )
672 ( ":=" calcFunc-assign 51 50 )
673 ( "=" calcFunc-assign 51 50 )
674 ( "->" calcFunc-assign 51 50 )
675 ( ":>" calcFunc-assign 51 50 )
676 ( "::" calcFunc-condition 45 46 )
677))
678
679(put 'math 'math-function-table
680 '( ( Abs . calcFunc-abs )
681 ( ArcCos . calcFunc-arccos )
682 ( ArcCosh . calcFunc-arccosh )
683 ( ArcSin . calcFunc-arcsin )
684 ( ArcSinh . calcFunc-arcsinh )
685 ( ArcTan . calcFunc-arctan )
686 ( ArcTanh . calcFunc-arctanh )
687 ( Arg . calcFunc-arg )
688 ( Binomial . calcFunc-choose )
689 ( Ceiling . calcFunc-ceil )
690 ( Conjugate . calcFunc-conj )
691 ( Cos . calcFunc-cos )
692 ( Cosh . calcFunc-cosh )
671dfbd8
JB
693 ( Cot . calcFunc-cot )
694 ( Coth . calcFunc-coth )
695 ( Csc . calcFunc-csc )
696 ( Csch . calcFunc-csch )
136211a9
EZ
697 ( D . calcFunc-deriv )
698 ( Dt . calcFunc-tderiv )
699 ( Det . calcFunc-det )
700 ( Exp . calcFunc-exp )
701 ( EulerPhi . calcFunc-totient )
702 ( Floor . calcFunc-floor )
703 ( Gamma . calcFunc-gamma )
704 ( GCD . calcFunc-gcd )
705 ( If . calcFunc-if )
706 ( Im . calcFunc-im )
707 ( Inverse . calcFunc-inv )
708 ( Integrate . calcFunc-integ )
709 ( Join . calcFunc-vconcat )
710 ( LCM . calcFunc-lcm )
711 ( Log . calcFunc-ln )
712 ( Max . calcFunc-max )
713 ( Min . calcFunc-min )
714 ( Mod . calcFunc-mod )
715 ( MoebiusMu . calcFunc-moebius )
716 ( Random . calcFunc-random )
717 ( Round . calcFunc-round )
718 ( Re . calcFunc-re )
671dfbd8
JB
719 ( Sec . calcFunc-sec )
720 ( Sech . calcFunc-sech )
136211a9
EZ
721 ( Sign . calcFunc-sign )
722 ( Sin . calcFunc-sin )
723 ( Sinh . calcFunc-sinh )
724 ( Sqrt . calcFunc-sqrt )
725 ( Tan . calcFunc-tan )
726 ( Tanh . calcFunc-tanh )
727 ( Transpose . calcFunc-trn )
728 ( Length . calcFunc-vlen )
729))
730
731(put 'math 'math-variable-table
732 '( ( I . var-i )
733 ( Pi . var-pi )
734 ( E . var-e )
735 ( GoldenRatio . var-phi )
736 ( EulerGamma . var-gamma )
737 ( Infinity . var-inf )
738 ( ComplexInfinity . var-uinf )
739 ( Indeterminate . var-nan )
740))
741
742(put 'math 'math-vector-brackets "{}")
743(put 'math 'math-complex-format 'I)
744(put 'math 'math-function-open "[")
745(put 'math 'math-function-close "]")
746
747(put 'math 'math-radix-formatter
748 (function (lambda (r s) (format "%d^^%s" r s))))
749
750(defun math-read-math-subscr (x op)
751 (let ((idx (math-read-expr-level 0)))
54961aa0 752 (or (and (equal math-expr-data "]")
136211a9
EZ
753 (progn
754 (math-read-token)
54961aa0 755 (equal math-expr-data "]")))
136211a9
EZ
756 (throw 'syntax "Expected ']]'"))
757 (math-read-token)
bf77c646 758 (list 'calcFunc-subscr x idx)))
136211a9
EZ
759
760
761(defun calc-maple-language ()
762 (interactive)
763 (calc-wrapper
764 (calc-set-language 'maple)
3132f345 765 (message "Maple language mode")))
136211a9
EZ
766
767(put 'maple 'math-oper-table
768 '( ( "matrix" ident -1 300 )
769 ( "MATRIX" ident -1 300 )
770 ( "!" calcFunc-fact 210 -1 )
771 ( "^" ^ 201 200 )
772 ( "**" ^ 201 200 )
773 ( "u+" ident -1 197 )
774 ( "u-" neg -1 197 )
775 ( "/" / 191 192 )
776 ( "*" * 191 192 )
777 ( "intersect" calcFunc-vint 191 192 )
778 ( "+" + 180 181 )
779 ( "-" - 180 181 )
780 ( "union" calcFunc-vunion 180 181 )
781 ( "minus" calcFunc-vdiff 180 181 )
782 ( "mod" % 170 170 )
783 ( ".." (math-read-maple-dots) 165 165 )
784 ( "\\dots" (math-read-maple-dots) 165 165 )
785 ( "<" calcFunc-lt 160 160 )
786 ( ">" calcFunc-gt 160 160 )
787 ( "<=" calcFunc-leq 160 160 )
788 ( ">=" calcFunc-geq 160 160 )
789 ( "=" calcFunc-eq 160 160 )
790 ( "<>" calcFunc-neq 160 160 )
791 ( "not" calcFunc-lnot -1 121 )
792 ( "and" calcFunc-land 110 111 )
793 ( "or" calcFunc-lor 100 101 )
794 ( "!!!" calcFunc-pnot -1 85 )
795 ( "&&&" calcFunc-pand 80 81 )
796 ( "|||" calcFunc-por 75 76 )
797 ( ":=" calcFunc-assign 51 50 )
798 ( "::" calcFunc-condition 45 46 )
799))
800
801(put 'maple 'math-function-table
802 '( ( bernoulli . calcFunc-bern )
803 ( binomial . calcFunc-choose )
804 ( diff . calcFunc-deriv )
805 ( GAMMA . calcFunc-gamma )
806 ( ifactor . calcFunc-prfac )
807 ( igcd . calcFunc-gcd )
808 ( ilcm . calcFunc-lcm )
809 ( int . calcFunc-integ )
810 ( modp . % )
811 ( irem . % )
812 ( iquo . calcFunc-idiv )
813 ( isprime . calcFunc-prime )
814 ( length . calcFunc-vlen )
815 ( member . calcFunc-in )
816 ( crossprod . calcFunc-cross )
817 ( inverse . calcFunc-inv )
818 ( trace . calcFunc-tr )
819 ( transpose . calcFunc-trn )
820 ( vectdim . calcFunc-vlen )
821))
822
823(put 'maple 'math-variable-table
824 '( ( I . var-i )
825 ( Pi . var-pi )
826 ( E . var-e )
827 ( infinity . var-inf )
828 ( infinity . var-uinf )
829 ( infinity . var-nan )
830))
831
832(put 'maple 'math-complex-format 'I)
833
834(defun math-read-maple-dots (x op)
bf77c646 835 (list 'intv 3 x (math-read-expr-level (nth 3 op))))
136211a9
EZ
836
837
8cd2540e
JB
838;; The variable math-read-big-lines is local to math-read-big-expr in
839;; calc-ext.el, but is used by math-read-big-rec, math-read-big-char,
840;; math-read-big-emptyp, math-read-big-error and math-read-big-balance,
841;; which are called (directly and indirectly) by math-read-big-expr.
842;; It is also local to math-read-big-bigp in calc-ext.el, which calls
843;; math-read-big-balance.
844(defvar math-read-big-lines)
845
846;; The variables math-read-big-baseline and math-read-big-h2 are
847;; local to math-read-big-expr in calc-ext.el, but used by
848;; math-read-big-rec.
849(defvar math-read-big-baseline)
850(defvar math-read-big-h2)
851
852;; The variables math-rb-h1, math-rb-h2, math-rb-v1 and math-rb-v2
853;; are local to math-read-big-rec, but are used by math-read-big-char,
854;; math-read-big-emptyp and math-read-big-balance which are called by
855;; math-read-big-rec.
856;; math-rb-h2 is also local to math-read-big-bigp in calc-ext.el,
857;; which calls math-read-big-balance.
858(defvar math-rb-h1)
859(defvar math-rb-h2)
860(defvar math-rb-v1)
861(defvar math-rb-v2)
862
863(defun math-read-big-rec (math-rb-h1 math-rb-v1 math-rb-h2 math-rb-v2
864 &optional baseline prec short)
136211a9
EZ
865 (or prec (setq prec 0))
866
867 ;; Clip whitespace above or below.
8cd2540e
JB
868 (while (and (< math-rb-v1 math-rb-v2)
869 (math-read-big-emptyp math-rb-h1 math-rb-v1 math-rb-h2 (1+ math-rb-v1)))
870 (setq math-rb-v1 (1+ math-rb-v1)))
871 (while (and (< math-rb-v1 math-rb-v2)
872 (math-read-big-emptyp math-rb-h1 (1- math-rb-v2) math-rb-h2 math-rb-v2))
873 (setq math-rb-v2 (1- math-rb-v2)))
136211a9
EZ
874
875 ;; If formula is a single line high, normal parser can handle it.
8cd2540e
JB
876 (if (<= math-rb-v2 (1+ math-rb-v1))
877 (if (or (<= math-rb-v2 math-rb-v1)
878 (> math-rb-h1 (length (setq math-rb-v2
879 (nth math-rb-v1 math-read-big-lines)))))
880 (math-read-big-error math-rb-h1 math-rb-v1)
881 (setq math-read-big-baseline math-rb-v1
882 math-read-big-h2 math-rb-h2
883 math-rb-v2 (nth math-rb-v1 math-read-big-lines)
884 math-rb-h2 (math-read-expr
885 (substring math-rb-v2 math-rb-h1
886 (min math-rb-h2 (length math-rb-v2)))))
887 (if (eq (car-safe math-rb-h2) 'error)
888 (math-read-big-error (+ math-rb-h1 (nth 1 math-rb-h2))
889 math-rb-v1 (nth 2 math-rb-h2))
890 math-rb-h2))
136211a9
EZ
891
892 ;; Clip whitespace at left or right.
8cd2540e
JB
893 (while (and (< math-rb-h1 math-rb-h2)
894 (math-read-big-emptyp math-rb-h1 math-rb-v1 (1+ math-rb-h1) math-rb-v2))
895 (setq math-rb-h1 (1+ math-rb-h1)))
896 (while (and (< math-rb-h1 math-rb-h2)
897 (math-read-big-emptyp (1- math-rb-h2) math-rb-v1 math-rb-h2 math-rb-v2))
898 (setq math-rb-h2 (1- math-rb-h2)))
136211a9
EZ
899
900 ;; Scan to find widest left-justified "----" in the region.
901 (let* ((widest nil)
902 (widest-h2 0)
8cd2540e 903 (lines-v1 (nthcdr math-rb-v1 math-read-big-lines))
136211a9 904 (p lines-v1)
8cd2540e 905 (v math-rb-v1)
136211a9
EZ
906 (other-v nil)
907 other-char line len h)
8cd2540e 908 (while (< v math-rb-v2)
136211a9 909 (setq line (car p)
8cd2540e
JB
910 len (min math-rb-h2 (length line)))
911 (and (< math-rb-h1 len)
912 (/= (aref line math-rb-h1) ?\ )
913 (if (and (= (aref line math-rb-h1) ?\-)
136211a9 914 ;; Make sure it's not a minus sign.
8cd2540e
JB
915 (or (and (< (1+ math-rb-h1) len)
916 (= (aref line (1+ math-rb-h1)) ?\-))
917 (/= (math-read-big-char math-rb-h1 (1- v)) ?\ )
918 (/= (math-read-big-char math-rb-h1 (1+ v)) ?\ )))
136211a9 919 (progn
8cd2540e 920 (setq h math-rb-h1)
136211a9
EZ
921 (while (and (< (setq h (1+ h)) len)
922 (= (aref line h) ?\-)))
923 (if (> h widest-h2)
924 (setq widest v
925 widest-h2 h)))
8cd2540e 926 (or other-v (setq other-v v other-char (aref line math-rb-h1)))))
136211a9
EZ
927 (setq v (1+ v)
928 p (cdr p)))
929
930 (cond ((not (setq v other-v))
8cd2540e 931 (math-read-big-error math-rb-h1 math-rb-v1)) ; Should never happen!
136211a9
EZ
932
933 ;; Quotient.
934 (widest
935 (setq h widest-h2
936 v widest)
8cd2540e
JB
937 (let ((num (math-read-big-rec math-rb-h1 math-rb-v1 h v))
938 (den (math-read-big-rec math-rb-h1 (1+ v) h math-rb-v2)))
136211a9
EZ
939 (setq p (if (and (math-integerp num) (math-integerp den))
940 (math-make-frac num den)
941 (list '/ num den)))))
942
943 ;; Big radical sign.
944 ((= other-char ?\\)
8cd2540e
JB
945 (or (= (math-read-big-char (1+ math-rb-h1) v) ?\|)
946 (math-read-big-error (1+ math-rb-h1) v "Malformed root sign"))
947 (math-read-big-emptyp math-rb-h1 math-rb-v1 (1+ math-rb-h1) v nil t)
948 (while (= (math-read-big-char (1+ math-rb-h1) (setq v (1- v))) ?\|))
949 (or (= (math-read-big-char (setq h (+ math-rb-h1 2)) v) ?\_)
136211a9
EZ
950 (math-read-big-error h v "Malformed root sign"))
951 (while (= (math-read-big-char (setq h (1+ h)) v) ?\_))
8cd2540e
JB
952 (math-read-big-emptyp math-rb-h1 math-rb-v1 (1+ math-rb-h1) v nil t)
953 (math-read-big-emptyp math-rb-h1 (1+ other-v) h math-rb-v2 nil t)
136211a9 954 (setq p (list 'calcFunc-sqrt (math-read-big-rec
8cd2540e 955 (+ math-rb-h1 2) (1+ v)
136211a9 956 h (1+ other-v) baseline))
8cd2540e 957 v math-read-big-baseline))
136211a9
EZ
958
959 ;; Small radical sign.
960 ((and (= other-char ?V)
8cd2540e
JB
961 (= (math-read-big-char (1+ math-rb-h1) (1- v)) ?\_))
962 (setq h (1+ math-rb-h1))
963 (math-read-big-emptyp math-rb-h1 math-rb-v1 h (1- v) nil t)
964 (math-read-big-emptyp math-rb-h1 (1+ v) h math-rb-v2 nil t)
965 (math-read-big-emptyp math-rb-h1 math-rb-v1 (1+ math-rb-h1) v nil t)
136211a9
EZ
966 (while (= (math-read-big-char (setq h (1+ h)) (1- v)) ?\_))
967 (setq p (list 'calcFunc-sqrt (math-read-big-rec
8cd2540e
JB
968 (1+ math-rb-h1) v h (1+ v) t))
969 v math-read-big-baseline))
136211a9
EZ
970
971 ;; Binomial coefficient.
972 ((and (= other-char ?\()
8cd2540e
JB
973 (= (math-read-big-char (1+ math-rb-h1) v) ?\ )
974 (= (string-match "( *)" (nth v math-read-big-lines)
975 math-rb-h1) math-rb-h1))
136211a9 976 (setq h (match-end 0))
8cd2540e
JB
977 (math-read-big-emptyp math-rb-h1 math-rb-v1 (1+ math-rb-h1) v nil t)
978 (math-read-big-emptyp math-rb-h1 (1+ v) (1+ math-rb-h1) math-rb-v2 nil t)
979 (math-read-big-emptyp (1- h) math-rb-v1 h v nil t)
980 (math-read-big-emptyp (1- h) (1+ v) h math-rb-v2 nil t)
136211a9 981 (setq p (list 'calcFunc-choose
8cd2540e
JB
982 (math-read-big-rec (1+ math-rb-h1) math-rb-v1 (1- h) v)
983 (math-read-big-rec (1+ math-rb-h1) (1+ v)
984 (1- h) math-rb-v2))))
136211a9
EZ
985
986 ;; Minus sign.
987 ((= other-char ?\-)
8cd2540e
JB
988 (setq p (list 'neg (math-read-big-rec (1+ math-rb-h1) math-rb-v1
989 math-rb-h2 math-rb-v2 v 250 t))
990 v math-read-big-baseline
991 h math-read-big-h2))
136211a9
EZ
992
993 ;; Parentheses.
994 ((= other-char ?\()
8cd2540e
JB
995 (math-read-big-emptyp math-rb-h1 math-rb-v1 (1+ math-rb-h1) v nil t)
996 (math-read-big-emptyp math-rb-h1 (1+ v) (1+ math-rb-h1) math-rb-v2 nil t)
997 (setq h (math-read-big-balance (1+ math-rb-h1) v "(" t))
998 (math-read-big-emptyp (1- h) math-rb-v1 h v nil t)
999 (math-read-big-emptyp (1- h) (1+ v) h math-rb-v2 nil t)
136211a9
EZ
1000 (let ((sep (math-read-big-char (1- h) v))
1001 hmid)
1002 (if (= sep ?\.)
1003 (setq h (1+ h)))
1004 (if (= sep ?\])
1005 (math-read-big-error (1- h) v "Expected `)'"))
1006 (if (= sep ?\))
8cd2540e
JB
1007 (setq p (math-read-big-rec
1008 (1+ math-rb-h1) math-rb-v1 (1- h) math-rb-v2 v))
136211a9 1009 (setq hmid (math-read-big-balance h v "(")
8cd2540e
JB
1010 p (list p
1011 (math-read-big-rec h math-rb-v1 (1- hmid) math-rb-v2 v))
136211a9
EZ
1012 h hmid)
1013 (cond ((= sep ?\.)
1014 (setq p (cons 'intv (cons (if (= (math-read-big-char
1015 (1- h) v)
1016 ?\))
1017 0 1)
1018 p))))
1019 ((= (math-read-big-char (1- h) v) ?\])
1020 (math-read-big-error (1- h) v "Expected `)'"))
1021 ((= sep ?\,)
1022 (or (and (math-realp (car p)) (math-realp (nth 1 p)))
1023 (math-read-big-error
8cd2540e 1024 math-rb-h1 v "Complex components must be real"))
136211a9
EZ
1025 (setq p (cons 'cplx p)))
1026 ((= sep ?\;)
1027 (or (and (math-realp (car p)) (math-anglep (nth 1 p)))
1028 (math-read-big-error
8cd2540e 1029 math-rb-h1 v "Complex components must be real"))
136211a9
EZ
1030 (setq p (cons 'polar p)))))))
1031
1032 ;; Matrix.
1033 ((and (= other-char ?\[)
8cd2540e 1034 (or (= (math-read-big-char (setq h math-rb-h1) (1+ v)) ?\[)
136211a9
EZ
1035 (= (math-read-big-char (setq h (1+ h)) v) ?\[)
1036 (and (= (math-read-big-char h v) ?\ )
1037 (= (math-read-big-char (setq h (1+ h)) v) ?\[)))
1038 (= (math-read-big-char h (1+ v)) ?\[))
8cd2540e 1039 (math-read-big-emptyp math-rb-h1 math-rb-v1 h v nil t)
136211a9
EZ
1040 (let ((vtop v)
1041 (hleft h)
1042 (hright nil))
1043 (setq p nil)
1044 (while (progn
1045 (setq h (math-read-big-balance (1+ hleft) v "["))
1046 (if hright
1047 (or (= h hright)
1048 (math-read-big-error hright v "Expected `]'"))
1049 (setq hright h))
1050 (setq p (cons (math-read-big-rec
1051 hleft v h (1+ v)) p))
1052 (and (memq (math-read-big-char h v) '(?\ ?\,))
1053 (= (math-read-big-char hleft (1+ v)) ?\[)))
1054 (setq v (1+ v)))
8cd2540e 1055 (or (= hleft math-rb-h1)
136211a9
EZ
1056 (progn
1057 (if (= (math-read-big-char h v) ?\ )
1058 (setq h (1+ h)))
1059 (and (= (math-read-big-char h v) ?\])
1060 (setq h (1+ h))))
1061 (math-read-big-error (1- h) v "Expected `]'"))
1062 (if (= (math-read-big-char h vtop) ?\,)
1063 (setq h (1+ h)))
8cd2540e 1064 (math-read-big-emptyp math-rb-h1 (1+ v) (1- h) math-rb-v2 nil t)
136211a9
EZ
1065 (setq v (+ vtop (/ (- v vtop) 2))
1066 p (cons 'vec (nreverse p)))))
1067
1068 ;; Square brackets.
1069 ((= other-char ?\[)
8cd2540e
JB
1070 (math-read-big-emptyp math-rb-h1 math-rb-v1 (1+ math-rb-h1) v nil t)
1071 (math-read-big-emptyp math-rb-h1 (1+ v) (1+ math-rb-h1) math-rb-v2 nil t)
136211a9 1072 (setq p nil
8cd2540e 1073 h (1+ math-rb-h1))
136211a9
EZ
1074 (while (progn
1075 (setq widest (math-read-big-balance h v "[" t))
8cd2540e
JB
1076 (math-read-big-emptyp (1- h) math-rb-v1 h v nil t)
1077 (math-read-big-emptyp (1- h) (1+ v) h math-rb-v2 nil t)
136211a9 1078 (setq p (cons (math-read-big-rec
8cd2540e 1079 h math-rb-v1 (1- widest) math-rb-v2 v) p)
136211a9
EZ
1080 h widest)
1081 (= (math-read-big-char (1- h) v) ?\,)))
1082 (setq widest (math-read-big-char (1- h) v))
1083 (if (or (memq widest '(?\; ?\)))
1084 (and (eq widest ?\.) (cdr p)))
1085 (math-read-big-error (1- h) v "Expected `]'"))
1086 (if (= widest ?\.)
1087 (setq h (1+ h)
1088 widest (math-read-big-balance h v "[")
8cd2540e
JB
1089 p (nconc p (list (math-read-big-rec
1090 h math-rb-v1 (1- widest) math-rb-v2 v)))
136211a9
EZ
1091 h widest
1092 p (cons 'intv (cons (if (= (math-read-big-char (1- h) v)
1093 ?\])
1094 3 2)
1095 p)))
1096 (setq p (cons 'vec (nreverse p)))))
1097
1098 ;; Date form.
1099 ((= other-char ?\<)
8cd2540e
JB
1100 (setq line (nth v math-read-big-lines))
1101 (string-match ">" line math-rb-h1)
136211a9 1102 (setq h (match-end 0))
8cd2540e
JB
1103 (math-read-big-emptyp math-rb-h1 math-rb-v1 h v nil t)
1104 (math-read-big-emptyp math-rb-h1 (1+ v) h math-rb-v2 nil t)
1105 (setq p (math-read-big-rec math-rb-h1 v h (1+ v) v)))
136211a9
EZ
1106
1107 ;; Variable name or function call.
1108 ((or (and (>= other-char ?a) (<= other-char ?z))
1109 (and (>= other-char ?A) (<= other-char ?Z)))
8cd2540e
JB
1110 (setq line (nth v math-read-big-lines))
1111 (string-match "\\([a-zA-Z'_]+\\) *" line math-rb-h1)
136211a9
EZ
1112 (setq h (match-end 1)
1113 widest (match-end 0)
1114 p (math-match-substring line 1))
8cd2540e
JB
1115 (math-read-big-emptyp math-rb-h1 math-rb-v1 h v nil t)
1116 (math-read-big-emptyp math-rb-h1 (1+ v) h math-rb-v2 nil t)
136211a9
EZ
1117 (if (= (math-read-big-char widest v) ?\()
1118 (progn
1119 (setq line (if (string-match "-" p)
1120 (intern p)
1121 (intern (concat "calcFunc-" p)))
1122 h (1+ widest)
1123 p nil)
8cd2540e
JB
1124 (math-read-big-emptyp widest math-rb-v1 h v nil t)
1125 (math-read-big-emptyp widest (1+ v) h math-rb-v2 nil t)
136211a9
EZ
1126 (while (progn
1127 (setq widest (math-read-big-balance h v "(" t))
8cd2540e
JB
1128 (math-read-big-emptyp (1- h) math-rb-v1 h v nil t)
1129 (math-read-big-emptyp (1- h) (1+ v) h math-rb-v2 nil t)
136211a9 1130 (setq p (cons (math-read-big-rec
8cd2540e 1131 h math-rb-v1 (1- widest) math-rb-v2 v) p)
136211a9
EZ
1132 h widest)
1133 (= (math-read-big-char (1- h) v) ?\,)))
1134 (or (= (math-read-big-char (1- h) v) ?\))
1135 (math-read-big-error (1- h) v "Expected `)'"))
1136 (setq p (cons line (nreverse p))))
1137 (setq p (list 'var
1138 (intern (math-remove-dashes p))
1139 (if (string-match "-" p)
1140 (intern p)
1141 (intern (concat "var-" p)))))))
1142
1143 ;; Number.
1144 (t
8cd2540e
JB
1145 (setq line (nth v math-read-big-lines))
1146 (or (= (string-match "_?\\([0-9]+.?0*@ *\\)?\\([0-9]+.?0*' *\\)?\\([0-9]+\\(#\\|\\^\\^\\)[0-9a-zA-Z:]+\\|[0-9]+:[0-9:]+\\|[0-9.]+\\([eE][-+_]?[0-9]+\\)?\"?\\)?" line math-rb-h1) math-rb-h1)
136211a9
EZ
1147 (math-read-big-error h v "Expected a number"))
1148 (setq h (match-end 0)
1149 p (math-read-number (math-match-substring line 0)))
8cd2540e
JB
1150 (math-read-big-emptyp math-rb-h1 math-rb-v1 h v nil t)
1151 (math-read-big-emptyp math-rb-h1 (1+ v) h math-rb-v2 nil t)))
136211a9 1152
8cd2540e
JB
1153 ;; Now left term is bounded by math-rb-h1, math-rb-v1, h, math-rb-v2;
1154 ;; baseline = v.
136211a9
EZ
1155 (if baseline
1156 (or (= v baseline)
8cd2540e 1157 (math-read-big-error math-rb-h1 v "Inconsistent baseline in formula"))
136211a9
EZ
1158 (setq baseline v))
1159
1160 ;; Look for superscripts or subscripts.
8cd2540e
JB
1161 (setq line (nth baseline math-read-big-lines)
1162 len (min math-rb-h2 (length line))
136211a9
EZ
1163 widest h)
1164 (while (and (< widest len)
1165 (= (aref line widest) ?\ ))
1166 (setq widest (1+ widest)))
8cd2540e
JB
1167 (and (>= widest len) (setq widest math-rb-h2))
1168 (if (math-read-big-emptyp h v widest math-rb-v2)
1169 (if (math-read-big-emptyp h math-rb-v1 widest v)
136211a9 1170 (setq h widest)
8cd2540e 1171 (setq p (list '^ p (math-read-big-rec h math-rb-v1 widest v))
136211a9 1172 h widest))
8cd2540e 1173 (if (math-read-big-emptyp h math-rb-v1 widest v)
136211a9 1174 (setq p (list 'calcFunc-subscr p
8cd2540e 1175 (math-read-big-rec h v widest math-rb-v2))
136211a9
EZ
1176 h widest)))
1177
1178 ;; Look for an operator name and grab additional terms.
1179 (while (and (< h len)
1180 (if (setq widest (and (math-read-big-emptyp
8cd2540e 1181 h math-rb-v1 (1+ h) v)
136211a9 1182 (math-read-big-emptyp
8cd2540e 1183 h (1+ v) (1+ h) math-rb-v2)
136211a9
EZ
1184 (string-match "<=\\|>=\\|\\+/-\\|!=\\|&&\\|||\\|:=\\|=>\\|." line h)
1185 (assoc (math-match-substring line 0)
1186 math-standard-opers)))
1187 (and (>= (nth 2 widest) prec)
1188 (setq h (match-end 0)))
1189 (and (not (eq (string-match ",\\|;\\|\\.\\.\\|)\\|\\]\\|:" line h)
1190 h))
1191 (setq widest '("2x" * 196 195)))))
1192 (cond ((eq (nth 3 widest) -1)
1193 (setq p (list (nth 1 widest) p)))
1194 ((equal (car widest) "?")
8cd2540e
JB
1195 (let ((y (math-read-big-rec h math-rb-v1 math-rb-h2
1196 math-rb-v2 baseline nil t)))
1197 (or (= (math-read-big-char math-read-big-h2 baseline) ?\:)
1198 (math-read-big-error math-read-big-h2 baseline "Expected `:'"))
136211a9 1199 (setq p (list (nth 1 widest) p y
8cd2540e
JB
1200 (math-read-big-rec
1201 (1+ math-read-big-h2) math-rb-v1 math-rb-h2 math-rb-v2
1202 baseline (nth 3 widest) t))
1203 h math-read-big-h2)))
136211a9
EZ
1204 (t
1205 (setq p (list (nth 1 widest) p
8cd2540e 1206 (math-read-big-rec h math-rb-v1 math-rb-h2 math-rb-v2
136211a9 1207 baseline (nth 3 widest) t))
8cd2540e 1208 h math-read-big-h2))))
136211a9
EZ
1209
1210 ;; Return all relevant information to caller.
8cd2540e
JB
1211 (setq math-read-big-baseline baseline
1212 math-read-big-h2 h)
1213 (or short (= math-read-big-h2 math-rb-h2)
136211a9 1214 (math-read-big-error h baseline))
bf77c646 1215 p)))
136211a9
EZ
1216
1217(defun math-read-big-char (h v)
8cd2540e
JB
1218 (or (and (>= h math-rb-h1)
1219 (< h math-rb-h2)
1220 (>= v math-rb-v1)
1221 (< v math-rb-v2)
1222 (let ((line (nth v math-read-big-lines)))
136211a9
EZ
1223 (and line
1224 (< h (length line))
1225 (aref line h))))
bf77c646 1226 ?\ ))
136211a9
EZ
1227
1228(defun math-read-big-emptyp (eh1 ev1 eh2 ev2 &optional what error)
8cd2540e
JB
1229 (and (< ev1 math-rb-v1) (setq ev1 math-rb-v1))
1230 (and (< eh1 math-rb-h1) (setq eh1 math-rb-h1))
1231 (and (> ev2 math-rb-v2) (setq ev2 math-rb-v2))
1232 (and (> eh2 math-rb-h2) (setq eh2 math-rb-h2))
136211a9 1233 (or what (setq what ?\ ))
8cd2540e 1234 (let ((p (nthcdr ev1 math-read-big-lines))
136211a9
EZ
1235 h)
1236 (while (and (< ev1 ev2)
1237 (progn
1238 (setq h (min eh2 (length (car p))))
1239 (while (and (>= (setq h (1- h)) eh1)
1240 (= (aref (car p) h) what)))
1241 (and error (>= h eh1)
1242 (math-read-big-error h ev1 (if (stringp error)
1243 error
1244 "Whitespace expected")))
1245 (< h eh1)))
1246 (setq ev1 (1+ ev1)
1247 p (cdr p)))
bf77c646 1248 (>= ev1 ev2)))
136211a9 1249
8cd2540e
JB
1250;; math-read-big-err-msg is local to math-read-big-expr in calc-ext.el,
1251;; but is used by math-read-big-error which is called (indirectly) by
1252;; math-read-big-expr.
1253(defvar math-read-big-err-msg)
1254
136211a9
EZ
1255(defun math-read-big-error (h v &optional msg)
1256 (let ((pos 0)
8cd2540e 1257 (p math-read-big-lines))
136211a9
EZ
1258 (while (> v 0)
1259 (setq pos (+ pos 1 (length (car p)))
1260 p (cdr p)
1261 v (1- v)))
1262 (setq h (+ pos (min h (length (car p))))
8cd2540e 1263 math-read-big-err-msg (list 'error h (or msg "Syntax error")))
bf77c646 1264 (throw 'syntax nil)))
136211a9
EZ
1265
1266(defun math-read-big-balance (h v what &optional commas)
8cd2540e
JB
1267 (let* ((line (nth v math-read-big-lines))
1268 (len (min math-rb-h2 (length line)))
136211a9
EZ
1269 (count 1))
1270 (while (> count 0)
1271 (if (>= h len)
1272 (if what
8cd2540e 1273 (math-read-big-error nil v (format "Unmatched `%s'" what))
136211a9
EZ
1274 (setq count 0))
1275 (if (memq (aref line h) '(?\( ?\[))
1276 (setq count (1+ count))
1277 (if (if (and commas (= count 1))
1278 (or (memq (aref line h) '(?\) ?\] ?\, ?\;))
1279 (and (eq (aref line h) ?\.)
1280 (< (1+ h) len)
1281 (eq (aref line (1+ h)) ?\.)))
1282 (memq (aref line h) '(?\) ?\])))
1283 (setq count (1- count))))
1284 (setq h (1+ h))))
bf77c646 1285 h))
136211a9 1286
4b37638f
JB
1287(provide 'calc-lang)
1288
ab5796a9 1289;;; arch-tag: 483bfe15-f290-4fef-bb7d-ce65be687f2e
bf77c646 1290;;; calc-lang.el ends here