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