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