Mercurial > emacs
annotate lisp/calc/calc-lang.el @ 50507:110c0e29159c
Handle multiple desktop files in different dirs.
Other cleanups.
Command line option --no-desktop introduced.
(desktop-read): Record buffers in the desktop file in
the same order as that in the buffer list,
(desktop-save): Put buffers in the order given in desktop file,
regardless of what handlers do.
(desktop-file-version): New variable. Version number of desktop
file format.
(desktop-create-buffer-form): Variable deleted.
(desktop-save): New customizable variable.
(desktop-kill): Changed to use `desktop-save'.
(desktop-file-name-format): New option: format in
which desktop file names should be saved.
(desktop-file-name): New function to convert a filename to the
format specified in `desktop-file-name-format'.
(desktop-create-buffer): Parameters renamed to descriptive
systematic names. These parameters are visible to handlers.
Renames:
ver -> desktop-file-version
mim -> desktop-buffer-minor-modes
pt -> desktop-buffer-point
mk -> desktop-buffer-mark
ro -> desktop-buffer-read-only
locals -> desktop-buffer-locals
(desktop-buffer-major-mode, desktop-buffer-file-name)
(desktop-buffer-name): Unused customizable variables deleted.
(desktop-buffer-misc): Unused variable deleted.
(desktop-save, desktop-buffer-dired-misc-data):
Use `desktop-file-name'.
(desktop-path): New customizable variable. List of directories in
which to lookup the desktop file. Replaces hardcoded list.
(desktop-globals-to-clear): New variable replaces hardcoded list.
(desktop-clear-preserve-buffers-regexp): New customizable variable.
(desktop-after-read-hook): New hook run after a desktop is read.
(desktop-no-desktop-file-hook): New hook when no desktop file found.
(desktop-change-dir): New function.
(desktop-save-in-load-dir): New function. Save desktop in
directory from witch it was loaded.
(desktop-revert): New function. Revert to the last loaded desktop.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Wed, 09 Apr 2003 01:37:56 +0000 |
parents | 0d8b17d428b5 |
children | 695cf19ef79e d7ddb3e565de |
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> |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49263
diff
changeset
|
6 ;; Maintainers: D. Goel <deego@gnufans.org> |
49263
f4d68f97221e
Add new maintainer (deego).
Deepak Goel <deego@gnufans.org>
parents:
41271
diff
changeset
|
7 ;; Colin Walters <walters@debian.org> |
40785 | 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 | |
41271
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
26 ;;; Commentary: |
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
27 |
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
28 ;;; Code: |
40785 | 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) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
56 (list lang option) t))) |
40785 | 57 |
58 (defun calc-normal-language () | |
59 (interactive) | |
60 (calc-wrapper | |
61 (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
|
62 (message "Normal language mode"))) |
40785 | 63 |
64 (defun calc-flat-language () | |
65 (interactive) | |
66 (calc-wrapper | |
67 (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
|
68 (message "Flat language mode (all stack entries shown on one line)"))) |
40785 | 69 |
70 (defun calc-big-language () | |
71 (interactive) | |
72 (calc-wrapper | |
73 (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
|
74 (message "\"Big\" language mode"))) |
40785 | 75 |
76 (defun calc-unformatted-language () | |
77 (interactive) | |
78 (calc-wrapper | |
79 (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
|
80 (message "Unformatted language mode"))) |
40785 | 81 |
82 | |
83 (defun calc-c-language () | |
84 (interactive) | |
85 (calc-wrapper | |
86 (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
|
87 (message "`C' language mode"))) |
40785 | 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 ) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
118 ( "::" calcFunc-condition 45 46 ))) ; should support full assignments |
40785 | 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 ) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
127 ( atanh . calcFunc-arctanh ))) |
40785 | 128 |
129 (put 'c 'math-variable-table | |
130 '( ( M_PI . var-pi ) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
131 ( M_E . var-e ))) |
40785 | 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) | |
41271
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 uppercase)" |
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 (all lowercase)") |
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
151 "Pascal language mode")))) |
40785 | 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 ) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
179 ( "::" calcFunc-condition 45 46 ))) |
40785 | 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 | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
193 (downcase str)))) |
40785 | 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 | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
201 (downcase str)))) |
40785 | 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) | |
41271
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 uppercase)" |
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 (all lowercase)") |
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
213 "FORTRAN language mode")))) |
40785 | 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 ) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
239 ( "::" calcFunc-condition 45 46 ))) |
40785 | 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 ) | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49263
diff
changeset
|
256 ( real . calcFunc-re ))) |
40785 | 257 |
258 (put 'fortran 'math-input-filter 'calc-input-case-filter) | |
259 (put 'fortran 'math-output-filter 'calc-output-case-filter) | |
260 | |
41271
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
261 (defvar math-parsing-fortran-vector nil) |
40785 | 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) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
267 exp-data (cdr math-parsing-fortran-vector))))) |
40785 | 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) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
276 (throw 'syntax "Unmatched closing `/'"))) |
40785 | 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))) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
283 sym) |
40785 | 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) | |
41271
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 \\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
|
294 "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
|
295 "TeX language mode")))) |
40785 | 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 ) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
350 ( "=>" calcFunc-evalto 40 -1 ))) |
40785 | 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 ) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
372 ( \\mu . calcFunc-moebius ))) |
40785 | 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) ) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
381 ( \\prod . (math-parse-tex-sum calcFunc-prod) ))) |
40785 | 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)) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
398 (list (nth 2 f) (math-read-factor) (nth 1 low) (nth 2 low) high))) |
40785 | 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)))))) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
404 str) |
40785 | 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) | |
41271
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
412 (message "Eqn language mode"))) |
40785 | 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 ) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
466 ( "=>" calcFunc-evalto 40 -1 ))) |
40785 | 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 ) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
478 ( matrix . (math-parse-eqn-matrix) ))) |
40785 | 479 |
480 (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
|
481 '( ( inf . var-uinf ))) |
40785 | 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) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
499 (math-transpose (cons 'vec (nreverse vec))))) |
40785 | 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)) "'")))) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
518 (list 'calcFunc-Prime x))) |
40785 | 519 |
520 | |
521 (defun calc-mathematica-language () | |
522 (interactive) | |
523 (calc-wrapper | |
524 (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
|
525 (message "Mathematica language mode"))) |
40785 | 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) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
631 (list 'calcFunc-subscr x idx))) |
40785 | 632 |
633 | |
634 (defun calc-maple-language () | |
635 (interactive) | |
636 (calc-wrapper | |
637 (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
|
638 (message "Maple language mode"))) |
40785 | 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) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
708 (list 'intv 3 x (math-read-expr-level (nth 3 op)))) |
40785 | 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)) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
1049 p))) |
40785 | 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)))) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
1060 ?\ )) |
40785 | 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))) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
1082 (>= ev1 ev2))) |
40785 | 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"))) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
1093 (throw 'syntax nil))) |
40785 | 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)))) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
1114 h)) |
40785 | 1115 |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
1116 ;;; calc-lang.el ends here |