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