1 ;;; calc-aent.el --- algebraic entry functions for Calc
3 ;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
5 ;; Author: Dave Gillespie <daveg@synaptics.com>
6 ;; Maintainers: D. Goel <deego@gnufans.org>
7 ;; Colin Walters <walters@debian.org>
9 ;; This file is part of GNU Emacs.
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.
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.
30 ;; This file is autoloaded from calc.el.
34 (eval-when-compile '(require calc-macs))
36 (defun calc-Need-calc-aent () nil)
39 (defun calc-do-quick-calc ()
41 (if (eq major-mode 'calc-mode)
42 (calc-algebraic-entry t)
46 (let* ((calc-command-flags nil)
47 (calc-dollar-values calc-quick-prev-results)
49 (enable-recursive-minibuffers t)
50 (calc-language (if (memq calc-language '(nil big))
52 (entry (calc-do-alg-entry "" "Quick calc: " t))
53 (alg-exp (mapcar (function
55 (if (and (not calc-extensions-loaded)
56 calc-previous-alg-entry
58 "\\`[-0-9._+*/^() ]+\\'"
59 calc-previous-alg-entry))
62 (math-evaluate-expr x))))
64 (when (and (= (length alg-exp) 1)
65 (eq (car-safe (car alg-exp)) 'calcFunc-assign)
66 (= (length (car alg-exp)) 3)
67 (eq (car-safe (nth 1 (car alg-exp))) 'var))
69 (set (nth 2 (nth 1 (car alg-exp))) (nth 2 (car alg-exp)))
70 (calc-refresh-evaltos (nth 2 (nth 1 (car alg-exp))))
71 (setq alg-exp (list (nth 2 (car alg-exp)))))
72 (setq calc-quick-prev-results alg-exp
73 buf (mapconcat (function (lambda (x)
74 (math-format-value x 1000)))
78 (if (and (= (length alg-exp) 1)
79 (memq (car-safe (car alg-exp)) '(nil bigpos bigneg))
81 (= calc-number-radix 10))
82 (setq buf (concat buf " ("
83 (let ((calc-number-radix 16))
84 (math-format-value (car alg-exp) 1000))
86 (let ((calc-number-radix 8))
87 (math-format-value (car alg-exp) 1000))
88 (if (and (integerp (car alg-exp))
90 (< (car alg-exp) 127))
91 (format ", \"%c\"" (car alg-exp))
94 (if (and (< (length buf) (frame-width)) (= (length entry) 1)
95 calc-extensions-loaded)
96 (let ((long (concat (math-format-value (car entry) 1000)
98 (if (<= (length long) (- (frame-width) 8))
101 (message "Result: %s" buf)))
102 (if (eq last-command-char 10)
104 (setq kill-ring (cons shortbuf kill-ring))
105 (when (> (length kill-ring) kill-ring-max)
106 (setcdr (nthcdr (1- kill-ring-max) kill-ring) nil))
107 (setq kill-ring-yank-pointer kill-ring)))))
109 (defun calc-do-calc-eval (str separator args)
115 ((and (consp str) (not (symbolp (car str))))
116 (let ((calc-language nil)
117 (math-expr-opers math-standard-opers)
118 (calc-internal-prec 12)
120 (calc-symbolic-mode nil)
121 (calc-matrix-mode nil)
122 (calc-angle-mode 'deg)
123 (calc-number-radix 10)
124 (calc-leading-zeros nil)
125 (calc-group-digits nil)
126 (calc-point-char ".")
127 (calc-frac-format '(":" nil))
128 (calc-prefer-frac nil)
129 (calc-hms-format "%s@ %s' %s\"")
130 (calc-date-format '((H ":" mm C SS pp " ")
131 Www " " Mmm " " D ", " YYYY))
132 (calc-float-format '(float 0))
133 (calc-full-float-format '(float 0))
134 (calc-complex-format nil)
135 (calc-matrix-just nil)
136 (calc-full-vectors t)
137 (calc-break-vectors nil)
138 (calc-vector-commas ",")
139 (calc-vector-brackets "[]")
140 (calc-matrix-brackets '(R O))
141 (calc-complex-mode 'cplx)
142 (calc-infinite-mode nil)
143 (calc-display-strings nil)
144 (calc-simplify-mode nil)
145 (calc-display-working-message 'lots)
148 (set (car strp) (nth 1 strp))
149 (setq strp (cdr (cdr strp))))
150 (calc-do-calc-eval (car str) separator args)))
151 ((eq separator 'eval)
153 ((eq separator 'macro)
155 (let* ((calc-buffer (current-buffer))
156 (calc-window (get-buffer-window calc-buffer))
157 (save-window (selected-window)))
161 (select-window calc-window)
162 (calc-execute-kbd-macro str nil (car args)))
163 (and (window-point save-window)
164 (select-window save-window)))
165 (save-window-excursion
166 (select-window (get-largest-window))
167 (switch-to-buffer calc-buffer)
168 (calc-execute-kbd-macro str nil (car args)))))
171 (or (not (integerp str))
173 (calc-pop (min str (calc-stack-size))))
178 (<= str (calc-stack-size))
179 (math-format-value (calc-top-n str (car args)) 1000)))
180 ((eq separator 'rawtop)
183 (<= str (calc-stack-size))
184 (calc-top-n str (car args))))
186 (let* ((calc-command-flags nil)
188 (calc-language (if (memq calc-language '(nil big))
189 'flat calc-language))
190 (calc-dollar-values (mapcar
195 (setq x (math-read-exprs x))
205 (res (if (stringp str)
206 (math-read-exprs str)
209 (if (eq (car res) 'error)
210 (calc-eval-error (cdr res))
211 (setq res (mapcar 'calc-normalize res))
212 (and (memq 'clear-message calc-command-flags)
214 (cond ((eq separator 'pred)
216 (if (= (length res) 1)
217 (math-is-true (car res))
218 (calc-eval-error '(0 "Single value expected"))))
220 (if (= (length res) 1)
222 (calc-eval-error '(0 "Single value expected"))))
223 ((eq separator 'list)
225 ((memq separator '(num rawnum))
226 (if (= (length res) 1)
227 (if (math-constp (car res))
228 (if (eq separator 'num)
229 (math-format-value (car res) 1000)
234 (calc-explain-why (car calc-next-why))
235 "Number expected"))))
236 (calc-eval-error '(0 "Single value expected"))))
237 ((eq separator 'push)
241 (setq buf (concat buf
242 (and buf (or separator ", "))
243 (math-format-value (car res) 1000))
247 (defun calc-eval-error (msg)
248 (if (and (boundp 'calc-eval-error)
250 (if (eq calc-eval-error 'string)
252 (error "%s" (nth 1 msg)))
256 ;;;; Reading an expression in algebraic form.
258 (defun calc-auto-algebraic-entry (&optional prefix)
260 (calc-algebraic-entry prefix t))
262 (defun calc-algebraic-entry (&optional prefix auto)
265 (let ((calc-language (if prefix nil calc-language))
266 (math-expr-opers (if prefix math-standard-opers math-expr-opers)))
267 (calc-alg-entry (and auto (char-to-string last-command-char))))))
269 (defun calc-alg-entry (&optional initial prompt)
270 (let* ((sel-mode nil)
271 (calc-dollar-values (mapcar 'calc-get-stack-element
272 (nthcdr calc-stack-top calc-stack)))
275 (alg-exp (calc-do-alg-entry initial prompt t)))
276 (if (stringp alg-exp)
279 (calc-alg-edit alg-exp))
280 (let* ((calc-simplify-mode (if (eq last-command-char ?\C-j)
283 (nvals (mapcar 'calc-normalize alg-exp)))
285 (calc-record (if calc-extensions-loaded (car alg-exp) (car nvals))
287 (calc-pop-push-record-list calc-dollar-used
288 (and (not (equal (car alg-exp)
290 calc-extensions-loaded
293 (setq alg-exp (cdr alg-exp)
295 calc-dollar-used 0)))
296 (calc-handle-whys))))
298 (defun calc-do-alg-entry (&optional initial prompt no-normalize)
299 (let* ((calc-buffer (current-buffer))
300 (blink-paren-function 'calcAlg-blink-matching-open)
302 (unless (boundp 'calc-alg-ent-map)
303 (setq calc-alg-ent-map (copy-keymap minibuffer-local-map))
304 (define-key calc-alg-ent-map "'" 'calcAlg-previous)
305 (define-key calc-alg-ent-map "`" 'calcAlg-edit)
306 (define-key calc-alg-ent-map "\C-m" 'calcAlg-enter)
307 (define-key calc-alg-ent-map "\C-j" 'calcAlg-enter)
308 (or calc-emacs-type-19
310 (setq calc-alg-ent-esc-map (copy-sequence esc-map))
312 (aset calc-alg-ent-esc-map i 'calcAlg-escape)
314 (unless calc-emacs-type-19
315 (define-key calc-alg-ent-map "\e" nil))
316 (if (eq calc-algebraic-mode 'total)
317 (define-key calc-alg-ent-map "\e" calc-alg-ent-esc-map)
318 (define-key calc-alg-ent-map "\ep" 'calcAlg-plus-minus)
319 (define-key calc-alg-ent-map "\em" 'calcAlg-mod)
320 (define-key calc-alg-ent-map "\e=" 'calcAlg-equals)
321 (define-key calc-alg-ent-map "\e\r" 'calcAlg-equals)
322 (define-key calc-alg-ent-map "\e%" 'self-insert-command))
323 (setq calc-aborted-prefix nil)
324 (let ((buf (read-from-minibuffer (or prompt "Algebraic: ")
326 calc-alg-ent-map nil)))
327 (when (eq alg-exp 'error)
328 (when (eq (car-safe (setq alg-exp (math-read-exprs buf))) 'error)
330 (setq calc-aborted-prefix "alg'")
332 (and alg-exp (setq alg-exp (mapcar 'calc-normalize alg-exp))))
335 (defun calcAlg-plus-minus ()
337 (if (calc-minibuffer-contains ".* \\'")
341 (defun calcAlg-mod ()
343 (if (not (calc-minibuffer-contains ".* \\'"))
345 (if (calc-minibuffer-contains ".* mod +\\'")
346 (if calc-previous-modulo
347 (insert (math-format-flat-expr calc-previous-modulo 0))
351 (defun calcAlg-previous ()
353 (if (calc-minibuffer-contains "\\`\\'")
354 (if calc-previous-alg-entry
355 (insert calc-previous-alg-entry)
359 (defun calcAlg-equals ()
364 (progn (setq prefix-arg (length alg-exp))
365 (calc-unread-command ?=)))))
367 (defun calcAlg-escape ()
369 (calc-unread-command)
372 (use-local-map calc-mode-map))
375 (defvar calc-plain-entry nil)
376 (defun calcAlg-edit ()
378 (if (or (not calc-plain-entry)
379 (calc-minibuffer-contains
380 "\\`\\([^\"]*\"[^\"]*\"\\)*[^\"]*\"[^\"]*\\'"))
382 (setq alg-exp (minibuffer-contents))
383 (and (> (length alg-exp) 0) (setq calc-previous-alg-entry alg-exp))
386 (defun calcAlg-enter ()
388 (let* ((str (minibuffer-contents))
389 (exp (and (> (length str) 0)
391 (set-buffer calc-buffer)
392 (math-read-exprs str)))))
393 (if (eq (car-safe exp) 'error)
395 (goto-char (minibuffer-prompt-end))
396 (forward-char (nth 1 exp))
398 (calc-temp-minibuffer-message
399 (concat " [" (or (nth 2 exp) "Error") "]"))
400 (calc-clear-unread-commands))
401 (setq alg-exp (if (calc-minibuffer-contains "\\` *\\[ *\\'")
404 (and (> (length str) 0) (setq calc-previous-alg-entry str))
407 (defun calcAlg-blink-matching-open ()
408 (let ((oldpos (point))
412 (setq blinkpos (scan-sexps oldpos -1))
415 (> oldpos (1+ (point-min)))
416 (or (and (= (char-after (1- oldpos)) ?\))
417 (= (char-after blinkpos) ?\[))
418 (and (= (char-after (1- oldpos)) ?\])
419 (= (char-after blinkpos) ?\()))
422 (looking-at ".+\\(\\.\\.\\|\\\\dots\\|\\\\ldots\\)")))
423 (let ((saved (aref (syntax-table) (char-after blinkpos))))
426 (aset (syntax-table) (char-after blinkpos)
427 (+ (logand saved 255)
428 (lsh (char-after (1- oldpos)) 8)))
429 (blink-matching-open))
430 (aset (syntax-table) (char-after blinkpos) saved)))
431 (blink-matching-open))))
434 (defun calc-alg-digit-entry ()
436 (cond ((eq last-command-char ?e)
437 (if (> calc-number-radix 14) (format "%d.^" calc-number-radix) "1e"))
438 ((eq last-command-char ?#) (format "%d#" calc-number-radix))
439 ((eq last-command-char ?_) "-")
440 ((eq last-command-char ?@) "0@ ")
441 (t (char-to-string last-command-char)))))
443 (defun calcDigit-algebraic ()
445 (if (calc-minibuffer-contains ".*[@oh] *[^'m ]+[^'m]*\\'")
447 (setq calc-digit-value (minibuffer-contents))
450 (defun calcDigit-edit ()
452 (calc-unread-command)
453 (setq calc-digit-value (minibuffer-contents))
457 ;;; Algebraic expression parsing. [Public]
459 (defun math-read-exprs (exp-str)
462 (exp-keep-spaces nil)
464 (if calc-language-input-filter
465 (setq exp-str (funcall calc-language-input-filter exp-str)))
466 (while (setq exp-token (string-match "\\.\\.\\([^.]\\|.[^.]\\)" exp-str))
467 (setq exp-str (concat (substring exp-str 0 exp-token) "\\dots"
468 (substring exp-str (+ exp-token 2)))))
469 (math-build-parse-table)
471 (let ((val (catch 'syntax (math-read-expr-list))))
473 (list 'error exp-old-pos val)
474 (if (equal exp-token 'end)
476 (list 'error exp-old-pos "Syntax error"))))))
478 (defun math-read-expr-list ()
479 (let* ((exp-keep-spaces nil)
480 (val (list (math-read-expr-level 0)))
482 (while (equal exp-data ",")
484 (let ((rest (list (math-read-expr-level 0))))
489 (defvar calc-user-parse-table nil)
490 (defvar calc-last-main-parse-table nil)
491 (defvar calc-last-lang-parse-table nil)
492 (defvar calc-user-tokens nil)
493 (defvar calc-user-token-chars nil)
495 (defun math-build-parse-table ()
496 (let ((mtab (cdr (assq nil calc-user-parse-tables)))
497 (ltab (cdr (assq calc-language calc-user-parse-tables))))
498 (or (and (eq mtab calc-last-main-parse-table)
499 (eq ltab calc-last-lang-parse-table))
500 (let ((p (append mtab ltab))
502 (setq calc-user-parse-table p)
503 (setq calc-user-token-chars nil)
505 (math-find-user-tokens (car (car p)))
507 (setq calc-user-tokens (mapconcat 'identity
508 (sort (mapcar 'car toks)
509 (function (lambda (x y)
513 calc-last-main-parse-table mtab
514 calc-last-lang-parse-table ltab)))))
516 (defun math-find-user-tokens (p) ; uses "toks"
518 (cond ((and (stringp (car p))
519 (or (> (length (car p)) 1) (equal (car p) "$")
520 (equal (car p) "\""))
521 (string-match "[^a-zA-Z0-9]" (car p)))
522 (let ((s (regexp-quote (car p))))
523 (if (string-match "\\`[a-zA-Z0-9]" s)
524 (setq s (concat "\\<" s)))
525 (if (string-match "[a-zA-Z0-9]\\'" s)
526 (setq s (concat s "\\>")))
529 (setq toks (cons (list s) toks))
530 (or (memq (aref (car p) 0) calc-user-token-chars)
531 (setq calc-user-token-chars
532 (cons (aref (car p) 0)
533 calc-user-token-chars)))))))
535 (math-find-user-tokens (nth 1 (car p)))
536 (or (eq (car (car p)) '\?)
537 (math-find-user-tokens (nth 2 (car p))))))
540 (defun math-read-token ()
541 (if (>= exp-pos (length exp-str))
542 (setq exp-old-pos exp-pos
545 (let ((ch (aref exp-str exp-pos)))
546 (setq exp-old-pos exp-pos)
547 (cond ((memq ch '(32 10 9))
548 (setq exp-pos (1+ exp-pos))
550 (setq exp-token 'space
553 ((and (memq ch calc-user-token-chars)
554 (let ((case-fold-search nil))
555 (eq (string-match calc-user-tokens exp-str exp-pos)
557 (setq exp-token 'punc
558 exp-data (math-match-substring exp-str 0)
559 exp-pos (match-end 0)))
560 ((or (and (>= ch ?a) (<= ch ?z))
561 (and (>= ch ?A) (<= ch ?Z)))
562 (string-match (if (memq calc-language '(c fortran pascal maple))
566 (setq exp-token 'symbol
567 exp-pos (match-end 0)
568 exp-data (math-restore-dashes
569 (math-match-substring exp-str 0)))
570 (if (eq calc-language 'eqn)
571 (let ((code (assoc exp-data math-eqn-ignore-words)))
575 ((consp (nth 1 code))
577 (if (assoc exp-data (cdr code))
578 (setq exp-data (format "%s %s"
579 (car code) exp-data))))
580 ((eq (nth 1 code) 'punc)
581 (setq exp-token 'punc
582 exp-data (nth 2 code)))
585 (math-read-token))))))
586 ((or (and (>= ch ?0) (<= ch ?9))
588 (eq (string-match "\\.[0-9]" exp-str exp-pos) exp-pos))
590 (eq (string-match "_\\.?[0-9]" exp-str exp-pos) exp-pos)
592 (and (memq calc-language '(nil flat big unform
594 (eq (string-match "[^])}\"a-zA-Z0-9'$]_"
595 exp-str (1- exp-pos))
597 (or (and (eq calc-language 'c)
598 (string-match "0[xX][0-9a-fA-F]+" exp-str exp-pos))
599 (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]+\\)?\"?\\)?" exp-str exp-pos))
600 (setq exp-token 'number
601 exp-data (math-match-substring exp-str 0)
602 exp-pos (match-end 0)))
604 (if (and (eq calc-language 'pascal)
606 "\\(\\$[0-9a-fA-F]+\\)\\($\\|[^0-9a-zA-Z]\\)"
609 (setq exp-token 'number
610 exp-data (math-match-substring exp-str 1)
611 exp-pos (match-end 1))
612 (if (eq (string-match "\\$\\([1-9][0-9]*\\)" exp-str exp-pos)
614 (setq exp-data (- (string-to-int (math-match-substring
616 (string-match "\\$+" exp-str exp-pos)
617 (setq exp-data (- (match-end 0) (match-beginning 0))))
618 (setq exp-token 'dollar
619 exp-pos (match-end 0))))
621 (if (eq (string-match "#\\([1-9][0-9]*\\)" exp-str exp-pos)
623 (setq exp-data (string-to-int
624 (math-match-substring exp-str 1))
625 exp-pos (match-end 0))
627 exp-pos (1+ exp-pos)))
628 (setq exp-token 'hash))
629 ((eq (string-match "~=\\|<=\\|>=\\|<>\\|/=\\|\\+/-\\|\\\\dots\\|\\\\ldots\\|\\*\\*\\|<<\\|>>\\|==\\|!=\\|&&&\\||||\\|!!!\\|&&\\|||\\|!!\\|:=\\|::\\|=>"
632 (setq exp-token 'punc
633 exp-data (math-match-substring exp-str 0)
634 exp-pos (match-end 0)))
636 (string-match "\\(\"\\([^\"\\]\\|\\\\.\\)*\\)\\(\"\\|\\'\\)" exp-str exp-pos))
637 (if (eq calc-language 'eqn)
639 (setq exp-str (copy-sequence exp-str))
640 (aset exp-str (match-beginning 1) ?\{)
641 (if (< (match-end 1) (length exp-str))
642 (aset exp-str (match-end 1) ?\}))
644 (setq exp-token 'string
645 exp-data (math-match-substring exp-str 1)
646 exp-pos (match-end 0))))
647 ((and (= ch ?\\) (eq calc-language 'tex)
648 (< exp-pos (1- (length exp-str))))
649 (or (string-match "\\\\hbox *{\\([a-zA-Z0-9]+\\)}" exp-str exp-pos)
650 (string-match "\\(\\\\\\([a-zA-Z]+\\|[^a-zA-Z]\\)\\)" exp-str exp-pos))
651 (setq exp-token 'symbol
652 exp-pos (match-end 0)
653 exp-data (math-restore-dashes
654 (math-match-substring exp-str 1)))
655 (let ((code (assoc exp-data math-tex-ignore-words)))
659 ((eq (nth 1 code) 'punc)
660 (setq exp-token 'punc
661 exp-data (nth 2 code)))
662 ((and (eq (nth 1 code) 'mat)
663 (string-match " *{" exp-str exp-pos))
664 (setq exp-pos (match-end 0)
667 (let ((right (string-match "}" exp-str exp-pos)))
669 (setq exp-str (copy-sequence exp-str))
670 (aset exp-str right ?\])))))))
671 ((and (= ch ?\.) (eq calc-language 'fortran)
672 (eq (string-match "\\.[a-zA-Z][a-zA-Z][a-zA-Z]?\\."
673 exp-str exp-pos) exp-pos))
674 (setq exp-token 'punc
675 exp-data (upcase (math-match-substring exp-str 0))
676 exp-pos (match-end 0)))
677 ((and (eq calc-language 'math)
678 (eq (string-match "\\[\\[\\|->\\|:>" exp-str exp-pos)
680 (setq exp-token 'punc
681 exp-data (math-match-substring exp-str 0)
682 exp-pos (match-end 0)))
683 ((and (eq calc-language 'eqn)
684 (eq (string-match "->\\|<-\\|+-\\|\\\\dots\\|~\\|\\^"
687 (setq exp-token 'punc
688 exp-data (math-match-substring exp-str 0)
689 exp-pos (match-end 0))
690 (and (eq (string-match "\\\\dots\\." exp-str exp-pos) exp-pos)
691 (setq exp-pos (match-end 0)))
692 (if (memq (aref exp-data 0) '(?~ ?^))
694 ((eq (string-match "%%.*$" exp-str exp-pos) exp-pos)
695 (setq exp-pos (match-end 0))
698 (if (and (eq ch ?\{) (memq calc-language '(tex eqn)))
700 (if (and (eq ch ?\}) (memq calc-language '(tex eqn)))
702 (if (and (eq ch ?\&) (eq calc-language 'tex))
704 (setq exp-token 'punc
705 exp-data (char-to-string ch)
706 exp-pos (1+ exp-pos)))))))
709 (defun math-read-expr-level (exp-prec &optional exp-term)
710 (let* ((x (math-read-factor)) (first t) op op2)
711 (while (and (or (and calc-user-parse-table
712 (setq op (calc-check-user-syntax x exp-prec))
714 op '("2x" ident 999999 -1)))
715 (and (setq op (assoc exp-data math-expr-opers))
717 (or (and (setq op2 (assoc
719 (cdr (memq op math-expr-opers))))
720 (eq (= (nth 3 op) -1)
722 (eq (= (nth 3 op2) -1)
723 (not (math-factor-after)))
726 (and (or (eq (nth 2 op) -1)
727 (memq exp-token '(symbol number dollar hash))
729 (and (equal exp-data "[")
730 (not (eq calc-language 'math))
731 (not (and exp-keep-spaces
732 (eq (car-safe x) 'vec)))))
733 (or (not (setq op (assoc exp-data math-expr-opers)))
735 (or (not calc-user-parse-table)
736 (not (eq exp-token 'symbol))
737 (let ((p calc-user-parse-table))
740 (car (car (car p)))))
742 (nth 1 (car (car p)))
746 (setq op (assoc "2x" math-expr-opers))))
747 (not (and exp-term (equal exp-data exp-term)))
748 (>= (nth 2 op) exp-prec))
749 (if (not (equal (car op) "2x"))
751 (and (memq (nth 1 op) '(sdev mod))
753 (setq x (cond ((consp (nth 1 op))
754 (funcall (car (nth 1 op)) x op))
756 (if (eq (nth 1 op) 'ident)
758 (if (eq (nth 1 op) 'closing)
759 (if (eq (nth 2 op) exp-prec)
763 (throw 'syntax "Mismatched delimiters"))
764 (list (nth 1 op) x))))
766 (memq (nth 1 op) math-alg-inequalities)
767 (memq (car-safe x) math-alg-inequalities))
769 (math-composite-inequalities x op))
772 (math-read-expr-level (nth 3 op) exp-term))))
776 (defun calc-check-user-syntax (&optional x prec)
777 (let ((p calc-user-parse-table)
782 (setq rule (car (car p)))
784 (and (integerp (car rule))
787 (car (setq rule (cdr rule)))))
788 (equal exp-data (car rule)))))
789 (let ((save-exp-pos exp-pos)
790 (save-exp-old-pos exp-old-pos)
791 (save-exp-token exp-token)
792 (save-exp-data exp-data))
794 (setq matches (calc-match-user-syntax rule))))
801 (setq matches (cons x matches)))
802 (setq match (cdr (car p)))
803 (while (and (eq (car-safe match)
805 (= (length match) 3))
806 (setq conds (append (math-flatten-lands
809 match (nth 1 match)))
810 (while (and conds match)
812 (cond ((eq (car-safe (car conds))
814 (setq temp (car conds))
815 (or (= (length temp) 3)
816 (and (= (length temp) 2)
817 (eq (car-safe (nth 1 temp))
819 (= (length (nth 1 temp)) 3)
820 (setq temp (nth 1 temp)))
828 args (cons (nth 1 temp)
830 ((and (eq (car-safe (car conds))
832 (= (length (car conds)) 3))
833 (setq temp (calcFunc-vmatches
837 (nth 2 (car conds))))
840 (while (setq temp (cdr temp))
841 (setq matches (cons (nth 2 (car temp))
843 args (cons (nth 1 (car temp))
846 (or (math-is-true (math-simplify
851 (setq conds (cdr conds)))
853 (not (setq match (math-multi-subst
854 match args matches)))
855 (setq exp-old-pos save-exp-old-pos
856 exp-token save-exp-token
857 exp-data save-exp-data
858 exp-pos save-exp-pos)))))))
862 (defun calc-match-user-syntax (p &optional term)
864 (save-exp-pos exp-pos)
865 (save-exp-old-pos exp-old-pos)
866 (save-exp-token exp-token)
867 (save-exp-data exp-data))
869 (cond ((stringp (car p))
870 (and (equal exp-data (car p))
875 (and (setq m (catch 'syntax
876 (math-read-expr-level
879 (if (consp (nth 1 p))
880 (car (nth 1 (nth 1 p)))
884 (setq matches (nconc matches (list m)))))
885 ((eq (car (car p)) '\?)
886 (setq m (calc-match-user-syntax (nth 1 (car p))))
891 (cons 'vec (and (listp m) m))))))
892 (or (listp m) (not (nth 2 (car p)))
893 (not (eq (aref (car (nth 2 (car p))) 0) ?\$))
894 (eq exp-token 'end)))
896 (setq m (calc-match-user-syntax (nth 1 (car p))
897 (car (nth 2 (car p)))))
899 (let ((vec (cons 'vec m))
903 mm (calc-match-user-syntax
906 (car (nth 2 (car p))))))
908 (setq vec (nconc vec mm)))
909 (setq matches (nconc matches (list vec))))
910 (and (eq (car (car p)) '*)
911 (setq matches (nconc matches (list '(vec)))))))))
914 (setq exp-pos save-exp-pos
915 exp-old-pos save-exp-old-pos
916 exp-token save-exp-token
917 exp-data save-exp-data
921 (defconst math-alg-inequalities
922 '(calcFunc-lt calcFunc-gt calcFunc-leq calcFunc-geq
923 calcFunc-eq calcFunc-neq))
925 (defun math-remove-dashes (x)
926 (if (string-match "\\`\\(.*\\)-\\(.*\\)\\'" x)
928 (concat (math-match-substring x 1) "#" (math-match-substring x 2)))
931 (defun math-restore-dashes (x)
932 (if (string-match "\\`\\(.*\\)[#_]\\(.*\\)\\'" x)
934 (concat (math-match-substring x 1) "-" (math-match-substring x 2)))
937 (defun math-read-if (cond op)
938 (let ((then (math-read-expr-level 0)))
939 (or (equal exp-data ":")
940 (throw 'syntax "Expected ':'"))
942 (list 'calcFunc-if cond then (math-read-expr-level (nth 3 op)))))
944 (defun math-factor-after ()
945 (let ((exp-pos exp-pos)
946 exp-old-pos exp-token exp-data)
948 (or (memq exp-token '(number symbol dollar hash string))
949 (and (assoc exp-data '(("-") ("+") ("!") ("|") ("/")))
950 (assoc (concat "u" exp-data) math-expr-opers))
951 (eq (nth 2 (assoc exp-data math-expr-opers)) -1)
952 (assoc exp-data '(("(") ("[") ("{"))))))
954 (defun math-read-factor ()
956 (cond ((eq exp-token 'number)
957 (let ((num (math-read-number exp-data)))
960 (setq exp-old-pos exp-pos)
961 (throw 'syntax "Bad format")))
963 (if (and math-read-expr-quotes
967 ((and calc-user-parse-table
968 (setq op (calc-check-user-syntax)))
970 ((or (equal exp-data "-")
974 (equal exp-data "/"))
975 (setq exp-data (concat "u" exp-data))
977 ((and (setq op (assoc exp-data math-expr-opers))
979 (if (consp (nth 1 op))
980 (funcall (car (nth 1 op)) op)
982 (let ((val (math-read-expr-level (nth 3 op))))
983 (cond ((eq (nth 1 op) 'ident)
985 ((and (Math-numberp val)
986 (equal (car op) "u-"))
988 (t (list (nth 1 op) val))))))
989 ((eq exp-token 'symbol)
990 (let ((sym (intern exp-data)))
992 (if (equal exp-data calc-function-open)
993 (let ((f (assq sym math-expr-function-mapping)))
996 (funcall (car (cdr f)) f sym)
997 (let ((args (if (or (equal exp-data calc-function-close)
1000 (math-read-expr-list))))
1001 (if (not (or (equal exp-data calc-function-close)
1002 (eq exp-token 'end)))
1003 (throw 'syntax "Expected `)'"))
1005 (if (and (eq calc-language 'fortran) args
1007 (let ((calc-matrix-mode 'scalar))
1012 (symbol-name sym)))))))
1013 (math-parse-fortran-subscr sym args)
1016 (and (= (aref (symbol-name sym) 0) ?\\)
1017 (< (prefix-numeric-value calc-language-option)
1019 (setq sym (intern (substring (symbol-name sym)
1021 (or (string-match "-" (symbol-name sym))
1024 (symbol-name sym))))))
1026 (if math-read-expr-quotes
1028 (let ((val (list 'var
1029 (intern (math-remove-dashes
1031 (if (string-match "-" (symbol-name sym))
1033 (intern (concat "var-"
1034 (symbol-name sym)))))))
1035 (let ((v (assq (nth 1 val) math-expr-variable-mapping)))
1036 (and v (setq val (if (consp (cdr v))
1037 (funcall (car (cdr v)) v val)
1040 (substring (symbol-name (cdr v))
1043 (while (and (memq calc-language '(c pascal maple))
1044 (equal exp-data "["))
1046 (setq val (append (list 'calcFunc-subscr val)
1047 (math-read-expr-list)))
1048 (if (equal exp-data "]")
1050 (throw 'syntax "Expected ']'")))
1052 ((eq exp-token 'dollar)
1053 (let ((abs (if (> exp-data 0) exp-data (- exp-data))))
1054 (if (>= (length calc-dollar-values) abs)
1055 (let ((num exp-data))
1057 (setq calc-dollar-used (max calc-dollar-used num))
1058 (math-check-complete (nth (1- abs) calc-dollar-values)))
1059 (throw 'syntax (if calc-dollar-values
1061 "$'s not allowed in this context")))))
1062 ((eq exp-token 'hash)
1063 (or calc-hashes-used
1064 (throw 'syntax "#'s not allowed in this context"))
1066 (if (<= exp-data (length calc-arg-values))
1067 (let ((num exp-data))
1069 (setq calc-hashes-used (max calc-hashes-used num))
1070 (nth (1- num) calc-arg-values))
1071 (throw 'syntax "Too many # arguments")))
1072 ((equal exp-data "(")
1073 (let* ((exp (let ((exp-keep-spaces nil))
1075 (if (or (equal exp-data "\\dots")
1076 (equal exp-data "\\ldots"))
1077 '(neg (var inf var-inf))
1078 (math-read-expr-level 0)))))
1079 (let ((exp-keep-spaces nil))
1081 ((equal exp-data ",")
1084 (let ((exp2 (math-read-expr-level 0)))
1086 (if (and exp2 (Math-realp exp) (Math-realp exp2))
1087 (math-normalize (list 'cplx exp exp2))
1088 (list '+ exp (list '* exp2 '(var i var-i))))))))
1089 ((equal exp-data ";")
1092 (let ((exp2 (math-read-expr-level 0)))
1093 (setq exp (if (and exp2 (Math-realp exp)
1095 (math-normalize (list 'polar exp exp2))
1100 (math-to-radians-2 exp2)
1101 '(var i var-i)))))))))
1102 ((or (equal exp-data "\\dots")
1103 (equal exp-data "\\ldots"))
1106 (let ((exp2 (if (or (equal exp-data ")")
1107 (equal exp-data "]")
1108 (eq exp-token 'end))
1110 (math-read-expr-level 0))))
1113 (if (equal exp-data ")") 0 1)
1116 (if (not (or (equal exp-data ")")
1117 (and (equal exp-data "]") (eq (car-safe exp) 'intv))
1118 (eq exp-token 'end)))
1119 (throw 'syntax "Expected `)'"))
1122 ((eq exp-token 'string)
1125 ((equal exp-data "[")
1127 (math-read-brackets t "]"))
1128 ((equal exp-data "{")
1130 (math-read-brackets nil "}"))
1131 ((equal exp-data "<")
1133 (math-read-angle-brackets))
1134 (t (throw 'syntax "Expected a number")))))
1136 ;;; calc-aent.el ends here