1 ;; Calculator for GNU Emacs, part I [calc-aent.el]
2 ;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc.
3 ;; Written by Dave Gillespie, daveg@synaptics.com.
5 ;; This file is part of GNU Emacs.
7 ;; GNU Emacs is distributed in the hope that it will be useful,
8 ;; but WITHOUT ANY WARRANTY. No author or distributor
9 ;; accepts responsibility to anyone for the consequences of using it
10 ;; or for whether it serves any particular purpose or works at all,
11 ;; unless he says so in writing. Refer to the GNU Emacs General Public
12 ;; License for full details.
14 ;; Everyone is granted permission to copy, modify and redistribute
15 ;; GNU Emacs, but only under the conditions described in the
16 ;; GNU Emacs General Public License. A copy of this license is
17 ;; supposed to have been given to you along with GNU Emacs so you
18 ;; can know your rights and responsibilities. It should be in a
19 ;; file named COPYING. Among other things, the copyright notice
20 ;; and this notice must be preserved on all copies.
24 ;; This file is autoloaded from calc.el.
29 (defun calc-Need-calc-aent () nil)
32 (defun calc-do-quick-calc ()
34 (if (eq major-mode 'calc-mode)
35 (calc-algebraic-entry t)
39 (let* ((calc-command-flags nil)
40 (calc-dollar-values calc-quick-prev-results)
42 (enable-recursive-minibuffers t)
43 (calc-language (if (memq calc-language '(nil big))
45 (entry (calc-do-alg-entry "" "Quick calc: " t))
46 (alg-exp (mapcar (function
48 (if (and (not calc-extensions-loaded)
49 calc-previous-alg-entry
51 "\\`[-0-9._+*/^() ]+\\'"
52 calc-previous-alg-entry))
55 (math-evaluate-expr x))))
57 (if (and (= (length alg-exp) 1)
58 (eq (car-safe (car alg-exp)) 'calcFunc-assign)
59 (= (length (car alg-exp)) 3)
60 (eq (car-safe (nth 1 (car alg-exp))) 'var))
63 (set (nth 2 (nth 1 (car alg-exp))) (nth 2 (car alg-exp)))
64 (calc-refresh-evaltos (nth 2 (nth 1 (car alg-exp))))
65 (setq alg-exp (list (nth 2 (car alg-exp))))))
66 (setq calc-quick-prev-results alg-exp
67 buf (mapconcat (function (lambda (x)
68 (math-format-value x 1000)))
72 (if (and (= (length alg-exp) 1)
73 (memq (car-safe (car alg-exp)) '(nil bigpos bigneg))
75 (= calc-number-radix 10))
76 (setq buf (concat buf " ("
77 (let ((calc-number-radix 16))
78 (math-format-value (car alg-exp) 1000))
80 (let ((calc-number-radix 8))
81 (math-format-value (car alg-exp) 1000))
82 (if (and (integerp (car alg-exp))
84 (< (car alg-exp) 127))
85 (format ", \"%c\"" (car alg-exp))
88 (if (and (< (length buf) (frame-width)) (= (length entry) 1)
89 calc-extensions-loaded)
90 (let ((long (concat (math-format-value (car entry) 1000)
92 (if (<= (length long) (- (frame-width) 8))
95 (message "Result: %s" buf)))
96 (if (eq last-command-char ?\n)
98 (setq kill-ring (cons shortbuf kill-ring))
99 (if (> (length kill-ring) kill-ring-max)
100 (setcdr (nthcdr (1- kill-ring-max) kill-ring) nil))
101 (setq kill-ring-yank-pointer kill-ring))))
104 (defun calc-do-calc-eval (str separator args)
110 ((and (consp str) (not (symbolp (car str))))
111 (let ((calc-language nil)
112 (math-expr-opers math-standard-opers)
113 (calc-internal-prec 12)
115 (calc-symbolic-mode nil)
116 (calc-matrix-mode nil)
117 (calc-angle-mode 'deg)
118 (calc-number-radix 10)
119 (calc-leading-zeros nil)
120 (calc-group-digits nil)
121 (calc-point-char ".")
122 (calc-frac-format '(":" nil))
123 (calc-prefer-frac nil)
124 (calc-hms-format "%s@ %s' %s\"")
125 (calc-date-format '((H ":" mm C SS pp " ")
126 Www " " Mmm " " D ", " YYYY))
127 (calc-float-format '(float 0))
128 (calc-full-float-format '(float 0))
129 (calc-complex-format nil)
130 (calc-matrix-just nil)
131 (calc-full-vectors t)
132 (calc-break-vectors nil)
133 (calc-vector-commas ",")
134 (calc-vector-brackets "[]")
135 (calc-matrix-brackets '(R O))
136 (calc-complex-mode 'cplx)
137 (calc-infinite-mode nil)
138 (calc-display-strings nil)
139 (calc-simplify-mode nil)
140 (calc-display-working-message 'lots)
143 (set (car strp) (nth 1 strp))
144 (setq strp (cdr (cdr strp))))
145 (calc-do-calc-eval (car str) separator args)))
146 ((eq separator 'eval)
148 ((eq separator 'macro)
150 (let* ((calc-buffer (current-buffer))
151 (calc-window (get-buffer-window calc-buffer))
152 (save-window (selected-window)))
156 (select-window calc-window)
157 (calc-execute-kbd-macro str nil (car args)))
158 (and (window-point save-window)
159 (select-window save-window)))
160 (save-window-excursion
161 (select-window (get-largest-window))
162 (switch-to-buffer calc-buffer)
163 (calc-execute-kbd-macro str nil (car args)))))
166 (or (not (integerp str))
168 (calc-pop (min str (calc-stack-size))))
173 (<= str (calc-stack-size))
174 (math-format-value (calc-top-n str (car args)) 1000)))
175 ((eq separator 'rawtop)
178 (<= str (calc-stack-size))
179 (calc-top-n str (car args))))
181 (let* ((calc-command-flags nil)
183 (calc-language (if (memq calc-language '(nil big))
184 'flat calc-language))
185 (calc-dollar-values (mapcar
190 (setq x (math-read-exprs x))
200 (res (if (stringp str)
201 (math-read-exprs str)
204 (if (eq (car res) 'error)
205 (calc-eval-error (cdr res))
206 (setq res (mapcar 'calc-normalize res))
207 (and (memq 'clear-message calc-command-flags)
209 (cond ((eq separator 'pred)
211 (if (= (length res) 1)
212 (math-is-true (car res))
213 (calc-eval-error '(0 "Single value expected"))))
215 (if (= (length res) 1)
217 (calc-eval-error '(0 "Single value expected"))))
218 ((eq separator 'list)
220 ((memq separator '(num rawnum))
221 (if (= (length res) 1)
222 (if (math-constp (car res))
223 (if (eq separator 'num)
224 (math-format-value (car res) 1000)
229 (calc-explain-why (car calc-next-why))
230 "Number expected"))))
231 (calc-eval-error '(0 "Single value expected"))))
232 ((eq separator 'push)
236 (setq buf (concat buf
237 (and buf (or separator ", "))
238 (math-format-value (car res) 1000))
243 (defun calc-eval-error (msg)
244 (if (and (boundp 'calc-eval-error)
246 (if (eq calc-eval-error 'string)
248 (error "%s" (nth 1 msg)))
253 ;;;; Reading an expression in algebraic form.
255 (defun calc-auto-algebraic-entry (&optional prefix)
257 (calc-algebraic-entry prefix t)
260 (defun calc-algebraic-entry (&optional prefix auto)
263 (let ((calc-language (if prefix nil calc-language))
264 (math-expr-opers (if prefix math-standard-opers math-expr-opers)))
265 (calc-alg-entry (and auto (char-to-string last-command-char)))))
268 (defun calc-alg-entry (&optional initial prompt)
269 (let* ((sel-mode nil)
270 (calc-dollar-values (mapcar 'calc-get-stack-element
271 (nthcdr calc-stack-top calc-stack)))
274 (alg-exp (calc-do-alg-entry initial prompt t)))
275 (if (stringp alg-exp)
278 (calc-alg-edit alg-exp))
279 (let* ((calc-simplify-mode (if (eq last-command-char ?\C-j)
282 (nvals (mapcar 'calc-normalize alg-exp)))
284 (calc-record (if calc-extensions-loaded (car alg-exp) (car nvals))
286 (calc-pop-push-record-list calc-dollar-used
287 (and (not (equal (car alg-exp)
289 calc-extensions-loaded
292 (setq alg-exp (cdr alg-exp)
294 calc-dollar-used 0)))
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 (if (boundp 'calc-alg-ent-map)
304 (setq calc-alg-ent-map (copy-keymap minibuffer-local-map))
305 (define-key calc-alg-ent-map "'" 'calcAlg-previous)
306 (define-key calc-alg-ent-map "`" 'calcAlg-edit)
307 (define-key calc-alg-ent-map "\C-m" 'calcAlg-enter)
308 (define-key calc-alg-ent-map "\C-j" 'calcAlg-enter)
309 (or calc-emacs-type-19
311 (setq calc-alg-ent-esc-map (copy-sequence esc-map))
313 (aset calc-alg-ent-esc-map i 'calcAlg-escape)
315 (or calc-emacs-type-19
316 (define-key calc-alg-ent-map "\e" nil))
317 (if (eq calc-algebraic-mode 'total)
318 (define-key calc-alg-ent-map "\e" calc-alg-ent-esc-map)
319 (define-key calc-alg-ent-map "\ep" 'calcAlg-plus-minus)
320 (define-key calc-alg-ent-map "\em" 'calcAlg-mod)
321 (define-key calc-alg-ent-map "\e=" 'calcAlg-equals)
322 (define-key calc-alg-ent-map "\e\r" 'calcAlg-equals)
323 (define-key calc-alg-ent-map "\e%" 'self-insert-command))
324 (setq calc-aborted-prefix nil)
325 (let ((buf (read-from-minibuffer (or prompt "Algebraic: ")
327 calc-alg-ent-map nil)))
328 (if (eq alg-exp 'error)
329 (if (eq (car-safe (setq alg-exp (math-read-exprs buf))) 'error)
331 (setq calc-aborted-prefix "alg'")
333 (and alg-exp (setq alg-exp (mapcar 'calc-normalize alg-exp))))
337 (defun calcAlg-plus-minus ()
339 (if (calc-minibuffer-contains ".* \\'")
344 (defun calcAlg-mod ()
346 (if (not (calc-minibuffer-contains ".* \\'"))
348 (if (calc-minibuffer-contains ".* mod +\\'")
349 (if calc-previous-modulo
350 (insert (math-format-flat-expr calc-previous-modulo 0))
355 (defun calcAlg-previous ()
357 (if (calc-minibuffer-contains "\\`\\'")
358 (if calc-previous-alg-entry
359 (insert calc-previous-alg-entry)
364 (defun calcAlg-equals ()
369 (progn (setq prefix-arg (length alg-exp))
370 (calc-unread-command ?=))))
373 (defun calcAlg-escape ()
375 (calc-unread-command)
378 (use-local-map calc-mode-map))
382 (defun calcAlg-edit ()
384 (if (or (not calc-plain-entry)
385 (calc-minibuffer-contains
386 "\\`\\([^\"]*\"[^\"]*\"\\)*[^\"]*\"[^\"]*\\'"))
388 (setq alg-exp (buffer-string))
389 (and (> (length alg-exp) 0) (setq calc-previous-alg-entry alg-exp))
392 (setq calc-plain-entry nil)
394 (defun calcAlg-enter ()
396 (let* ((str (buffer-string))
397 (exp (and (> (length str) 0)
399 (set-buffer calc-buffer)
400 (math-read-exprs str)))))
401 (if (eq (car-safe exp) 'error)
403 (goto-char (point-min))
404 (forward-char (nth 1 exp))
406 (calc-temp-minibuffer-message
407 (concat " [" (or (nth 2 exp) "Error") "]"))
408 (calc-clear-unread-commands))
409 (setq alg-exp (if (calc-minibuffer-contains "\\` *\\[ *\\'")
412 (and (> (length str) 0) (setq calc-previous-alg-entry str))
416 (defun calcAlg-blink-matching-open ()
417 (let ((oldpos (point))
421 (setq blinkpos (scan-sexps oldpos -1))
424 (> oldpos (1+ (point-min)))
425 (or (and (= (char-after (1- oldpos)) ?\))
426 (= (char-after blinkpos) ?\[))
427 (and (= (char-after (1- oldpos)) ?\])
428 (= (char-after blinkpos) ?\()))
431 (looking-at ".+\\(\\.\\.\\|\\\\dots\\|\\\\ldots\\)")))
433 ((char-num (char-int (char-after blinkpos)))
434 (saved (aref (syntax-table) char-num)))
437 (aset (syntax-table) char-num
438 (+ (logand saved 255)
439 (lsh (char-int (char-after (1- oldpos))) 8)))
440 (blink-matching-open))
441 (aset (syntax-table) char-num saved)))
442 (blink-matching-open))))
444 (defun calc-alg-digit-entry ()
446 (cond ((eq last-command-char ?e)
447 (if (> calc-number-radix 14) (format "%d.^" calc-number-radix) "1e"))
448 ((eq last-command-char ?#) (format "%d#" calc-number-radix))
449 ((eq last-command-char ?_) "-")
450 ((eq last-command-char ?@) "0@ ")
451 (t (char-to-string last-command-char))))
454 (defun calcDigit-algebraic ()
456 (if (calc-minibuffer-contains ".*[@oh] *[^'m ]+[^'m]*\\'")
458 (setq calc-digit-value (buffer-string))
462 (defun calcDigit-edit ()
464 (calc-unread-command)
465 (setq calc-digit-value (buffer-string))
470 ;;; Algebraic expression parsing. [Public]
472 (defun math-read-exprs (exp-str)
475 (exp-keep-spaces nil)
477 (if calc-language-input-filter
478 (setq exp-str (funcall calc-language-input-filter exp-str)))
479 (while (setq exp-token (string-match "\\.\\.\\([^.]\\|.[^.]\\)" exp-str))
480 (setq exp-str (concat (substring exp-str 0 exp-token) "\\dots"
481 (substring exp-str (+ exp-token 2)))))
482 (math-build-parse-table)
484 (let ((val (catch 'syntax (math-read-expr-list))))
486 (list 'error exp-old-pos val)
487 (if (equal exp-token 'end)
489 (list 'error exp-old-pos "Syntax error")))))
492 (defun math-read-expr-list ()
493 (let* ((exp-keep-spaces nil)
494 (val (list (math-read-expr-level 0)))
496 (while (equal exp-data ",")
498 (let ((rest (list (math-read-expr-level 0))))
504 (setq calc-user-parse-table nil)
505 (setq calc-last-main-parse-table nil)
506 (setq calc-last-lang-parse-table nil)
507 (setq calc-user-tokens nil)
508 (setq calc-user-token-chars nil)
510 (defun math-build-parse-table ()
511 (let ((mtab (cdr (assq nil calc-user-parse-tables)))
512 (ltab (cdr (assq calc-language calc-user-parse-tables))))
513 (or (and (eq mtab calc-last-main-parse-table)
514 (eq ltab calc-last-lang-parse-table))
515 (let ((p (append mtab ltab))
517 (setq calc-user-parse-table p)
518 (setq calc-user-token-chars nil)
520 (math-find-user-tokens (car (car p)))
522 (setq calc-user-tokens (mapconcat 'identity
523 (sort (mapcar 'car toks)
524 (function (lambda (x y)
528 calc-last-main-parse-table mtab
529 calc-last-lang-parse-table ltab))))
532 (defun math-find-user-tokens (p) ; uses "toks"
534 (cond ((and (stringp (car p))
535 (or (> (length (car p)) 1) (equal (car p) "$")
536 (equal (car p) "\""))
537 (string-match "[^a-zA-Z0-9]" (car p)))
538 (let ((s (regexp-quote (car p))))
539 (if (string-match "\\`[a-zA-Z0-9]" s)
540 (setq s (concat "\\<" s)))
541 (if (string-match "[a-zA-Z0-9]\\'" s)
542 (setq s (concat s "\\>")))
545 (setq toks (cons (list s) toks))
546 (or (memq (aref (car p) 0) calc-user-token-chars)
547 (setq calc-user-token-chars
548 (cons (aref (car p) 0)
549 calc-user-token-chars)))))))
551 (math-find-user-tokens (nth 1 (car p)))
552 (or (eq (car (car p)) '\?)
553 (math-find-user-tokens (nth 2 (car p))))))
557 (defun math-read-token ()
558 (if (>= exp-pos (length exp-str))
559 (setq exp-old-pos exp-pos
562 (let ((ch (aref exp-str exp-pos)))
563 (setq exp-old-pos exp-pos)
564 (cond ((memq ch '(? ?\n ?\t))
565 (setq exp-pos (1+ exp-pos))
567 (setq exp-token 'space
570 ((and (memq ch calc-user-token-chars)
571 (let ((case-fold-search nil))
572 (eq (string-match calc-user-tokens exp-str exp-pos)
574 (setq exp-token 'punc
575 exp-data (math-match-substring exp-str 0)
576 exp-pos (match-end 0)))
577 ((or (and (>= ch ?a) (<= ch ?z))
578 (and (>= ch ?A) (<= ch ?Z)))
579 (string-match (if (memq calc-language '(c fortran pascal maple))
583 (setq exp-token 'symbol
584 exp-pos (match-end 0)
585 exp-data (math-restore-dashes
586 (math-match-substring exp-str 0)))
587 (if (eq calc-language 'eqn)
588 (let ((code (assoc exp-data math-eqn-ignore-words)))
592 ((consp (nth 1 code))
594 (if (assoc exp-data (cdr code))
595 (setq exp-data (format "%s %s"
596 (car code) exp-data))))
597 ((eq (nth 1 code) 'punc)
598 (setq exp-token 'punc
599 exp-data (nth 2 code)))
602 (math-read-token))))))
603 ((or (and (>= ch ?0) (<= ch ?9))
605 (eq (string-match "\\.[0-9]" exp-str exp-pos) exp-pos))
607 (eq (string-match "_\\.?[0-9]" exp-str exp-pos) exp-pos)
609 (and (memq calc-language '(nil flat big unform
611 (eq (string-match "[^])}\"a-zA-Z0-9'$]_"
612 exp-str (1- exp-pos))
614 (or (and (eq calc-language 'c)
615 (string-match "0[xX][0-9a-fA-F]+" exp-str exp-pos))
616 (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))
617 (setq exp-token 'number
618 exp-data (math-match-substring exp-str 0)
619 exp-pos (match-end 0)))
621 (if (and (eq calc-language 'pascal)
623 "\\(\\$[0-9a-fA-F]+\\)\\($\\|[^0-9a-zA-Z]\\)"
626 (setq exp-token 'number
627 exp-data (math-match-substring exp-str 1)
628 exp-pos (match-end 1))
629 (if (eq (string-match "\\$\\([1-9][0-9]*\\)" exp-str exp-pos)
631 (setq exp-data (- (string-to-int (math-match-substring
633 (string-match "\\$+" exp-str exp-pos)
634 (setq exp-data (- (match-end 0) (match-beginning 0))))
635 (setq exp-token 'dollar
636 exp-pos (match-end 0))))
638 (if (eq (string-match "#\\([1-9][0-9]*\\)" exp-str exp-pos)
640 (setq exp-data (string-to-int
641 (math-match-substring exp-str 1))
642 exp-pos (match-end 0))
644 exp-pos (1+ exp-pos)))
645 (setq exp-token 'hash))
646 ((eq (string-match "~=\\|<=\\|>=\\|<>\\|/=\\|\\+/-\\|\\\\dots\\|\\\\ldots\\|\\*\\*\\|<<\\|>>\\|==\\|!=\\|&&&\\||||\\|!!!\\|&&\\|||\\|!!\\|:=\\|::\\|=>"
649 (setq exp-token 'punc
650 exp-data (math-match-substring exp-str 0)
651 exp-pos (match-end 0)))
653 (string-match "\\(\"\\([^\"\\]\\|\\\\.\\)*\\)\\(\"\\|\\'\\)" exp-str exp-pos))
654 (if (eq calc-language 'eqn)
656 (setq exp-str (copy-sequence exp-str))
657 (aset exp-str (match-beginning 1) ?\{)
658 (if (< (match-end 1) (length exp-str))
659 (aset exp-str (match-end 1) ?\}))
661 (setq exp-token 'string
662 exp-data (math-match-substring exp-str 1)
663 exp-pos (match-end 0))))
664 ((and (= ch ?\\) (eq calc-language 'tex)
665 (< exp-pos (1- (length exp-str))))
666 (or (string-match "\\\\hbox *{\\([a-zA-Z0-9]+\\)}" exp-str exp-pos)
667 (string-match "\\(\\\\\\([a-zA-Z]+\\|[^a-zA-Z]\\)\\)" exp-str exp-pos))
668 (setq exp-token 'symbol
669 exp-pos (match-end 0)
670 exp-data (math-restore-dashes
671 (math-match-substring exp-str 1)))
672 (let ((code (assoc exp-data math-tex-ignore-words)))
676 ((eq (nth 1 code) 'punc)
677 (setq exp-token 'punc
678 exp-data (nth 2 code)))
679 ((and (eq (nth 1 code) 'mat)
680 (string-match " *{" exp-str exp-pos))
681 (setq exp-pos (match-end 0)
684 (let ((right (string-match "}" exp-str exp-pos)))
686 (setq exp-str (copy-sequence exp-str))
687 (aset exp-str right ?\])))))))
688 ((and (= ch ?\.) (eq calc-language 'fortran)
689 (eq (string-match "\\.[a-zA-Z][a-zA-Z][a-zA-Z]?\\."
690 exp-str exp-pos) exp-pos))
691 (setq exp-token 'punc
692 exp-data (upcase (math-match-substring exp-str 0))
693 exp-pos (match-end 0)))
694 ((and (eq calc-language 'math)
695 (eq (string-match "\\[\\[\\|->\\|:>" exp-str exp-pos)
697 (setq exp-token 'punc
698 exp-data (math-match-substring exp-str 0)
699 exp-pos (match-end 0)))
700 ((and (eq calc-language 'eqn)
701 (eq (string-match "->\\|<-\\|+-\\|\\\\dots\\|~\\|\\^"
704 (setq exp-token 'punc
705 exp-data (math-match-substring exp-str 0)
706 exp-pos (match-end 0))
707 (and (eq (string-match "\\\\dots\\." exp-str exp-pos) exp-pos)
708 (setq exp-pos (match-end 0)))
709 (if (memq (aref exp-data 0) '(?~ ?^))
711 ((eq (string-match "%%.*$" exp-str exp-pos) exp-pos)
712 (setq exp-pos (match-end 0))
715 (if (and (eq ch ?\{) (memq calc-language '(tex eqn)))
717 (if (and (eq ch ?\}) (memq calc-language '(tex eqn)))
719 (if (and (eq ch ?\&) (eq calc-language 'tex))
721 (setq exp-token 'punc
722 exp-data (char-to-string ch)
723 exp-pos (1+ exp-pos))))))
727 (defun math-read-expr-level (exp-prec &optional exp-term)
728 (let* ((x (math-read-factor)) (first t) op op2)
729 (while (and (or (and calc-user-parse-table
730 (setq op (calc-check-user-syntax x exp-prec))
732 op '("2x" ident 999999 -1)))
733 (and (setq op (assoc exp-data math-expr-opers))
735 (or (and (setq op2 (assoc
737 (cdr (memq op math-expr-opers))))
738 (eq (= (nth 3 op) -1)
740 (eq (= (nth 3 op2) -1)
741 (not (math-factor-after)))
744 (and (or (eq (nth 2 op) -1)
745 (memq exp-token '(symbol number dollar hash))
747 (and (equal exp-data "[")
748 (not (eq calc-language 'math))
749 (not (and exp-keep-spaces
750 (eq (car-safe x) 'vec)))))
751 (or (not (setq op (assoc exp-data math-expr-opers)))
753 (or (not calc-user-parse-table)
754 (not (eq exp-token 'symbol))
755 (let ((p calc-user-parse-table))
758 (car (car (car p)))))
760 (nth 1 (car (car p)))
764 (setq op (assoc "2x" math-expr-opers))))
765 (not (and exp-term (equal exp-data exp-term)))
766 (>= (nth 2 op) exp-prec))
767 (if (not (equal (car op) "2x"))
769 (and (memq (nth 1 op) '(sdev mod))
771 (setq x (cond ((consp (nth 1 op))
772 (funcall (car (nth 1 op)) x op))
774 (if (eq (nth 1 op) 'ident)
776 (if (eq (nth 1 op) 'closing)
777 (if (eq (nth 2 op) exp-prec)
781 (throw 'syntax "Mismatched delimiters"))
782 (list (nth 1 op) x))))
784 (memq (nth 1 op) math-alg-inequalities)
785 (memq (car-safe x) math-alg-inequalities))
787 (math-composite-inequalities x op))
790 (math-read-expr-level (nth 3 op) exp-term))))
795 (defun calc-check-user-syntax (&optional x prec)
796 (let ((p calc-user-parse-table)
801 (setq rule (car (car p)))
803 (and (integerp (car rule))
806 (car (setq rule (cdr rule)))))
807 (equal exp-data (car rule)))))
808 (let ((save-exp-pos exp-pos)
809 (save-exp-old-pos exp-old-pos)
810 (save-exp-token exp-token)
811 (save-exp-data exp-data))
813 (setq matches (calc-match-user-syntax rule))))
820 (setq matches (cons x matches)))
821 (setq match (cdr (car p)))
822 (while (and (eq (car-safe match)
824 (= (length match) 3))
825 (setq conds (append (math-flatten-lands
828 match (nth 1 match)))
829 (while (and conds match)
831 (cond ((eq (car-safe (car conds))
833 (setq temp (car conds))
834 (or (= (length temp) 3)
835 (and (= (length temp) 2)
836 (eq (car-safe (nth 1 temp))
838 (= (length (nth 1 temp)) 3)
839 (setq temp (nth 1 temp)))
847 args (cons (nth 1 temp)
849 ((and (eq (car-safe (car conds))
851 (= (length (car conds)) 3))
852 (setq temp (calcFunc-vmatches
856 (nth 2 (car conds))))
859 (while (setq temp (cdr temp))
860 (setq matches (cons (nth 2 (car temp))
862 args (cons (nth 1 (car temp))
865 (or (math-is-true (math-simplify
870 (setq conds (cdr conds)))
872 (not (setq match (math-multi-subst
873 match args matches)))
874 (setq exp-old-pos save-exp-old-pos
875 exp-token save-exp-token
876 exp-data save-exp-data
877 exp-pos save-exp-pos)))))))
882 (defun calc-match-user-syntax (p &optional term)
884 (save-exp-pos exp-pos)
885 (save-exp-old-pos exp-old-pos)
886 (save-exp-token exp-token)
887 (save-exp-data exp-data))
889 (cond ((stringp (car p))
890 (and (equal exp-data (car p))
895 (and (setq m (catch 'syntax
896 (math-read-expr-level
899 (if (consp (nth 1 p))
900 (car (nth 1 (nth 1 p)))
904 (setq matches (nconc matches (list m)))))
905 ((eq (car (car p)) '\?)
906 (setq m (calc-match-user-syntax (nth 1 (car p))))
911 (cons 'vec (and (listp m) m))))))
912 (or (listp m) (not (nth 2 (car p)))
913 (not (eq (aref (car (nth 2 (car p))) 0) ?\$))
914 (eq exp-token 'end)))
916 (setq m (calc-match-user-syntax (nth 1 (car p))
917 (car (nth 2 (car p)))))
919 (let ((vec (cons 'vec m))
923 mm (calc-match-user-syntax
926 (car (nth 2 (car p))))))
928 (setq vec (nconc vec mm)))
929 (setq matches (nconc matches (list vec))))
930 (and (eq (car (car p)) '*)
931 (setq matches (nconc matches (list '(vec)))))))))
934 (setq exp-pos save-exp-pos
935 exp-old-pos save-exp-old-pos
936 exp-token save-exp-token
937 exp-data save-exp-data
942 (defconst math-alg-inequalities
943 '(calcFunc-lt calcFunc-gt calcFunc-leq calcFunc-geq
944 calcFunc-eq calcFunc-neq))
946 (defun math-remove-dashes (x)
947 (if (string-match "\\`\\(.*\\)-\\(.*\\)\\'" x)
949 (concat (math-match-substring x 1) "#" (math-match-substring x 2)))
953 (defun math-restore-dashes (x)
954 (if (string-match "\\`\\(.*\\)[#_]\\(.*\\)\\'" x)
956 (concat (math-match-substring x 1) "-" (math-match-substring x 2)))
960 (defun math-read-if (cond op)
961 (let ((then (math-read-expr-level 0)))
962 (or (equal exp-data ":")
963 (throw 'syntax "Expected ':'"))
965 (list 'calcFunc-if cond then (math-read-expr-level (nth 3 op))))
968 (defun math-factor-after ()
969 (let ((exp-pos exp-pos)
970 exp-old-pos exp-token exp-data)
972 (or (memq exp-token '(number symbol dollar hash string))
973 (and (assoc exp-data '(("-") ("+") ("!") ("|") ("/")))
974 (assoc (concat "u" exp-data) math-expr-opers))
975 (eq (nth 2 (assoc exp-data math-expr-opers)) -1)
976 (assoc exp-data '(("(") ("[") ("{")))))
979 (defun math-read-factor ()
981 (cond ((eq exp-token 'number)
982 (let ((num (math-read-number exp-data)))
985 (setq exp-old-pos exp-pos)
986 (throw 'syntax "Bad format")))
988 (if (and math-read-expr-quotes
992 ((and calc-user-parse-table
993 (setq op (calc-check-user-syntax)))
995 ((or (equal exp-data "-")
999 (equal exp-data "/"))
1000 (setq exp-data (concat "u" exp-data))
1002 ((and (setq op (assoc exp-data math-expr-opers))
1004 (if (consp (nth 1 op))
1005 (funcall (car (nth 1 op)) op)
1007 (let ((val (math-read-expr-level (nth 3 op))))
1008 (cond ((eq (nth 1 op) 'ident)
1010 ((and (Math-numberp val)
1011 (equal (car op) "u-"))
1013 (t (list (nth 1 op) val))))))
1014 ((eq exp-token 'symbol)
1015 (let ((sym (intern exp-data)))
1017 (if (equal exp-data calc-function-open)
1018 (let ((f (assq sym math-expr-function-mapping)))
1021 (funcall (car (cdr f)) f sym)
1022 (let ((args (if (or (equal exp-data calc-function-close)
1023 (eq exp-token 'end))
1025 (math-read-expr-list))))
1026 (if (not (or (equal exp-data calc-function-close)
1027 (eq exp-token 'end)))
1028 (throw 'syntax "Expected `)'"))
1030 (if (and (eq calc-language 'fortran) args
1032 (let ((calc-matrix-mode 'scalar))
1037 (symbol-name sym)))))))
1038 (math-parse-fortran-subscr sym args)
1041 (and (= (aref (symbol-name sym) 0) ?\\)
1042 (< (prefix-numeric-value calc-language-option)
1044 (setq sym (intern (substring (symbol-name sym)
1046 (or (string-match "-" (symbol-name sym))
1049 (symbol-name sym))))))
1051 (if math-read-expr-quotes
1053 (let ((val (list 'var
1054 (intern (math-remove-dashes
1056 (if (string-match "-" (symbol-name sym))
1058 (intern (concat "var-"
1059 (symbol-name sym)))))))
1060 (let ((v (assq (nth 1 val) math-expr-variable-mapping)))
1061 (and v (setq val (if (consp (cdr v))
1062 (funcall (car (cdr v)) v val)
1065 (substring (symbol-name (cdr v))
1068 (while (and (memq calc-language '(c pascal maple))
1069 (equal exp-data "["))
1071 (setq val (append (list 'calcFunc-subscr val)
1072 (math-read-expr-list)))
1073 (if (equal exp-data "]")
1075 (throw 'syntax "Expected ']'")))
1077 ((eq exp-token 'dollar)
1078 (let ((abs (if (> exp-data 0) exp-data (- exp-data))))
1079 (if (>= (length calc-dollar-values) abs)
1080 (let ((num exp-data))
1082 (setq calc-dollar-used (max calc-dollar-used num))
1083 (math-check-complete (nth (1- abs) calc-dollar-values)))
1084 (throw 'syntax (if calc-dollar-values
1086 "$'s not allowed in this context")))))
1087 ((eq exp-token 'hash)
1088 (or calc-hashes-used
1089 (throw 'syntax "#'s not allowed in this context"))
1091 (if (<= exp-data (length calc-arg-values))
1092 (let ((num exp-data))
1094 (setq calc-hashes-used (max calc-hashes-used num))
1095 (nth (1- num) calc-arg-values))
1096 (throw 'syntax "Too many # arguments")))
1097 ((equal exp-data "(")
1098 (let* ((exp (let ((exp-keep-spaces nil))
1100 (if (or (equal exp-data "\\dots")
1101 (equal exp-data "\\ldots"))
1102 '(neg (var inf var-inf))
1103 (math-read-expr-level 0)))))
1104 (let ((exp-keep-spaces nil))
1106 ((equal exp-data ",")
1109 (let ((exp2 (math-read-expr-level 0)))
1111 (if (and exp2 (Math-realp exp) (Math-realp exp2))
1112 (math-normalize (list 'cplx exp exp2))
1113 (list '+ exp (list '* exp2 '(var i var-i))))))))
1114 ((equal exp-data ";")
1117 (let ((exp2 (math-read-expr-level 0)))
1118 (setq exp (if (and exp2 (Math-realp exp)
1120 (math-normalize (list 'polar exp exp2))
1125 (math-to-radians-2 exp2)
1126 '(var i var-i)))))))))
1127 ((or (equal exp-data "\\dots")
1128 (equal exp-data "\\ldots"))
1131 (let ((exp2 (if (or (equal exp-data ")")
1132 (equal exp-data "]")
1133 (eq exp-token 'end))
1135 (math-read-expr-level 0))))
1138 (if (equal exp-data ")") 0 1)
1141 (if (not (or (equal exp-data ")")
1142 (and (equal exp-data "]") (eq (car-safe exp) 'intv))
1143 (eq exp-token 'end)))
1144 (throw 'syntax "Expected `)'"))
1147 ((eq exp-token 'string)
1150 ((equal exp-data "[")
1152 (math-read-brackets t "]"))
1153 ((equal exp-data "{")
1155 (math-read-brackets nil "}"))
1156 ((equal exp-data "<")
1158 (math-read-angle-brackets))
1159 (t (throw 'syntax "Expected a number"))))