?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
Port various comments from new VC to reduce the noise in the diff.
[emacs.git] / lisp / calc / calc-aent.el
blobffd07bd8f2efc96546003f62b4efd426e44a60b9
1 ;;; calc-aent.el --- algebraic entry functions for Calc
2
3 ;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004,
4 ;; 2005, 2006, 2007 Free Software Foundation, Inc.
5
6 ;; Author: Dave Gillespie <daveg@synaptics.com>
7 ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
8
9 ;; This file is part of GNU Emacs.
10
11 ;; GNU Emacs is free software; you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 3, or (at your option)
14 ;; any later version.
15
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
20
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
24 ;; Boston, MA 02110-1301, USA.
25
26 ;;; Commentary:
27
28 ;;; Code:
29
30 ;; This file is autoloaded from calc.el.
31
32 (require 'calc)
33 (require 'calc-macs)
34
35 (defvar calc-quick-calc-history nil
36 "The history list for quick-calc.")
37
38 (defun calc-do-quick-calc ()
39 (require 'calc-ext)
40 (calc-check-defines)
41 (if (eq major-mode 'calc-mode)
42 (calc-algebraic-entry t)
43 (let (buf shortbuf)
44 (save-excursion
45 (calc-create-buffer)
46 (let* ((calc-command-flags nil)
47 (calc-dollar-values calc-quick-prev-results)
48 (calc-dollar-used 0)
49 (enable-recursive-minibuffers t)
50 (calc-language (if (memq calc-language '(nil big))
51 'flat calc-language))
52 (entry (calc-do-alg-entry "" "Quick calc: " t 'calc-quick-calc-history))
53 (alg-exp (mapcar 'math-evaluate-expr entry)))
54 (when (and (= (length alg-exp) 1)
55 (eq (car-safe (car alg-exp)) 'calcFunc-assign)
56 (= (length (car alg-exp)) 3)
57 (eq (car-safe (nth 1 (car alg-exp))) 'var))
58 (set (nth 2 (nth 1 (car alg-exp))) (nth 2 (car alg-exp)))
59 (calc-refresh-evaltos (nth 2 (nth 1 (car alg-exp))))
60 (setq alg-exp (list (nth 2 (car alg-exp)))))
61 (setq calc-quick-prev-results alg-exp
62 buf (mapconcat (function (lambda (x)
63 (math-format-value x 1000)))
64 alg-exp
65 " ")
66 shortbuf buf)
67 (if (and (= (length alg-exp) 1)
68 (memq (car-safe (car alg-exp)) '(nil bigpos bigneg))
69 (< (length buf) 20)
70 (= calc-number-radix 10))
71 (setq buf (concat buf " ("
72 (let ((calc-number-radix 16))
73 (math-format-value (car alg-exp) 1000))
74 ", "
75 (let ((calc-number-radix 8))
76 (math-format-value (car alg-exp) 1000))
77 ", "
78 (let ((calc-number-radix 2))
79 (math-format-value (car alg-exp) 1000))
80 (if (and (integerp (car alg-exp))
81 (> (car alg-exp) 0)
82 (< (car alg-exp) 127))
83 (format ", \"%c\"" (car alg-exp))
84 "")
85 ")")))
86 (if (and (< (length buf) (frame-width)) (= (length entry) 1)
87 (featurep 'calc-ext))
88 (let ((long (concat (math-format-value (car entry) 1000)
89 " => " buf)))
90 (if (<= (length long) (- (frame-width) 8))
91 (setq buf long))))
92 (calc-handle-whys)
93 (message "Result: %s" buf)))
94 (if (eq last-command-char 10)
95 (insert shortbuf)
96 (kill-new shortbuf)))))
97
98 (defun calc-do-calc-eval (str separator args)
99 (calc-check-defines)
100 (catch 'calc-error
101 (save-excursion
102 (calc-create-buffer)
103 (cond
104 ((and (consp str) (not (symbolp (car str))))
105 (let ((calc-language nil)
106 (math-expr-opers (math-standard-ops))
107 (calc-internal-prec 12)
108 (calc-word-size 32)
109 (calc-symbolic-mode nil)
110 (calc-matrix-mode nil)
111 (calc-angle-mode 'deg)
112 (calc-number-radix 10)
113 (calc-leading-zeros nil)
114 (calc-group-digits nil)
115 (calc-point-char ".")
116 (calc-frac-format '(":" nil))
117 (calc-prefer-frac nil)
118 (calc-hms-format "%s@ %s' %s\"")
119 (calc-date-format '((H ":" mm C SS pp " ")
120 Www " " Mmm " " D ", " YYYY))
121 (calc-float-format '(float 0))
122 (calc-full-float-format '(float 0))
123 (calc-complex-format nil)
124 (calc-matrix-just nil)
125 (calc-full-vectors t)
126 (calc-break-vectors nil)
127 (calc-vector-commas ",")
128 (calc-vector-brackets "[]")
129 (calc-matrix-brackets '(R O))
130 (calc-complex-mode 'cplx)
131 (calc-infinite-mode nil)
132 (calc-display-strings nil)
133 (calc-simplify-mode nil)
134 (calc-display-working-message 'lots)
135 (strp (cdr str)))
136 (while strp
137 (set (car strp) (nth 1 strp))
138 (setq strp (cdr (cdr strp))))
139 (calc-do-calc-eval (car str) separator args)))
140 ((eq separator 'eval)
141 (eval str))
142 ((eq separator 'macro)
143 (require 'calc-ext)
144 (let* ((calc-buffer (current-buffer))
145 (calc-window (get-buffer-window calc-buffer))
146 (save-window (selected-window)))
147 (if calc-window
148 (unwind-protect
149 (progn
150 (select-window calc-window)
151 (calc-execute-kbd-macro str nil (car args)))
152 (and (window-point save-window)
153 (select-window save-window)))
154 (save-window-excursion
155 (select-window (get-largest-window))
156 (switch-to-buffer calc-buffer)
157 (calc-execute-kbd-macro str nil (car args)))))
158 nil)
159 ((eq separator 'pop)
160 (or (not (integerp str))
161 (= str 0)
162 (calc-pop (min str (calc-stack-size))))
163 (calc-stack-size))
164 ((eq separator 'top)
165 (and (integerp str)
166 (> str 0)
167 (<= str (calc-stack-size))
168 (math-format-value (calc-top-n str (car args)) 1000)))
169 ((eq separator 'rawtop)
170 (and (integerp str)
171 (> str 0)
172 (<= str (calc-stack-size))
173 (calc-top-n str (car args))))
174 (t
175 (let* ((calc-command-flags nil)
176 (calc-next-why nil)
177 (calc-language (if (memq calc-language '(nil big))
178 'flat calc-language))
179 (calc-dollar-values (mapcar
180 (function
181 (lambda (x)
182 (if (stringp x)
183 (progn
184 (setq x (math-read-exprs x))
185 (if (eq (car-safe x)
186 'error)
187 (throw 'calc-error
188 (calc-eval-error
189 (cdr x)))
190 (car x)))
191 x)))
192 args))
193 (calc-dollar-used 0)
194 (res (if (stringp str)
195 (math-read-exprs str)
196 (list str)))
197 buf)
198 (if (eq (car res) 'error)
199 (calc-eval-error (cdr res))
200 (setq res (mapcar 'calc-normalize res))
201 (and (memq 'clear-message calc-command-flags)
202 (message ""))
203 (cond ((eq separator 'pred)
204 (require 'calc-ext)
205 (if (= (length res) 1)
206 (math-is-true (car res))
207 (calc-eval-error '(0 "Single value expected"))))
208 ((eq separator 'raw)
209 (if (= (length res) 1)
210 (car res)
211 (calc-eval-error '(0 "Single value expected"))))
212 ((eq separator 'list)
213 res)
214 ((memq separator '(num rawnum))
215 (if (= (length res) 1)
216 (if (math-constp (car res))
217 (if (eq separator 'num)
218 (math-format-value (car res) 1000)
219 (car res))
220 (calc-eval-error
221 (list 0
222 (if calc-next-why
223 (calc-explain-why (car calc-next-why))
224 "Number expected"))))
225 (calc-eval-error '(0 "Single value expected"))))
226 ((eq separator 'push)
227 (calc-push-list res)
228 nil)
229 (t (while res
230 (setq buf (concat buf
231 (and buf (or separator ", "))
232 (math-format-value (car res) 1000))
233 res (cdr res)))
234 buf)))))))))
235
236 (defvar calc-eval-error nil
237 "Determines how calc handles errors.
238 If nil, return a list containing the character position of error.
239 STRING means return error message as string rather than list.
240 The value t means abort and give an error message.")
241
242 (defun calc-eval-error (msg)
243 (if calc-eval-error
244 (if (eq calc-eval-error 'string)
245 (nth 1 msg)
246 (error "%s" (nth 1 msg)))
247 msg))
248
249
250 ;;;; Reading an expression in algebraic form.
251
252 (defun calc-auto-algebraic-entry (&optional prefix)
253 (interactive "P")
254 (calc-algebraic-entry prefix t))
255
256 (defun calc-algebraic-entry (&optional prefix auto)
257 (interactive "P")
258 (calc-wrapper
259 (let ((calc-language (if prefix nil calc-language))
260 (math-expr-opers (if prefix (math-standard-ops) (math-expr-ops))))
261 (calc-alg-entry (and auto (char-to-string last-command-char))))))
262
263 (defvar calc-alg-entry-history nil
264 "History for algebraic entry.")
265
266 (defun calc-alg-entry (&optional initial prompt)
267 (let* ((sel-mode nil)
268 (calc-dollar-values (mapcar 'calc-get-stack-element
269 (nthcdr calc-stack-top calc-stack)))
270 (calc-dollar-used 0)
271 (calc-plain-entry t)
272 (alg-exp (calc-do-alg-entry initial prompt t 'calc-alg-entry-history)))
273 (if (stringp alg-exp)
274 (progn
275 (require 'calc-ext)
276 (calc-alg-edit alg-exp))
277 (let* ((calc-simplify-mode (if (eq last-command-char ?\C-j)
278 'none
279 calc-simplify-mode))
280 (nvals (mapcar 'calc-normalize alg-exp)))
281 (while alg-exp
282 (calc-record (if (featurep 'calc-ext) (car alg-exp) (car nvals))
283 "alg'")
284 (calc-pop-push-record-list calc-dollar-used
285 (and (not (equal (car alg-exp)
286 (car nvals)))
287 (featurep 'calc-ext)
288 "")
289 (list (car nvals)))
290 (setq alg-exp (cdr alg-exp)
291 nvals (cdr nvals)
292 calc-dollar-used 0)))
293 (calc-handle-whys))))
294
295 (defvar calc-alg-ent-map nil
296 "The keymap used for algebraic entry.")
297
298 (defvar calc-alg-ent-esc-map nil
299 "The keymap used for escapes in algebraic entry.")
300
301 (defvar calc-alg-exp)
302
303 (defun calc-do-alg-entry (&optional initial prompt no-normalize history)
304 (let* ((calc-buffer (current-buffer))
305 (blink-paren-function 'calcAlg-blink-matching-open)
306 (calc-alg-exp 'error))
307 (unless calc-alg-ent-map
308 (setq calc-alg-ent-map (copy-keymap minibuffer-local-map))
309 (define-key calc-alg-ent-map "'" 'calcAlg-previous)
310 (define-key calc-alg-ent-map "`" 'calcAlg-edit)
311 (define-key calc-alg-ent-map "\C-m" 'calcAlg-enter)
312 (define-key calc-alg-ent-map "\C-j" 'calcAlg-enter)
313 (let ((i 33))
314 (setq calc-alg-ent-esc-map (copy-keymap esc-map))
315 (while (< i 127)
316 (aset (nth 1 calc-alg-ent-esc-map) i 'calcAlg-escape)
317 (setq i (1+ i)))))
318 (define-key calc-alg-ent-map "\e" nil)
319 (if (eq calc-algebraic-mode 'total)
320 (define-key calc-alg-ent-map "\e" calc-alg-ent-esc-map)
321 (define-key calc-alg-ent-map "\e+" 'calcAlg-plus-minus)
322 (define-key calc-alg-ent-map "\em" 'calcAlg-mod)
323 (define-key calc-alg-ent-map "\e=" 'calcAlg-equals)
324 (define-key calc-alg-ent-map "\e\r" 'calcAlg-equals)
325 (define-key calc-alg-ent-map "\ep" 'previous-history-element)
326 (define-key calc-alg-ent-map "\en" 'next-history-element)
327 (define-key calc-alg-ent-map "\e%" 'self-insert-command))
328 (setq calc-aborted-prefix nil)
329 (let ((buf (read-from-minibuffer (or prompt "Algebraic: ")
330 (or initial "")
331 calc-alg-ent-map nil history)))
332 (when (eq calc-alg-exp 'error)
333 (when (eq (car-safe (setq calc-alg-exp (math-read-exprs buf))) 'error)
334 (setq calc-alg-exp nil)))
335 (setq calc-aborted-prefix "alg'")
336 (or no-normalize
337 (and calc-alg-exp (setq calc-alg-exp (mapcar 'calc-normalize calc-alg-exp))))
338 calc-alg-exp)))
339
340 (defun calcAlg-plus-minus ()
341 (interactive)
342 (if (calc-minibuffer-contains ".* \\'")
343 (insert "+/- ")
344 (insert " +/- ")))
345
346 (defun calcAlg-mod ()
347 (interactive)
348 (if (not (calc-minibuffer-contains ".* \\'"))
349 (insert " "))
350 (if (calc-minibuffer-contains ".* mod +\\'")
351 (if calc-previous-modulo
352 (insert (math-format-flat-expr calc-previous-modulo 0))
353 (beep))
354 (insert "mod ")))
355
356 (defun calcAlg-previous ()
357 (interactive)
358 (if (calc-minibuffer-contains "\\'")
359 (previous-history-element 1)
360 (insert "'")))
361
362 (defun calcAlg-equals ()
363 (interactive)
364 (unwind-protect
365 (calcAlg-enter)
366 (if (consp calc-alg-exp)
367 (progn (setq prefix-arg (length calc-alg-exp))
368 (calc-unread-command ?=)))))
369
370 (defun calcAlg-escape ()
371 (interactive)
372 (calc-unread-command)
373 (save-excursion
374 (calc-select-buffer)
375 (use-local-map calc-mode-map))
376 (calcAlg-enter))
377
378 (defvar calc-plain-entry nil)
379 (defun calcAlg-edit ()
380 (interactive)
381 (if (or (not calc-plain-entry)
382 (calc-minibuffer-contains
383 "\\`\\([^\"]*\"[^\"]*\"\\)*[^\"]*\"[^\"]*\\'"))
384 (insert "`")
385 (setq calc-alg-exp (minibuffer-contents))
386 (exit-minibuffer)))
387
388 (defvar calc-buffer)
389
390 (defun calcAlg-enter ()
391 (interactive)
392 (let* ((str (minibuffer-contents))
393 (exp (and (> (length str) 0)
394 (save-excursion
395 (set-buffer calc-buffer)
396 (math-read-exprs str)))))
397 (if (eq (car-safe exp) 'error)
398 (progn
399 (goto-char (minibuffer-prompt-end))
400 (forward-char (nth 1 exp))
401 (beep)
402 (calc-temp-minibuffer-message
403 (concat " [" (or (nth 2 exp) "Error") "]"))
404 (calc-clear-unread-commands))
405 (setq calc-alg-exp (if (calc-minibuffer-contains "\\` *\\[ *\\'")
406 '((incomplete vec))
407 exp))
408 (exit-minibuffer))))
409
410 (defun calcAlg-blink-matching-open ()
411 (let ((rightpt (point))
412 (leftpt nil)
413 (rightchar (preceding-char))
414 leftchar
415 rightsyntax
416 leftsyntax)
417 (save-excursion
418 (condition-case ()
419 (setq leftpt (scan-sexps rightpt -1)
420 leftchar (char-after leftpt))
421 (error nil)))
422 (if (and leftpt
423 (or (and (= rightchar ?\))
424 (= leftchar ?\[))
425 (and (= rightchar ?\])
426 (= leftchar ?\()))
427 (save-excursion
428 (goto-char leftpt)
429 (looking-at ".+\\(\\.\\.\\|\\\\dots\\|\\\\ldots\\)")))
430 (let ((leftsaved (aref (syntax-table) leftchar))
431 (rightsaved (aref (syntax-table) rightchar)))
432 (unwind-protect
433 (progn
434 (cond ((= leftchar ?\[)
435 (aset (syntax-table) leftchar (cons 4 ?\)))
436 (aset (syntax-table) rightchar (cons 5 ?\[)))
437 (t
438 (aset (syntax-table) leftchar (cons 4 ?\]))
439 (aset (syntax-table) rightchar (cons 5 ?\())))
440 (blink-matching-open))
441 (aset (syntax-table) leftchar leftsaved)
442 (aset (syntax-table) rightchar rightsaved)))
443 (blink-matching-open))))
444
445 (defun calc-alg-digit-entry ()
446 (calc-alg-entry
447 (cond ((eq last-command-char ?e)
448 (if (> calc-number-radix 14) (format "%d.^" calc-number-radix) "1e"))
449 ((eq last-command-char ?#) (format "%d#" calc-number-radix))
450 ((eq last-command-char ?_) "-")
451 ((eq last-command-char ?@) "0@ ")
452 (t (char-to-string last-command-char)))))
453
454 ;; The variable calc-digit-value is initially declared in calc.el,
455 ;; but can be set by calcDigit-algebraic and calcDigit-edit.
456 (defvar calc-digit-value)
457
458 (defun calcDigit-algebraic ()
459 (interactive)
460 (if (calc-minibuffer-contains ".*[@oh] *[^'m ]+[^'m]*\\'")
461 (calcDigit-key)
462 (setq calc-digit-value (minibuffer-contents))
463 (exit-minibuffer)))
464
465 (defun calcDigit-edit ()
466 (interactive)
467 (calc-unread-command)
468 (setq calc-digit-value (minibuffer-contents))
469 (exit-minibuffer))
470
471
472 ;;; Algebraic expression parsing. [Public]
473
474 (defvar math-read-replacement-list
475 '(;; Misc symbols
476 ("±" "+/-") ; plus or minus
477 ("×" "*") ; multiplication sign
478 ("÷" ":") ; division sign
479 ("−" "-") ; subtraction sign
480 ("∕" "/") ; division sign
481 ("∗" "*") ; asterisk multiplication
482 ("∞" "inf") ; infinity symbol
483 ("≤" "<=")
484 ("≥" ">=")
485 ("≦" "<=")
486 ("≧" ">=")
487 ;; fractions
488 ("¼" "(1:4)") ; 1/4
489 ("½" "(1:2)") ; 1/2
490 ("¾" "(3:4)") ; 3/4
491 ("⅓" "(1:3)") ; 1/3
492 ("⅔" "(2:3)") ; 2/3
493 ("⅕" "(1:5)") ; 1/5
494 ("⅖" "(2:5)") ; 2/5
495 ("⅗" "(3:5)") ; 3/5
496 ("⅘" "(4:5)") ; 4/5
497 ("⅙" "(1:6)") ; 1/6
498 ("⅚" "(5:6)") ; 5/6
499 ("⅛" "(1:8)") ; 1/8
500 ("⅜" "(3:8)") ; 3/8
501 ("⅝" "(5:8)") ; 5/8
502 ("⅞" "(7:8)") ; 7/8
503 ("⅟" "1:") ; 1/...
504 ;; superscripts
505 ("⁰" "0") ; 0
506 ("¹" "1") ; 1
507 ("²" "2") ; 2
508 ("³" "3") ; 3
509 ("⁴" "4") ; 4
510 ("⁵" "5") ; 5
511 ("⁶" "6") ; 6
512 ("⁷" "7") ; 7
513 ("⁸" "8") ; 8
514 ("⁹" "9") ; 9
515 ("⁺" "+") ; +
516 ("⁻" "-") ; -
517 ("⁽" "(") ; (
518 ("⁾" ")") ; )
519 ("ⁿ" "n") ; n
520 ("ⁱ" "i") ; i
521 ;; subscripts
522 ("₀" "0") ; 0
523 ("₁" "1") ; 1
524 ("₂" "2") ; 2
525 ("₃" "3") ; 3
526 ("₄" "4") ; 4
527 ("₅" "5") ; 5
528 ("₆" "6") ; 6
529 ("₇" "7") ; 7
530 ("₈" "8") ; 8
531 ("₉" "9") ; 9
532 ("₊" "+") ; +
533 ("₋" "-") ; -
534 ("₍" "(") ; (
535 ("₎" ")")) ; )
536 "A list whose elements (old new) indicate replacements to make
537 in Calc algebraic input.")
538
539 (defvar math-read-superscripts
540 "⁰¹²³⁴⁵⁶⁷⁸⁹⁺⁻⁽⁾ⁿⁱ" ; 0123456789+-()ni
541 "A string consisting of the superscripts allowed by Calc.")
542
543 (defvar math-read-subscripts
544 "₀₁₂₃₄₅₆₇₈₉₊₋₍₎" ; 0123456789+-()
545 "A string consisting of the subscripts allowed by Calc.")
546
547 (defun math-read-preprocess-string (str)
548 "Replace some substrings of STR by Calc equivalents."
549 (setq str
550 (replace-regexp-in-string (concat "[" math-read-superscripts "]+")
551 "^(\\&)" str))
552 (setq str
553 (replace-regexp-in-string (concat "[" math-read-subscripts "]+")
554 "_(\\&)" str))
555 (let ((rep-list math-read-replacement-list))
556 (while rep-list
557 (setq str
558 (replace-regexp-in-string (nth 0 (car rep-list))
559 (nth 1 (car rep-list)) str))
560 (setq rep-list (cdr rep-list))))
561 str)
562
563 ;; The next few variables are local to math-read-exprs (and math-read-expr
564 ;; in calc-ext.el), but are set in functions they call.
565
566 (defvar math-exp-pos)
567 (defvar math-exp-str)
568 (defvar math-exp-old-pos)
569 (defvar math-exp-token)
570 (defvar math-exp-keep-spaces)
571 (defvar math-expr-data)
572
573 (defun math-read-exprs (math-exp-str)
574 (let ((math-exp-pos 0)
575 (math-exp-old-pos 0)
576 (math-exp-keep-spaces nil)
577 math-exp-token math-expr-data)
578 (setq math-exp-str (math-read-preprocess-string math-exp-str))
579 (if calc-language-input-filter
580 (setq math-exp-str (funcall calc-language-input-filter math-exp-str)))
581 (while (setq math-exp-token (string-match "\\.\\.\\([^.]\\|.[^.]\\)" math-exp-str))
582 (setq math-exp-str (concat (substring math-exp-str 0 math-exp-token) "\\dots"
583 (substring math-exp-str (+ math-exp-token 2)))))
584 (math-build-parse-table)
585 (math-read-token)
586 (let ((val (catch 'syntax (math-read-expr-list))))
587 (if (stringp val)
588 (list 'error math-exp-old-pos val)
589 (if (equal math-exp-token 'end)
590 val
591 (list 'error math-exp-old-pos "Syntax error"))))))
592
593 (defun math-read-expr-list ()
594 (let* ((math-exp-keep-spaces nil)
595 (val (list (math-read-expr-level 0)))
596 (last val))
597 (while (equal math-expr-data ",")
598 (math-read-token)
599 (let ((rest (list (math-read-expr-level 0))))
600 (setcdr last rest)
601 (setq last rest)))
602 val))
603
604 (defvar calc-user-parse-table nil)
605 (defvar calc-last-main-parse-table nil)
606 (defvar calc-last-lang-parse-table nil)
607 (defvar calc-user-tokens nil)
608 (defvar calc-user-token-chars nil)
609
610 (defvar math-toks nil
611 "Tokens to pass between math-build-parse-table and math-find-user-tokens.")
612
613 (defun math-build-parse-table ()
614 (let ((mtab (cdr (assq nil calc-user-parse-tables)))
615 (ltab (cdr (assq calc-language calc-user-parse-tables))))
616 (or (and (eq mtab calc-last-main-parse-table)
617 (eq ltab calc-last-lang-parse-table))
618 (let ((p (append mtab ltab))
619 (math-toks nil))
620 (setq calc-user-parse-table p)
621 (setq calc-user-token-chars nil)
622 (while p
623 (math-find-user-tokens (car (car p)))
624 (setq p (cdr p)))
625 (setq calc-user-tokens (mapconcat 'identity
626 (sort (mapcar 'car math-toks)
627 (function (lambda (x y)
628 (> (length x)
629 (length y)))))
630 "\\|")
631 calc-last-main-parse-table mtab
632 calc-last-lang-parse-table ltab)))))
633
634 (defun math-find-user-tokens (p)
635 (while p
636 (cond ((and (stringp (car p))
637 (or (> (length (car p)) 1) (equal (car p) "$")
638 (equal (car p) "\""))
639 (string-match "[^a-zA-Z0-9]" (car p)))
640 (let ((s (regexp-quote (car p))))
641 (if (string-match "\\`[a-zA-Z0-9]" s)
642 (setq s (concat "\\<" s)))
643 (if (string-match "[a-zA-Z0-9]\\'" s)
644 (setq s (concat s "\\>")))
645 (or (assoc s math-toks)
646 (progn
647 (setq math-toks (cons (list s) math-toks))
648 (or (memq (aref (car p) 0) calc-user-token-chars)
649 (setq calc-user-token-chars
650 (cons (aref (car p) 0)
651 calc-user-token-chars)))))))
652 ((consp (car p))
653 (math-find-user-tokens (nth 1 (car p)))
654 (or (eq (car (car p)) '\?)
655 (math-find-user-tokens (nth 2 (car p))))))
656 (setq p (cdr p))))
657
658 (defun math-read-token ()
659 (if (>= math-exp-pos (length math-exp-str))
660 (setq math-exp-old-pos math-exp-pos
661 math-exp-token 'end
662 math-expr-data "\000")
663 (let ((ch (aref math-exp-str math-exp-pos)))
664 (setq math-exp-old-pos math-exp-pos)
665 (cond ((memq ch '(32 10 9))
666 (setq math-exp-pos (1+ math-exp-pos))
667 (if math-exp-keep-spaces
668 (setq math-exp-token 'space
669 math-expr-data " ")
670 (math-read-token)))
671 ((and (memq ch calc-user-token-chars)
672 (let ((case-fold-search nil))
673 (eq (string-match calc-user-tokens math-exp-str math-exp-pos)
674 math-exp-pos)))
675 (setq math-exp-token 'punc
676 math-expr-data (math-match-substring math-exp-str 0)
677 math-exp-pos (match-end 0)))
678 ((or (and (>= ch ?a) (<= ch ?z))
679 (and (>= ch ?A) (<= ch ?Z)))
680 (string-match (if (memq calc-language '(c fortran pascal maple))
681 "[a-zA-Z0-9_#]*"
682 "[a-zA-Z0-9'#]*")
683 math-exp-str math-exp-pos)
684 (setq math-exp-token 'symbol
685 math-exp-pos (match-end 0)
686 math-expr-data (math-restore-dashes
687 (math-match-substring math-exp-str 0)))
688 (if (eq calc-language 'eqn)
689 (let ((code (assoc math-expr-data math-eqn-ignore-words)))
690 (cond ((null code))
691 ((null (cdr code))
692 (math-read-token))
693 ((consp (nth 1 code))
694 (math-read-token)
695 (if (assoc math-expr-data (cdr code))
696 (setq math-expr-data (format "%s %s"
697 (car code) math-expr-data))))
698 ((eq (nth 1 code) 'punc)
699 (setq math-exp-token 'punc
700 math-expr-data (nth 2 code)))
701 (t
702 (math-read-token)
703 (math-read-token))))))
704 ((or (and (>= ch ?0) (<= ch ?9))
705 (and (eq ch '?\.)
706 (eq (string-match "\\.[0-9]" math-exp-str math-exp-pos)
707 math-exp-pos))
708 (and (eq ch '?_)
709 (eq (string-match "_\\.?[0-9]" math-exp-str math-exp-pos)
710 math-exp-pos)
711 (or (eq math-exp-pos 0)
712 (and (memq calc-language '(nil flat big unform
713 tex latex eqn))
714 (eq (string-match "[^])}\"a-zA-Z0-9'$]_"
715 math-exp-str (1- math-exp-pos))
716 (1- math-exp-pos))))))
717 (or (and (eq calc-language 'c)
718 (string-match "0[xX][0-9a-fA-F]+" math-exp-str math-exp-pos))
719 (string-match "_?\\([0-9]+.?0*@ *\\)?\\([0-9]+.?0*' *\\)?\\(0*\\([2-9]\\|1[0-4]\\)\\(#\\|\\^\\^\\)[0-9a-dA-D.]+[eE][-+_]?[0-9]+\\|0*\\([2-9]\\|[0-2][0-9]\\|3[0-6]\\)\\(#\\|\\^\\^\\)[0-9a-zA-Z:.]+\\|[0-9]+:[0-9:]+\\|[0-9.]+\\([eE][-+_]?[0-9]+\\)?\"?\\)?"
720 math-exp-str math-exp-pos))
721 (setq math-exp-token 'number
722 math-expr-data (math-match-substring math-exp-str 0)
723 math-exp-pos (match-end 0)))
724 ((eq ch ?\$)
725 (if (and (eq calc-language 'pascal)
726 (eq (string-match
727 "\\(\\$[0-9a-fA-F]+\\)\\($\\|[^0-9a-zA-Z]\\)"
728 math-exp-str math-exp-pos)
729 math-exp-pos))
730 (setq math-exp-token 'number
731 math-expr-data (math-match-substring math-exp-str 1)
732 math-exp-pos (match-end 1))
733 (if (eq (string-match "\\$\\([1-9][0-9]*\\)" math-exp-str math-exp-pos)
734 math-exp-pos)
735 (setq math-expr-data (- (string-to-number (math-match-substring
736 math-exp-str 1))))
737 (string-match "\\$+" math-exp-str math-exp-pos)
738 (setq math-expr-data (- (match-end 0) (match-beginning 0))))
739 (setq math-exp-token 'dollar
740 math-exp-pos (match-end 0))))
741 ((eq ch ?\#)
742 (if (eq (string-match "#\\([1-9][0-9]*\\)" math-exp-str math-exp-pos)
743 math-exp-pos)
744 (setq math-expr-data (string-to-number
745 (math-match-substring math-exp-str 1))
746 math-exp-pos (match-end 0))
747 (setq math-expr-data 1
748 math-exp-pos (1+ math-exp-pos)))
749 (setq math-exp-token 'hash))
750 ((eq (string-match "~=\\|<=\\|>=\\|<>\\|/=\\|\\+/-\\|\\\\dots\\|\\\\ldots\\|\\*\\*\\|<<\\|>>\\|==\\|!=\\|&&&\\||||\\|!!!\\|&&\\|||\\|!!\\|:=\\|::\\|=>"
751 math-exp-str math-exp-pos)
752 math-exp-pos)
753 (setq math-exp-token 'punc
754 math-expr-data (math-match-substring math-exp-str 0)
755 math-exp-pos (match-end 0)))
756 ((and (eq ch ?\")
757 (string-match "\\(\"\\([^\"\\]\\|\\\\.\\)*\\)\\(\"\\|\\'\\)"
758 math-exp-str math-exp-pos))
759 (if (eq calc-language 'eqn)
760 (progn
761 (setq math-exp-str (copy-sequence math-exp-str))
762 (aset math-exp-str (match-beginning 1) ?\{)
763 (if (< (match-end 1) (length math-exp-str))
764 (aset math-exp-str (match-end 1) ?\}))
765 (math-read-token))
766 (setq math-exp-token 'string
767 math-expr-data (math-match-substring math-exp-str 1)
768 math-exp-pos (match-end 0))))
769 ((and (= ch ?\\) (eq calc-language 'tex)
770 (< math-exp-pos (1- (length math-exp-str))))
771 (or (string-match "\\\\hbox *{\\([a-zA-Z0-9]+\\)}"
772 math-exp-str math-exp-pos)
773 (string-match "\\(\\\\\\([a-zA-Z]+\\|[^a-zA-Z]\\)\\)"
774 math-exp-str math-exp-pos))
775 (setq math-exp-token 'symbol
776 math-exp-pos (match-end 0)
777 math-expr-data (math-restore-dashes
778 (math-match-substring math-exp-str 1)))
779 (let ((code (assoc math-expr-data math-latex-ignore-words)))
780 (cond ((null code))
781 ((null (cdr code))
782 (math-read-token))
783 ((eq (nth 1 code) 'punc)
784 (setq math-exp-token 'punc
785 math-expr-data (nth 2 code)))
786 ((and (eq (nth 1 code) 'mat)
787 (string-match " *{" math-exp-str math-exp-pos))
788 (setq math-exp-pos (match-end 0)
789 math-exp-token 'punc
790 math-expr-data "[")
791 (let ((right (string-match "}" math-exp-str math-exp-pos)))
792 (and right
793 (setq math-exp-str (copy-sequence math-exp-str))
794 (aset math-exp-str right ?\])))))))
795 ((and (= ch ?\\) (eq calc-language 'latex)
796 (< math-exp-pos (1- (length math-exp-str))))
797 (or (string-match "\\\\hbox *{\\([a-zA-Z0-9]+\\)}"
798 math-exp-str math-exp-pos)
799 (string-match "\\\\text *{\\([a-zA-Z0-9]+\\)}"
800 math-exp-str math-exp-pos)
801 (string-match "\\(\\\\\\([a-zA-Z]+\\|[^a-zA-Z]\\)\\)"
802 math-exp-str math-exp-pos))
803 (setq math-exp-token 'symbol
804 math-exp-pos (match-end 0)
805 math-expr-data (math-restore-dashes
806 (math-match-substring math-exp-str 1)))
807 (let ((code (assoc math-expr-data math-tex-ignore-words))
808 envname)
809 (cond ((null code))
810 ((null (cdr code))
811 (math-read-token))
812 ((eq (nth 1 code) 'punc)
813 (setq math-exp-token 'punc
814 math-expr-data (nth 2 code)))
815 ((and (eq (nth 1 code) 'begenv)
816 (string-match " *{\\([^}]*\\)}" math-exp-str math-exp-pos))
817 (setq math-exp-pos (match-end 0)
818 envname (match-string 1 math-exp-str)
819 math-exp-token 'punc
820 math-expr-data "[")
821 (cond ((or (string= envname "matrix")
822 (string= envname "bmatrix")
823 (string= envname "smallmatrix")
824 (string= envname "pmatrix"))
825 (if (string-match (concat "\\\\end{" envname "}")
826 math-exp-str math-exp-pos)
827 (setq math-exp-str
828 (replace-match "]" t t math-exp-str))
829 (error "%s" (concat "No closing \\end{" envname "}"))))))
830 ((and (eq (nth 1 code) 'mat)
831 (string-match " *{" math-exp-str math-exp-pos))
832 (setq math-exp-pos (match-end 0)
833 math-exp-token 'punc
834 math-expr-data "[")
835 (let ((right (string-match "}" math-exp-str math-exp-pos)))
836 (and right
837 (setq math-exp-str (copy-sequence math-exp-str))
838 (aset math-exp-str right ?\])))))))
839 ((and (= ch ?\.) (eq calc-language 'fortran)
840 (eq (string-match "\\.[a-zA-Z][a-zA-Z][a-zA-Z]?\\."
841 math-exp-str math-exp-pos) math-exp-pos))
842 (setq math-exp-token 'punc
843 math-expr-data (upcase (math-match-substring math-exp-str 0))
844 math-exp-pos (match-end 0)))
845 ((and (eq calc-language 'math)
846 (eq (string-match "\\[\\[\\|->\\|:>" math-exp-str math-exp-pos)
847 math-exp-pos))
848 (setq math-exp-token 'punc
849 math-expr-data (math-match-substring math-exp-str 0)
850 math-exp-pos (match-end 0)))
851 ((and (eq calc-language 'eqn)
852 (eq (string-match "->\\|<-\\|+-\\|\\\\dots\\|~\\|\\^"
853 math-exp-str math-exp-pos)
854 math-exp-pos))
855 (setq math-exp-token 'punc
856 math-expr-data (math-match-substring math-exp-str 0)
857 math-exp-pos (match-end 0))
858 (and (eq (string-match "\\\\dots\\." math-exp-str math-exp-pos)
859 math-exp-pos)
860 (setq math-exp-pos (match-end 0)))
861 (if (memq (aref math-expr-data 0) '(?~ ?^))
862 (math-read-token)))
863 ((eq (string-match "%%.*$" math-exp-str math-exp-pos) math-exp-pos)
864 (setq math-exp-pos (match-end 0))
865 (math-read-token))
866 (t
867 (if (and (eq ch ?\{) (memq calc-language '(tex latex eqn)))
868 (setq ch ?\())
869 (if (and (eq ch ?\}) (memq calc-language '(tex latex eqn)))
870 (setq ch ?\)))
871 (if (and (eq ch ?\&) (memq calc-language '(tex latex)))
872 (setq ch ?\,))
873 (setq math-exp-token 'punc
874 math-expr-data (char-to-string ch)
875 math-exp-pos (1+ math-exp-pos)))))))
876
877 (defconst math-alg-inequalities
878 '(calcFunc-lt calcFunc-gt calcFunc-leq calcFunc-geq
879 calcFunc-eq calcFunc-neq))
880
881 (defun math-read-expr-level (exp-prec &optional exp-term)
882 (let* ((math-expr-opers (math-expr-ops))
883 (x (math-read-factor))
884 (first t)
885 op op2)
886 (while (and (or (and calc-user-parse-table
887 (setq op (calc-check-user-syntax x exp-prec))
888 (setq x op
889 op '("2x" ident 999999 -1)))
890 (and (setq op (assoc math-expr-data math-expr-opers))
891 (/= (nth 2 op) -1)
892 (or (and (setq op2 (assoc
893 math-expr-data
894 (cdr (memq op math-expr-opers))))
895 (eq (= (nth 3 op) -1)
896 (/= (nth 3 op2) -1))
897 (eq (= (nth 3 op2) -1)
898 (not (math-factor-after)))
899 (setq op op2))
900 t))
901 (and (or (eq (nth 2 op) -1)
902 (memq math-exp-token '(symbol number dollar hash))
903 (equal math-expr-data "(")
904 (and (equal math-expr-data "[")
905 (not (eq calc-language 'math))
906 (not (and math-exp-keep-spaces
907 (eq (car-safe x) 'vec)))))
908 (or (not (setq op (assoc math-expr-data math-expr-opers)))
909 (/= (nth 2 op) -1))
910 (or (not calc-user-parse-table)
911 (not (eq math-exp-token 'symbol))
912 (let ((p calc-user-parse-table))
913 (while (and p
914 (or (not (integerp
915 (car (car (car p)))))
916 (not (equal
917 (nth 1 (car (car p)))
918 math-expr-data))))
919 (setq p (cdr p)))
920 (not p)))
921 (setq op (assoc "2x" math-expr-opers))))
922 (not (and exp-term (equal math-expr-data exp-term)))
923 (>= (nth 2 op) exp-prec))
924 (if (not (equal (car op) "2x"))
925 (math-read-token))
926 (and (memq (nth 1 op) '(sdev mod))
927 (require 'calc-ext))
928 (setq x (cond ((consp (nth 1 op))
929 (funcall (car (nth 1 op)) x op))
930 ((eq (nth 3 op) -1)
931 (if (eq (nth 1 op) 'ident)
932 x
933 (if (eq (nth 1 op) 'closing)
934 (if (eq (nth 2 op) exp-prec)
935 (progn
936 (setq exp-prec 1000)
937 x)
938 (throw 'syntax "Mismatched delimiters"))
939 (list (nth 1 op) x))))
940 ((and (not first)
941 (memq (nth 1 op) math-alg-inequalities)
942 (memq (car-safe x) math-alg-inequalities))
943 (require 'calc-ext)
944 (math-composite-inequalities x op))
945 (t (list (nth 1 op)
946 x
947 (math-read-expr-level (nth 3 op) exp-term))))
948 first nil))
949 x))
950
951 ;; calc-arg-values is defined in calc-ext.el, but is used here.
952 (defvar calc-arg-values)
953
954 (defun calc-check-user-syntax (&optional x prec)
955 (let ((p calc-user-parse-table)
956 (matches nil)
957 match rule)
958 (while (and p
959 (or (not (progn
960 (setq rule (car (car p)))
961 (if x
962 (and (integerp (car rule))
963 (>= (car rule) prec)
964 (equal math-expr-data
965 (car (setq rule (cdr rule)))))
966 (equal math-expr-data (car rule)))))
967 (let ((save-exp-pos math-exp-pos)
968 (save-exp-old-pos math-exp-old-pos)
969 (save-exp-token math-exp-token)
970 (save-exp-data math-expr-data))
971 (or (not (listp
972 (setq matches (calc-match-user-syntax rule))))
973 (let ((args (progn
974 (require 'calc-ext)
975 calc-arg-values))
976 (conds nil)
977 temp)
978 (if x
979 (setq matches (cons x matches)))
980 (setq match (cdr (car p)))
981 (while (and (eq (car-safe match)
982 'calcFunc-condition)
983 (= (length match) 3))
984 (setq conds (append (math-flatten-lands
985 (nth 2 match))
986 conds)
987 match (nth 1 match)))
988 (while (and conds match)
989 (require 'calc-ext)
990 (cond ((eq (car-safe (car conds))
991 'calcFunc-let)
992 (setq temp (car conds))
993 (or (= (length temp) 3)
994 (and (= (length temp) 2)
995 (eq (car-safe (nth 1 temp))
996 'calcFunc-assign)
997 (= (length (nth 1 temp)) 3)
998 (setq temp (nth 1 temp)))
999 (setq match nil))
1000 (setq matches (cons
1001 (math-normalize
1002 (math-multi-subst
1003 (nth 2 temp)
1004 args matches))
1005 matches)
1006 args (cons (nth 1 temp)
1007 args)))
1008 ((and (eq (car-safe (car conds))
1009 'calcFunc-matches)
1010 (= (length (car conds)) 3))
1011 (setq temp (calcFunc-vmatches
1012 (math-multi-subst
1013 (nth 1 (car conds))
1014 args matches)
1015 (nth 2 (car conds))))
1016 (if (eq temp 0)
1017 (setq match nil)
1018 (while (setq temp (cdr temp))
1019 (setq matches (cons (nth 2 (car temp))
1020 matches)
1021 args (cons (nth 1 (car temp))
1022 args)))))
1023 (t
1024 (or (math-is-true (math-simplify
1025 (math-multi-subst
1026 (car conds)
1027 args matches)))
1028 (setq match nil))))
1029 (setq conds (cdr conds)))
1030 (if match
1031 (not (setq match (math-multi-subst
1032 match args matches)))
1033 (setq math-exp-old-pos save-exp-old-pos
1034 math-exp-token save-exp-token
1035 math-expr-data save-exp-data
1036 math-exp-pos save-exp-pos)))))))
1037 (setq p (cdr p)))
1038 (and p match)))
1039
1040 (defun calc-match-user-syntax (p &optional term)
1041 (let ((matches nil)
1042 (save-exp-pos math-exp-pos)
1043 (save-exp-old-pos math-exp-old-pos)
1044 (save-exp-token math-exp-token)
1045 (save-exp-data math-expr-data)
1046 m)
1047 (while (and p
1048 (cond ((stringp (car p))
1049 (and (equal math-expr-data (car p))
1050 (progn
1051 (math-read-token)
1052 t)))
1053 ((integerp (car p))
1054 (and (setq m (catch 'syntax
1055 (math-read-expr-level
1056 (car p)
1057 (if (cdr p)
1058 (if (consp (nth 1 p))
1059 (car (nth 1 (nth 1 p)))
1060 (nth 1 p))
1061 term))))
1062 (not (stringp m))
1063 (setq matches (nconc matches (list m)))))
1064 ((eq (car (car p)) '\?)
1065 (setq m (calc-match-user-syntax (nth 1 (car p))))
1066 (or (nth 2 (car p))
1067 (setq matches
1068 (nconc matches
1069 (list
1070 (cons 'vec (and (listp m) m))))))
1071 (or (listp m) (not (nth 2 (car p)))
1072 (not (eq (aref (car (nth 2 (car p))) 0) ?\$))
1073 (eq math-exp-token 'end)))
1074 (t
1075 (setq m (calc-match-user-syntax (nth 1 (car p))
1076 (car (nth 2 (car p)))))
1077 (if (listp m)
1078 (let ((vec (cons 'vec m))
1079 opos mm)
1080 (while (and (listp
1081 (setq opos math-exp-pos
1082 mm (calc-match-user-syntax
1083 (or (nth 2 (car p))
1084 (nth 1 (car p)))
1085 (car (nth 2 (car p))))))
1086 (> math-exp-pos opos))
1087 (setq vec (nconc vec mm)))
1088 (setq matches (nconc matches (list vec))))
1089 (and (eq (car (car p)) '*)
1090 (setq matches (nconc matches (list '(vec)))))))))
1091 (setq p (cdr p)))
1092 (if p
1093 (setq math-exp-pos save-exp-pos
1094 math-exp-old-pos save-exp-old-pos
1095 math-exp-token save-exp-token
1096 math-expr-data save-exp-data
1097 matches "Failed"))
1098 matches))
1099
1100 (defun math-remove-dashes (x)
1101 (if (string-match "\\`\\(.*\\)-\\(.*\\)\\'" x)
1102 (math-remove-dashes
1103 (concat (math-match-substring x 1) "#" (math-match-substring x 2)))
1104 x))
1105
1106 (defun math-restore-dashes (x)
1107 (if (string-match "\\`\\(.*\\)[#_]\\(.*\\)\\'" x)
1108 (math-restore-dashes
1109 (concat (math-match-substring x 1) "-" (math-match-substring x 2)))
1110 x))
1111
1112 (defun math-read-if (cond op)
1113 (let ((then (math-read-expr-level 0)))
1114 (or (equal math-expr-data ":")
1115 (throw 'syntax "Expected ':'"))
1116 (math-read-token)
1117 (list 'calcFunc-if cond then (math-read-expr-level (nth 3 op)))))
1118
1119 (defun math-factor-after ()
1120 (let ((math-exp-pos math-exp-pos)
1121 math-exp-old-pos math-exp-token math-expr-data)
1122 (math-read-token)
1123 (or (memq math-exp-token '(number symbol dollar hash string))
1124 (and (assoc math-expr-data '(("-") ("+") ("!") ("|") ("/")))
1125 (assoc (concat "u" math-expr-data) math-expr-opers))
1126 (eq (nth 2 (assoc math-expr-data math-expr-opers)) -1)
1127 (assoc math-expr-data '(("(") ("[") ("{"))))))
1128
1129 (defun math-read-factor ()
1130 (let ((math-expr-opers (math-expr-ops))
1131 op)
1132 (cond ((eq math-exp-token 'number)
1133 (let ((num (math-read-number math-expr-data)))
1134 (if (not num)
1135 (progn
1136 (setq math-exp-old-pos math-exp-pos)
1137 (throw 'syntax "Bad format")))
1138 (math-read-token)
1139 (if (and math-read-expr-quotes
1140 (consp num))
1141 (list 'quote num)
1142 num)))
1143 ((and calc-user-parse-table
1144 (setq op (calc-check-user-syntax)))
1145 op)
1146 ((or (equal math-expr-data "-")
1147 (equal math-expr-data "+")
1148 (equal math-expr-data "!")
1149 (equal math-expr-data "|")
1150 (equal math-expr-data "/"))
1151 (setq math-expr-data (concat "u" math-expr-data))
1152 (math-read-factor))
1153 ((and (setq op (assoc math-expr-data math-expr-opers))
1154 (eq (nth 2 op) -1))
1155 (if (consp (nth 1 op))
1156 (funcall (car (nth 1 op)) op)
1157 (math-read-token)
1158 (let ((val (math-read-expr-level (nth 3 op))))
1159 (cond ((eq (nth 1 op) 'ident)
1160 val)
1161 ((and (Math-numberp val)
1162 (equal (car op) "u-"))
1163 (math-neg val))
1164 (t (list (nth 1 op) val))))))
1165 ((eq math-exp-token 'symbol)
1166 (let ((sym (intern math-expr-data)))
1167 (math-read-token)
1168 (if (equal math-expr-data calc-function-open)
1169 (let ((f (assq sym math-expr-function-mapping)))
1170 (math-read-token)
1171 (if (consp (cdr f))
1172 (funcall (car (cdr f)) f sym)
1173 (let ((args (if (or (equal math-expr-data calc-function-close)
1174 (eq math-exp-token 'end))
1175 nil
1176 (math-read-expr-list))))
1177 (if (not (or (equal math-expr-data calc-function-close)
1178 (eq math-exp-token 'end)))
1179 (throw 'syntax "Expected `)'"))
1180 (math-read-token)
1181 (if (and (eq calc-language 'fortran) args
1182 (require 'calc-ext)
1183 (let ((calc-matrix-mode 'scalar))
1184 (math-known-matrixp
1185 (list 'var sym
1186 (intern
1187 (concat "var-"
1188 (symbol-name sym)))))))
1189 (math-parse-fortran-subscr sym args)
1190 (if f
1191 (setq sym (cdr f))
1192 (and (= (aref (symbol-name sym) 0) ?\\)
1193 (< (prefix-numeric-value calc-language-option)
1194 0)
1195 (setq sym (intern (substring (symbol-name sym)
1196 1))))
1197 (or (string-match "-" (symbol-name sym))
1198 (setq sym (intern
1199 (concat "calcFunc-"
1200 (symbol-name sym))))))
1201 (cons sym args)))))
1202 (if math-read-expr-quotes
1203 sym
1204 (let ((val (list 'var
1205 (intern (math-remove-dashes
1206 (symbol-name sym)))
1207 (if (string-match "-" (symbol-name sym))
1208 sym
1209 (intern (concat "var-"
1210 (symbol-name sym)))))))
1211 (let ((v (assq (nth 1 val) math-expr-variable-mapping)))
1212 (and v (setq val (if (consp (cdr v))
1213 (funcall (car (cdr v)) v val)
1214 (list 'var
1215 (intern
1216 (substring (symbol-name (cdr v))
1217 4))
1218 (cdr v))))))
1219 (while (and (memq calc-language '(c pascal maple))
1220 (equal math-expr-data "["))
1221 (math-read-token)
1222 (setq val (append (list 'calcFunc-subscr val)
1223 (math-read-expr-list)))
1224 (if (equal math-expr-data "]")
1225 (math-read-token)
1226 (throw 'syntax "Expected ']'")))
1227 val)))))
1228 ((eq math-exp-token 'dollar)
1229 (let ((abs (if (> math-expr-data 0) math-expr-data (- math-expr-data))))
1230 (if (>= (length calc-dollar-values) abs)
1231 (let ((num math-expr-data))
1232 (math-read-token)
1233 (setq calc-dollar-used (max calc-dollar-used num))
1234 (math-check-complete (nth (1- abs) calc-dollar-values)))
1235 (throw 'syntax (if calc-dollar-values
1236 "Too many $'s"
1237 "$'s not allowed in this context")))))
1238 ((eq math-exp-token 'hash)
1239 (or calc-hashes-used
1240 (throw 'syntax "#'s not allowed in this context"))
1241 (require 'calc-ext)
1242 (if (<= math-expr-data (length calc-arg-values))
1243 (let ((num math-expr-data))
1244 (math-read-token)
1245 (setq calc-hashes-used (max calc-hashes-used num))
1246 (nth (1- num) calc-arg-values))
1247 (throw 'syntax "Too many # arguments")))
1248 ((equal math-expr-data "(")
1249 (let* ((exp (let ((math-exp-keep-spaces nil))
1250 (math-read-token)
1251 (if (or (equal math-expr-data "\\dots")
1252 (equal math-expr-data "\\ldots"))
1253 '(neg (var inf var-inf))
1254 (math-read-expr-level 0)))))
1255 (let ((math-exp-keep-spaces nil))
1256 (cond
1257 ((equal math-expr-data ",")
1258 (progn
1259 (math-read-token)
1260 (let ((exp2 (math-read-expr-level 0)))
1261 (setq exp
1262 (if (and exp2 (Math-realp exp) (Math-realp exp2))
1263 (math-normalize (list 'cplx exp exp2))
1264 (list '+ exp (list '* exp2 '(var i var-i))))))))
1265 ((equal math-expr-data ";")
1266 (progn
1267 (math-read-token)
1268 (let ((exp2 (math-read-expr-level 0)))
1269 (setq exp (if (and exp2 (Math-realp exp)
1270 (Math-anglep exp2))
1271 (math-normalize (list 'polar exp exp2))
1272 (require 'calc-ext)
1273 (list '* exp
1274 (list 'calcFunc-exp
1275 (list '*
1276 (math-to-radians-2 exp2)
1277 '(var i var-i)))))))))
1278 ((or (equal math-expr-data "\\dots")
1279 (equal math-expr-data "\\ldots"))
1280 (progn
1281 (math-read-token)
1282 (let ((exp2 (if (or (equal math-expr-data ")")
1283 (equal math-expr-data "]")
1284 (eq math-exp-token 'end))
1285 '(var inf var-inf)
1286 (math-read-expr-level 0))))
1287 (setq exp
1288 (list 'intv
1289 (if (equal math-expr-data ")") 0 1)
1290 exp
1291 exp2)))))))
1292 (if (not (or (equal math-expr-data ")")
1293 (and (equal math-expr-data "]") (eq (car-safe exp) 'intv))
1294 (eq math-exp-token 'end)))
1295 (throw 'syntax "Expected `)'"))
1296 (math-read-token)
1297 exp))
1298 ((eq math-exp-token 'string)
1299 (require 'calc-ext)
1300 (math-read-string))
1301 ((equal math-expr-data "[")
1302 (require 'calc-ext)
1303 (math-read-brackets t "]"))
1304 ((equal math-expr-data "{")
1305 (require 'calc-ext)
1306 (math-read-brackets nil "}"))
1307 ((equal math-expr-data "<")
1308 (require 'calc-ext)
1309 (math-read-angle-brackets))
1310 (t (throw 'syntax "Expected a number")))))
1311
1312 (provide 'calc-aent)
1313
1314 ;;; arch-tag: 5599e45d-e51e-44bb-9a20-9f4ed8c96c32
1315 ;;; calc-aent.el ends here
Emacs repository mirror