3 |
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. |
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. |
4 |
|
|
5 |
;; Author: David Gillespie <daveg@synaptics.com> |
;; Author: David Gillespie <daveg@synaptics.com> |
6 |
;; Maintainers: D. Goel <deego@gnufans.org> |
;; Maintainer: Jay Belanger <belanger@truman.edu> |
|
;; Colin Walters <walters@debian.org> |
|
7 |
|
|
8 |
;; This file is part of GNU Emacs. |
;; This file is part of GNU Emacs. |
9 |
|
|
707 |
(list 'intv 3 x (math-read-expr-level (nth 3 op)))) |
(list 'intv 3 x (math-read-expr-level (nth 3 op)))) |
708 |
|
|
709 |
|
|
710 |
|
;; The variable math-read-big-lines is local to math-read-big-expr in |
711 |
|
;; calc-ext.el, but is used by math-read-big-rec, math-read-big-char, |
712 |
|
;; math-read-big-emptyp, math-read-big-error and math-read-big-balance, |
713 |
|
;; which are called (directly and indirectly) by math-read-big-expr. |
714 |
|
;; It is also local to math-read-big-bigp in calc-ext.el, which calls |
715 |
|
;; math-read-big-balance. |
716 |
|
(defvar math-read-big-lines) |
717 |
|
|
718 |
|
;; The variables math-read-big-baseline and math-read-big-h2 are |
719 |
|
;; local to math-read-big-expr in calc-ext.el, but used by |
720 |
|
;; math-read-big-rec. |
721 |
|
(defvar math-read-big-baseline) |
722 |
|
(defvar math-read-big-h2) |
723 |
|
|
724 |
|
;; The variables math-rb-h1, math-rb-h2, math-rb-v1 and math-rb-v2 |
725 |
|
;; are local to math-read-big-rec, but are used by math-read-big-char, |
726 |
|
;; math-read-big-emptyp and math-read-big-balance which are called by |
727 |
|
;; math-read-big-rec. |
728 |
|
;; math-rb-h2 is also local to math-read-big-bigp in calc-ext.el, |
729 |
|
;; which calls math-read-big-balance. |
730 |
|
(defvar math-rb-h1) |
731 |
|
(defvar math-rb-h2) |
732 |
|
(defvar math-rb-v1) |
733 |
|
(defvar math-rb-v2) |
734 |
|
|
735 |
|
(defun math-read-big-rec (math-rb-h1 math-rb-v1 math-rb-h2 math-rb-v2 |
736 |
|
&optional baseline prec short) |
|
(defun math-read-big-rec (h1 v1 h2 v2 &optional baseline prec short) |
|
737 |
(or prec (setq prec 0)) |
(or prec (setq prec 0)) |
738 |
|
|
739 |
;; Clip whitespace above or below. |
;; Clip whitespace above or below. |
740 |
(while (and (< v1 v2) (math-read-big-emptyp h1 v1 h2 (1+ v1))) |
(while (and (< math-rb-v1 math-rb-v2) |
741 |
(setq v1 (1+ v1))) |
(math-read-big-emptyp math-rb-h1 math-rb-v1 math-rb-h2 (1+ math-rb-v1))) |
742 |
(while (and (< v1 v2) (math-read-big-emptyp h1 (1- v2) h2 v2)) |
(setq math-rb-v1 (1+ math-rb-v1))) |
743 |
(setq v2 (1- v2))) |
(while (and (< math-rb-v1 math-rb-v2) |
744 |
|
(math-read-big-emptyp math-rb-h1 (1- math-rb-v2) math-rb-h2 math-rb-v2)) |
745 |
|
(setq math-rb-v2 (1- math-rb-v2))) |
746 |
|
|
747 |
;; If formula is a single line high, normal parser can handle it. |
;; If formula is a single line high, normal parser can handle it. |
748 |
(if (<= v2 (1+ v1)) |
(if (<= math-rb-v2 (1+ math-rb-v1)) |
749 |
(if (or (<= v2 v1) |
(if (or (<= math-rb-v2 math-rb-v1) |
750 |
(> h1 (length (setq v2 (nth v1 lines))))) |
(> math-rb-h1 (length (setq math-rb-v2 |
751 |
(math-read-big-error h1 v1) |
(nth math-rb-v1 math-read-big-lines))))) |
752 |
(setq the-baseline v1 |
(math-read-big-error math-rb-h1 math-rb-v1) |
753 |
the-h2 h2 |
(setq math-read-big-baseline math-rb-v1 |
754 |
v2 (nth v1 lines) |
math-read-big-h2 math-rb-h2 |
755 |
h2 (math-read-expr (substring v2 h1 (min h2 (length v2))))) |
math-rb-v2 (nth math-rb-v1 math-read-big-lines) |
756 |
(if (eq (car-safe h2) 'error) |
math-rb-h2 (math-read-expr |
757 |
(math-read-big-error (+ h1 (nth 1 h2)) v1 (nth 2 h2)) |
(substring math-rb-v2 math-rb-h1 |
758 |
h2)) |
(min math-rb-h2 (length math-rb-v2))))) |
759 |
|
(if (eq (car-safe math-rb-h2) 'error) |
760 |
|
(math-read-big-error (+ math-rb-h1 (nth 1 math-rb-h2)) |
761 |
|
math-rb-v1 (nth 2 math-rb-h2)) |
762 |
|
math-rb-h2)) |
763 |
|
|
764 |
;; Clip whitespace at left or right. |
;; Clip whitespace at left or right. |
765 |
(while (and (< h1 h2) (math-read-big-emptyp h1 v1 (1+ h1) v2)) |
(while (and (< math-rb-h1 math-rb-h2) |
766 |
(setq h1 (1+ h1))) |
(math-read-big-emptyp math-rb-h1 math-rb-v1 (1+ math-rb-h1) math-rb-v2)) |
767 |
(while (and (< h1 h2) (math-read-big-emptyp (1- h2) v1 h2 v2)) |
(setq math-rb-h1 (1+ math-rb-h1))) |
768 |
(setq h2 (1- h2))) |
(while (and (< math-rb-h1 math-rb-h2) |
769 |
|
(math-read-big-emptyp (1- math-rb-h2) math-rb-v1 math-rb-h2 math-rb-v2)) |
770 |
|
(setq math-rb-h2 (1- math-rb-h2))) |
771 |
|
|
772 |
;; Scan to find widest left-justified "----" in the region. |
;; Scan to find widest left-justified "----" in the region. |
773 |
(let* ((widest nil) |
(let* ((widest nil) |
774 |
(widest-h2 0) |
(widest-h2 0) |
775 |
(lines-v1 (nthcdr v1 lines)) |
(lines-v1 (nthcdr math-rb-v1 math-read-big-lines)) |
776 |
(p lines-v1) |
(p lines-v1) |
777 |
(v v1) |
(v math-rb-v1) |
778 |
(other-v nil) |
(other-v nil) |
779 |
other-char line len h) |
other-char line len h) |
780 |
(while (< v v2) |
(while (< v math-rb-v2) |
781 |
(setq line (car p) |
(setq line (car p) |
782 |
len (min h2 (length line))) |
len (min math-rb-h2 (length line))) |
783 |
(and (< h1 len) |
(and (< math-rb-h1 len) |
784 |
(/= (aref line h1) ?\ ) |
(/= (aref line math-rb-h1) ?\ ) |
785 |
(if (and (= (aref line h1) ?\-) |
(if (and (= (aref line math-rb-h1) ?\-) |
786 |
;; Make sure it's not a minus sign. |
;; Make sure it's not a minus sign. |
787 |
(or (and (< (1+ h1) len) (= (aref line (1+ h1)) ?\-)) |
(or (and (< (1+ math-rb-h1) len) |
788 |
(/= (math-read-big-char h1 (1- v)) ?\ ) |
(= (aref line (1+ math-rb-h1)) ?\-)) |
789 |
(/= (math-read-big-char h1 (1+ v)) ?\ ))) |
(/= (math-read-big-char math-rb-h1 (1- v)) ?\ ) |
790 |
|
(/= (math-read-big-char math-rb-h1 (1+ v)) ?\ ))) |
791 |
(progn |
(progn |
792 |
(setq h h1) |
(setq h math-rb-h1) |
793 |
(while (and (< (setq h (1+ h)) len) |
(while (and (< (setq h (1+ h)) len) |
794 |
(= (aref line h) ?\-))) |
(= (aref line h) ?\-))) |
795 |
(if (> h widest-h2) |
(if (> h widest-h2) |
796 |
(setq widest v |
(setq widest v |
797 |
widest-h2 h))) |
widest-h2 h))) |
798 |
(or other-v (setq other-v v other-char (aref line h1))))) |
(or other-v (setq other-v v other-char (aref line math-rb-h1))))) |
799 |
(setq v (1+ v) |
(setq v (1+ v) |
800 |
p (cdr p))) |
p (cdr p))) |
801 |
|
|
802 |
(cond ((not (setq v other-v)) |
(cond ((not (setq v other-v)) |
803 |
(math-read-big-error h1 v1)) ; Should never happen! |
(math-read-big-error math-rb-h1 math-rb-v1)) ; Should never happen! |
804 |
|
|
805 |
;; Quotient. |
;; Quotient. |
806 |
(widest |
(widest |
807 |
(setq h widest-h2 |
(setq h widest-h2 |
808 |
v widest) |
v widest) |
809 |
(let ((num (math-read-big-rec h1 v1 h v)) |
(let ((num (math-read-big-rec math-rb-h1 math-rb-v1 h v)) |
810 |
(den (math-read-big-rec h1 (1+ v) h v2))) |
(den (math-read-big-rec math-rb-h1 (1+ v) h math-rb-v2))) |
811 |
(setq p (if (and (math-integerp num) (math-integerp den)) |
(setq p (if (and (math-integerp num) (math-integerp den)) |
812 |
(math-make-frac num den) |
(math-make-frac num den) |
813 |
(list '/ num den))))) |
(list '/ num den))))) |
814 |
|
|
815 |
;; Big radical sign. |
;; Big radical sign. |
816 |
((= other-char ?\\) |
((= other-char ?\\) |
817 |
(or (= (math-read-big-char (1+ h1) v) ?\|) |
(or (= (math-read-big-char (1+ math-rb-h1) v) ?\|) |
818 |
(math-read-big-error (1+ h1) v "Malformed root sign")) |
(math-read-big-error (1+ math-rb-h1) v "Malformed root sign")) |
819 |
(math-read-big-emptyp h1 v1 (1+ h1) v nil t) |
(math-read-big-emptyp math-rb-h1 math-rb-v1 (1+ math-rb-h1) v nil t) |
820 |
(while (= (math-read-big-char (1+ h1) (setq v (1- v))) ?\|)) |
(while (= (math-read-big-char (1+ math-rb-h1) (setq v (1- v))) ?\|)) |
821 |
(or (= (math-read-big-char (setq h (+ h1 2)) v) ?\_) |
(or (= (math-read-big-char (setq h (+ math-rb-h1 2)) v) ?\_) |
822 |
(math-read-big-error h v "Malformed root sign")) |
(math-read-big-error h v "Malformed root sign")) |
823 |
(while (= (math-read-big-char (setq h (1+ h)) v) ?\_)) |
(while (= (math-read-big-char (setq h (1+ h)) v) ?\_)) |
824 |
(math-read-big-emptyp h1 v1 (1+ h1) v nil t) |
(math-read-big-emptyp math-rb-h1 math-rb-v1 (1+ math-rb-h1) v nil t) |
825 |
(math-read-big-emptyp h1 (1+ other-v) h v2 nil t) |
(math-read-big-emptyp math-rb-h1 (1+ other-v) h math-rb-v2 nil t) |
826 |
(setq p (list 'calcFunc-sqrt (math-read-big-rec |
(setq p (list 'calcFunc-sqrt (math-read-big-rec |
827 |
(+ h1 2) (1+ v) |
(+ math-rb-h1 2) (1+ v) |
828 |
h (1+ other-v) baseline)) |
h (1+ other-v) baseline)) |
829 |
v the-baseline)) |
v math-read-big-baseline)) |
830 |
|
|
831 |
;; Small radical sign. |
;; Small radical sign. |
832 |
((and (= other-char ?V) |
((and (= other-char ?V) |
833 |
(= (math-read-big-char (1+ h1) (1- v)) ?\_)) |
(= (math-read-big-char (1+ math-rb-h1) (1- v)) ?\_)) |
834 |
(setq h (1+ h1)) |
(setq h (1+ math-rb-h1)) |
835 |
(math-read-big-emptyp h1 v1 h (1- v) nil t) |
(math-read-big-emptyp math-rb-h1 math-rb-v1 h (1- v) nil t) |
836 |
(math-read-big-emptyp h1 (1+ v) h v2 nil t) |
(math-read-big-emptyp math-rb-h1 (1+ v) h math-rb-v2 nil t) |
837 |
(math-read-big-emptyp h1 v1 (1+ h1) v nil t) |
(math-read-big-emptyp math-rb-h1 math-rb-v1 (1+ math-rb-h1) v nil t) |
838 |
(while (= (math-read-big-char (setq h (1+ h)) (1- v)) ?\_)) |
(while (= (math-read-big-char (setq h (1+ h)) (1- v)) ?\_)) |
839 |
(setq p (list 'calcFunc-sqrt (math-read-big-rec |
(setq p (list 'calcFunc-sqrt (math-read-big-rec |
840 |
(1+ h1) v h (1+ v) t)) |
(1+ math-rb-h1) v h (1+ v) t)) |
841 |
v the-baseline)) |
v math-read-big-baseline)) |
842 |
|
|
843 |
;; Binomial coefficient. |
;; Binomial coefficient. |
844 |
((and (= other-char ?\() |
((and (= other-char ?\() |
845 |
(= (math-read-big-char (1+ h1) v) ?\ ) |
(= (math-read-big-char (1+ math-rb-h1) v) ?\ ) |
846 |
(= (string-match "( *)" (nth v lines) h1) h1)) |
(= (string-match "( *)" (nth v math-read-big-lines) |
847 |
|
math-rb-h1) math-rb-h1)) |
848 |
(setq h (match-end 0)) |
(setq h (match-end 0)) |
849 |
(math-read-big-emptyp h1 v1 (1+ h1) v nil t) |
(math-read-big-emptyp math-rb-h1 math-rb-v1 (1+ math-rb-h1) v nil t) |
850 |
(math-read-big-emptyp h1 (1+ v) (1+ h1) v2 nil t) |
(math-read-big-emptyp math-rb-h1 (1+ v) (1+ math-rb-h1) math-rb-v2 nil t) |
851 |
(math-read-big-emptyp (1- h) v1 h v nil t) |
(math-read-big-emptyp (1- h) math-rb-v1 h v nil t) |
852 |
(math-read-big-emptyp (1- h) (1+ v) h v2 nil t) |
(math-read-big-emptyp (1- h) (1+ v) h math-rb-v2 nil t) |
853 |
(setq p (list 'calcFunc-choose |
(setq p (list 'calcFunc-choose |
854 |
(math-read-big-rec (1+ h1) v1 (1- h) v) |
(math-read-big-rec (1+ math-rb-h1) math-rb-v1 (1- h) v) |
855 |
(math-read-big-rec (1+ h1) (1+ v) |
(math-read-big-rec (1+ math-rb-h1) (1+ v) |
856 |
(1- h) v2)))) |
(1- h) math-rb-v2)))) |
857 |
|
|
858 |
;; Minus sign. |
;; Minus sign. |
859 |
((= other-char ?\-) |
((= other-char ?\-) |
860 |
(setq p (list 'neg (math-read-big-rec (1+ h1) v1 h2 v2 v 250 t)) |
(setq p (list 'neg (math-read-big-rec (1+ math-rb-h1) math-rb-v1 |
861 |
v the-baseline |
math-rb-h2 math-rb-v2 v 250 t)) |
862 |
h the-h2)) |
v math-read-big-baseline |
863 |
|
h math-read-big-h2)) |
864 |
|
|
865 |
;; Parentheses. |
;; Parentheses. |
866 |
((= other-char ?\() |
((= other-char ?\() |
867 |
(math-read-big-emptyp h1 v1 (1+ h1) v nil t) |
(math-read-big-emptyp math-rb-h1 math-rb-v1 (1+ math-rb-h1) v nil t) |
868 |
(math-read-big-emptyp h1 (1+ v) (1+ h1) v2 nil t) |
(math-read-big-emptyp math-rb-h1 (1+ v) (1+ math-rb-h1) math-rb-v2 nil t) |
869 |
(setq h (math-read-big-balance (1+ h1) v "(" t)) |
(setq h (math-read-big-balance (1+ math-rb-h1) v "(" t)) |
870 |
(math-read-big-emptyp (1- h) v1 h v nil t) |
(math-read-big-emptyp (1- h) math-rb-v1 h v nil t) |
871 |
(math-read-big-emptyp (1- h) (1+ v) h v2 nil t) |
(math-read-big-emptyp (1- h) (1+ v) h math-rb-v2 nil t) |
872 |
(let ((sep (math-read-big-char (1- h) v)) |
(let ((sep (math-read-big-char (1- h) v)) |
873 |
hmid) |
hmid) |
874 |
(if (= sep ?\.) |
(if (= sep ?\.) |
876 |
(if (= sep ?\]) |
(if (= sep ?\]) |
877 |
(math-read-big-error (1- h) v "Expected `)'")) |
(math-read-big-error (1- h) v "Expected `)'")) |
878 |
(if (= sep ?\)) |
(if (= sep ?\)) |
879 |
(setq p (math-read-big-rec (1+ h1) v1 (1- h) v2 v)) |
(setq p (math-read-big-rec |
880 |
|
(1+ math-rb-h1) math-rb-v1 (1- h) math-rb-v2 v)) |
881 |
(setq hmid (math-read-big-balance h v "(") |
(setq hmid (math-read-big-balance h v "(") |
882 |
p (list p (math-read-big-rec h v1 (1- hmid) v2 v)) |
p (list p |
883 |
|
(math-read-big-rec h math-rb-v1 (1- hmid) math-rb-v2 v)) |
884 |
h hmid) |
h hmid) |
885 |
(cond ((= sep ?\.) |
(cond ((= sep ?\.) |
886 |
(setq p (cons 'intv (cons (if (= (math-read-big-char |
(setq p (cons 'intv (cons (if (= (math-read-big-char |
893 |
((= sep ?\,) |
((= sep ?\,) |
894 |
(or (and (math-realp (car p)) (math-realp (nth 1 p))) |
(or (and (math-realp (car p)) (math-realp (nth 1 p))) |
895 |
(math-read-big-error |
(math-read-big-error |
896 |
h1 v "Complex components must be real")) |
math-rb-h1 v "Complex components must be real")) |
897 |
(setq p (cons 'cplx p))) |
(setq p (cons 'cplx p))) |
898 |
((= sep ?\;) |
((= sep ?\;) |
899 |
(or (and (math-realp (car p)) (math-anglep (nth 1 p))) |
(or (and (math-realp (car p)) (math-anglep (nth 1 p))) |
900 |
(math-read-big-error |
(math-read-big-error |
901 |
h1 v "Complex components must be real")) |
math-rb-h1 v "Complex components must be real")) |
902 |
(setq p (cons 'polar p))))))) |
(setq p (cons 'polar p))))))) |
903 |
|
|
904 |
;; Matrix. |
;; Matrix. |
905 |
((and (= other-char ?\[) |
((and (= other-char ?\[) |
906 |
(or (= (math-read-big-char (setq h h1) (1+ v)) ?\[) |
(or (= (math-read-big-char (setq h math-rb-h1) (1+ v)) ?\[) |
907 |
(= (math-read-big-char (setq h (1+ h)) v) ?\[) |
(= (math-read-big-char (setq h (1+ h)) v) ?\[) |
908 |
(and (= (math-read-big-char h v) ?\ ) |
(and (= (math-read-big-char h v) ?\ ) |
909 |
(= (math-read-big-char (setq h (1+ h)) v) ?\[))) |
(= (math-read-big-char (setq h (1+ h)) v) ?\[))) |
910 |
(= (math-read-big-char h (1+ v)) ?\[)) |
(= (math-read-big-char h (1+ v)) ?\[)) |
911 |
(math-read-big-emptyp h1 v1 h v nil t) |
(math-read-big-emptyp math-rb-h1 math-rb-v1 h v nil t) |
912 |
(let ((vtop v) |
(let ((vtop v) |
913 |
(hleft h) |
(hleft h) |
914 |
(hright nil)) |
(hright nil)) |
924 |
(and (memq (math-read-big-char h v) '(?\ ?\,)) |
(and (memq (math-read-big-char h v) '(?\ ?\,)) |
925 |
(= (math-read-big-char hleft (1+ v)) ?\[))) |
(= (math-read-big-char hleft (1+ v)) ?\[))) |
926 |
(setq v (1+ v))) |
(setq v (1+ v))) |
927 |
(or (= hleft h1) |
(or (= hleft math-rb-h1) |
928 |
(progn |
(progn |
929 |
(if (= (math-read-big-char h v) ?\ ) |
(if (= (math-read-big-char h v) ?\ ) |
930 |
(setq h (1+ h))) |
(setq h (1+ h))) |
933 |
(math-read-big-error (1- h) v "Expected `]'")) |
(math-read-big-error (1- h) v "Expected `]'")) |
934 |
(if (= (math-read-big-char h vtop) ?\,) |
(if (= (math-read-big-char h vtop) ?\,) |
935 |
(setq h (1+ h))) |
(setq h (1+ h))) |
936 |
(math-read-big-emptyp h1 (1+ v) (1- h) v2 nil t) |
(math-read-big-emptyp math-rb-h1 (1+ v) (1- h) math-rb-v2 nil t) |
937 |
(setq v (+ vtop (/ (- v vtop) 2)) |
(setq v (+ vtop (/ (- v vtop) 2)) |
938 |
p (cons 'vec (nreverse p))))) |
p (cons 'vec (nreverse p))))) |
939 |
|
|
940 |
;; Square brackets. |
;; Square brackets. |
941 |
((= other-char ?\[) |
((= other-char ?\[) |
942 |
(math-read-big-emptyp h1 v1 (1+ h1) v nil t) |
(math-read-big-emptyp math-rb-h1 math-rb-v1 (1+ math-rb-h1) v nil t) |
943 |
(math-read-big-emptyp h1 (1+ v) (1+ h1) v2 nil t) |
(math-read-big-emptyp math-rb-h1 (1+ v) (1+ math-rb-h1) math-rb-v2 nil t) |
944 |
(setq p nil |
(setq p nil |
945 |
h (1+ h1)) |
h (1+ math-rb-h1)) |
946 |
(while (progn |
(while (progn |
947 |
(setq widest (math-read-big-balance h v "[" t)) |
(setq widest (math-read-big-balance h v "[" t)) |
948 |
(math-read-big-emptyp (1- h) v1 h v nil t) |
(math-read-big-emptyp (1- h) math-rb-v1 h v nil t) |
949 |
(math-read-big-emptyp (1- h) (1+ v) h v2 nil t) |
(math-read-big-emptyp (1- h) (1+ v) h math-rb-v2 nil t) |
950 |
(setq p (cons (math-read-big-rec |
(setq p (cons (math-read-big-rec |
951 |
h v1 (1- widest) v2 v) p) |
h math-rb-v1 (1- widest) math-rb-v2 v) p) |
952 |
h widest) |
h widest) |
953 |
(= (math-read-big-char (1- h) v) ?\,))) |
(= (math-read-big-char (1- h) v) ?\,))) |
954 |
(setq widest (math-read-big-char (1- h) v)) |
(setq widest (math-read-big-char (1- h) v)) |
958 |
(if (= widest ?\.) |
(if (= widest ?\.) |
959 |
(setq h (1+ h) |
(setq h (1+ h) |
960 |
widest (math-read-big-balance h v "[") |
widest (math-read-big-balance h v "[") |
961 |
p (nconc p (list (math-read-big-big-rec |
p (nconc p (list (math-read-big-rec |
962 |
h v1 (1- widest) v2 v))) |
h math-rb-v1 (1- widest) math-rb-v2 v))) |
963 |
h widest |
h widest |
964 |
p (cons 'intv (cons (if (= (math-read-big-char (1- h) v) |
p (cons 'intv (cons (if (= (math-read-big-char (1- h) v) |
965 |
?\]) |
?\]) |
969 |
|
|
970 |
;; Date form. |
;; Date form. |
971 |
((= other-char ?\<) |
((= other-char ?\<) |
972 |
(setq line (nth v lines)) |
(setq line (nth v math-read-big-lines)) |
973 |
(string-match ">" line h1) |
(string-match ">" line math-rb-h1) |
974 |
(setq h (match-end 0)) |
(setq h (match-end 0)) |
975 |
(math-read-big-emptyp h1 v1 h v nil t) |
(math-read-big-emptyp math-rb-h1 math-rb-v1 h v nil t) |
976 |
(math-read-big-emptyp h1 (1+ v) h v2 nil t) |
(math-read-big-emptyp math-rb-h1 (1+ v) h math-rb-v2 nil t) |
977 |
(setq p (math-read-big-rec h1 v h (1+ v) v))) |
(setq p (math-read-big-rec math-rb-h1 v h (1+ v) v))) |
978 |
|
|
979 |
;; Variable name or function call. |
;; Variable name or function call. |
980 |
((or (and (>= other-char ?a) (<= other-char ?z)) |
((or (and (>= other-char ?a) (<= other-char ?z)) |
981 |
(and (>= other-char ?A) (<= other-char ?Z))) |
(and (>= other-char ?A) (<= other-char ?Z))) |
982 |
(setq line (nth v lines)) |
(setq line (nth v math-read-big-lines)) |
983 |
(string-match "\\([a-zA-Z'_]+\\) *" line h1) |
(string-match "\\([a-zA-Z'_]+\\) *" line math-rb-h1) |
984 |
(setq h (match-end 1) |
(setq h (match-end 1) |
985 |
widest (match-end 0) |
widest (match-end 0) |
986 |
p (math-match-substring line 1)) |
p (math-match-substring line 1)) |
987 |
(math-read-big-emptyp h1 v1 h v nil t) |
(math-read-big-emptyp math-rb-h1 math-rb-v1 h v nil t) |
988 |
(math-read-big-emptyp h1 (1+ v) h v2 nil t) |
(math-read-big-emptyp math-rb-h1 (1+ v) h math-rb-v2 nil t) |
989 |
(if (= (math-read-big-char widest v) ?\() |
(if (= (math-read-big-char widest v) ?\() |
990 |
(progn |
(progn |
991 |
(setq line (if (string-match "-" p) |
(setq line (if (string-match "-" p) |
993 |
(intern (concat "calcFunc-" p))) |
(intern (concat "calcFunc-" p))) |
994 |
h (1+ widest) |
h (1+ widest) |
995 |
p nil) |
p nil) |
996 |
(math-read-big-emptyp widest v1 h v nil t) |
(math-read-big-emptyp widest math-rb-v1 h v nil t) |
997 |
(math-read-big-emptyp widest (1+ v) h v2 nil t) |
(math-read-big-emptyp widest (1+ v) h math-rb-v2 nil t) |
998 |
(while (progn |
(while (progn |
999 |
(setq widest (math-read-big-balance h v "(" t)) |
(setq widest (math-read-big-balance h v "(" t)) |
1000 |
(math-read-big-emptyp (1- h) v1 h v nil t) |
(math-read-big-emptyp (1- h) math-rb-v1 h v nil t) |
1001 |
(math-read-big-emptyp (1- h) (1+ v) h v2 nil t) |
(math-read-big-emptyp (1- h) (1+ v) h math-rb-v2 nil t) |
1002 |
(setq p (cons (math-read-big-rec |
(setq p (cons (math-read-big-rec |
1003 |
h v1 (1- widest) v2 v) p) |
h math-rb-v1 (1- widest) math-rb-v2 v) p) |
1004 |
h widest) |
h widest) |
1005 |
(= (math-read-big-char (1- h) v) ?\,))) |
(= (math-read-big-char (1- h) v) ?\,))) |
1006 |
(or (= (math-read-big-char (1- h) v) ?\)) |
(or (= (math-read-big-char (1- h) v) ?\)) |
1014 |
|
|
1015 |
;; Number. |
;; Number. |
1016 |
(t |
(t |
1017 |
(setq line (nth v lines)) |
(setq line (nth v math-read-big-lines)) |
1018 |
(or (= (string-match "_?\\([0-9]+.?0*@ *\\)?\\([0-9]+.?0*' *\\)?\\([0-9]+\\(#\\|\\^\\^\\)[0-9a-zA-Z:]+\\|[0-9]+:[0-9:]+\\|[0-9.]+\\([eE][-+_]?[0-9]+\\)?\"?\\)?" line h1) h1) |
(or (= (string-match "_?\\([0-9]+.?0*@ *\\)?\\([0-9]+.?0*' *\\)?\\([0-9]+\\(#\\|\\^\\^\\)[0-9a-zA-Z:]+\\|[0-9]+:[0-9:]+\\|[0-9.]+\\([eE][-+_]?[0-9]+\\)?\"?\\)?" line math-rb-h1) math-rb-h1) |
1019 |
(math-read-big-error h v "Expected a number")) |
(math-read-big-error h v "Expected a number")) |
1020 |
(setq h (match-end 0) |
(setq h (match-end 0) |
1021 |
p (math-read-number (math-match-substring line 0))) |
p (math-read-number (math-match-substring line 0))) |
1022 |
(math-read-big-emptyp h1 v1 h v nil t) |
(math-read-big-emptyp math-rb-h1 math-rb-v1 h v nil t) |
1023 |
(math-read-big-emptyp h1 (1+ v) h v2 nil t))) |
(math-read-big-emptyp math-rb-h1 (1+ v) h math-rb-v2 nil t))) |
1024 |
|
|
1025 |
;; Now left term is bounded by h1, v1, h, v2; baseline = v. |
;; Now left term is bounded by math-rb-h1, math-rb-v1, h, math-rb-v2; |
1026 |
|
;; baseline = v. |
1027 |
(if baseline |
(if baseline |
1028 |
(or (= v baseline) |
(or (= v baseline) |
1029 |
(math-read-big-error h1 v "Inconsistent baseline in formula")) |
(math-read-big-error math-rb-h1 v "Inconsistent baseline in formula")) |
1030 |
(setq baseline v)) |
(setq baseline v)) |
1031 |
|
|
1032 |
;; Look for superscripts or subscripts. |
;; Look for superscripts or subscripts. |
1033 |
(setq line (nth baseline lines) |
(setq line (nth baseline math-read-big-lines) |
1034 |
len (min h2 (length line)) |
len (min math-rb-h2 (length line)) |
1035 |
widest h) |
widest h) |
1036 |
(while (and (< widest len) |
(while (and (< widest len) |
1037 |
(= (aref line widest) ?\ )) |
(= (aref line widest) ?\ )) |
1038 |
(setq widest (1+ widest))) |
(setq widest (1+ widest))) |
1039 |
(and (>= widest len) (setq widest h2)) |
(and (>= widest len) (setq widest math-rb-h2)) |
1040 |
(if (math-read-big-emptyp h v widest v2) |
(if (math-read-big-emptyp h v widest math-rb-v2) |
1041 |
(if (math-read-big-emptyp h v1 widest v) |
(if (math-read-big-emptyp h math-rb-v1 widest v) |
1042 |
(setq h widest) |
(setq h widest) |
1043 |
(setq p (list '^ p (math-read-big-rec h v1 widest v)) |
(setq p (list '^ p (math-read-big-rec h math-rb-v1 widest v)) |
1044 |
h widest)) |
h widest)) |
1045 |
(if (math-read-big-emptyp h v1 widest v) |
(if (math-read-big-emptyp h math-rb-v1 widest v) |
1046 |
(setq p (list 'calcFunc-subscr p |
(setq p (list 'calcFunc-subscr p |
1047 |
(math-read-big-rec h v widest v2)) |
(math-read-big-rec h v widest math-rb-v2)) |
1048 |
h widest))) |
h widest))) |
1049 |
|
|
1050 |
;; Look for an operator name and grab additional terms. |
;; Look for an operator name and grab additional terms. |
1051 |
(while (and (< h len) |
(while (and (< h len) |
1052 |
(if (setq widest (and (math-read-big-emptyp |
(if (setq widest (and (math-read-big-emptyp |
1053 |
h v1 (1+ h) v) |
h math-rb-v1 (1+ h) v) |
1054 |
(math-read-big-emptyp |
(math-read-big-emptyp |
1055 |
h (1+ v) (1+ h) v2) |
h (1+ v) (1+ h) math-rb-v2) |
1056 |
(string-match "<=\\|>=\\|\\+/-\\|!=\\|&&\\|||\\|:=\\|=>\\|." line h) |
(string-match "<=\\|>=\\|\\+/-\\|!=\\|&&\\|||\\|:=\\|=>\\|." line h) |
1057 |
(assoc (math-match-substring line 0) |
(assoc (math-match-substring line 0) |
1058 |
math-standard-opers))) |
math-standard-opers))) |
1064 |
(cond ((eq (nth 3 widest) -1) |
(cond ((eq (nth 3 widest) -1) |
1065 |
(setq p (list (nth 1 widest) p))) |
(setq p (list (nth 1 widest) p))) |
1066 |
((equal (car widest) "?") |
((equal (car widest) "?") |
1067 |
(let ((y (math-read-big-rec h v1 h2 v2 baseline nil t))) |
(let ((y (math-read-big-rec h math-rb-v1 math-rb-h2 |
1068 |
(or (= (math-read-big-char the-h2 baseline) ?\:) |
math-rb-v2 baseline nil t))) |
1069 |
(math-read-big-error the-h2 baseline "Expected `:'")) |
(or (= (math-read-big-char math-read-big-h2 baseline) ?\:) |
1070 |
|
(math-read-big-error math-read-big-h2 baseline "Expected `:'")) |
1071 |
(setq p (list (nth 1 widest) p y |
(setq p (list (nth 1 widest) p y |
1072 |
(math-read-big-rec (1+ the-h2) v1 h2 v2 |
(math-read-big-rec |
1073 |
baseline (nth 3 widest) t)) |
(1+ math-read-big-h2) math-rb-v1 math-rb-h2 math-rb-v2 |
1074 |
h the-h2))) |
baseline (nth 3 widest) t)) |
1075 |
|
h math-read-big-h2))) |
1076 |
(t |
(t |
1077 |
(setq p (list (nth 1 widest) p |
(setq p (list (nth 1 widest) p |
1078 |
(math-read-big-rec h v1 h2 v2 |
(math-read-big-rec h math-rb-v1 math-rb-h2 math-rb-v2 |
1079 |
baseline (nth 3 widest) t)) |
baseline (nth 3 widest) t)) |
1080 |
h the-h2)))) |
h math-read-big-h2)))) |
1081 |
|
|
1082 |
;; Return all relevant information to caller. |
;; Return all relevant information to caller. |
1083 |
(setq the-baseline baseline |
(setq math-read-big-baseline baseline |
1084 |
the-h2 h) |
math-read-big-h2 h) |
1085 |
(or short (= the-h2 h2) |
(or short (= math-read-big-h2 math-rb-h2) |
1086 |
(math-read-big-error h baseline)) |
(math-read-big-error h baseline)) |
1087 |
p))) |
p))) |
1088 |
|
|
1089 |
(defun math-read-big-char (h v) |
(defun math-read-big-char (h v) |
1090 |
(or (and (>= h h1) |
(or (and (>= h math-rb-h1) |
1091 |
(< h h2) |
(< h math-rb-h2) |
1092 |
(>= v v1) |
(>= v math-rb-v1) |
1093 |
(< v v2) |
(< v math-rb-v2) |
1094 |
(let ((line (nth v lines))) |
(let ((line (nth v math-read-big-lines))) |
1095 |
(and line |
(and line |
1096 |
(< h (length line)) |
(< h (length line)) |
1097 |
(aref line h)))) |
(aref line h)))) |
1098 |
?\ )) |
?\ )) |
1099 |
|
|
1100 |
(defun math-read-big-emptyp (eh1 ev1 eh2 ev2 &optional what error) |
(defun math-read-big-emptyp (eh1 ev1 eh2 ev2 &optional what error) |
1101 |
(and (< ev1 v1) (setq ev1 v1)) |
(and (< ev1 math-rb-v1) (setq ev1 math-rb-v1)) |
1102 |
(and (< eh1 h1) (setq eh1 h1)) |
(and (< eh1 math-rb-h1) (setq eh1 math-rb-h1)) |
1103 |
(and (> ev2 v2) (setq ev2 v2)) |
(and (> ev2 math-rb-v2) (setq ev2 math-rb-v2)) |
1104 |
(and (> eh2 h2) (setq eh2 h2)) |
(and (> eh2 math-rb-h2) (setq eh2 math-rb-h2)) |
1105 |
(or what (setq what ?\ )) |
(or what (setq what ?\ )) |
1106 |
(let ((p (nthcdr ev1 lines)) |
(let ((p (nthcdr ev1 math-read-big-lines)) |
1107 |
h) |
h) |
1108 |
(while (and (< ev1 ev2) |
(while (and (< ev1 ev2) |
1109 |
(progn |
(progn |
1119 |
p (cdr p))) |
p (cdr p))) |
1120 |
(>= ev1 ev2))) |
(>= ev1 ev2))) |
1121 |
|
|
1122 |
|
;; math-read-big-err-msg is local to math-read-big-expr in calc-ext.el, |
1123 |
|
;; but is used by math-read-big-error which is called (indirectly) by |
1124 |
|
;; math-read-big-expr. |
1125 |
|
(defvar math-read-big-err-msg) |
1126 |
|
|
1127 |
(defun math-read-big-error (h v &optional msg) |
(defun math-read-big-error (h v &optional msg) |
1128 |
(let ((pos 0) |
(let ((pos 0) |
1129 |
(p lines)) |
(p math-read-big-lines)) |
1130 |
(while (> v 0) |
(while (> v 0) |
1131 |
(setq pos (+ pos 1 (length (car p))) |
(setq pos (+ pos 1 (length (car p))) |
1132 |
p (cdr p) |
p (cdr p) |
1133 |
v (1- v))) |
v (1- v))) |
1134 |
(setq h (+ pos (min h (length (car p)))) |
(setq h (+ pos (min h (length (car p)))) |
1135 |
err-msg (list 'error h (or msg "Syntax error"))) |
math-read-big-err-msg (list 'error h (or msg "Syntax error"))) |
1136 |
(throw 'syntax nil))) |
(throw 'syntax nil))) |
1137 |
|
|
1138 |
(defun math-read-big-balance (h v what &optional commas) |
(defun math-read-big-balance (h v what &optional commas) |
1139 |
(let* ((line (nth v lines)) |
(let* ((line (nth v math-read-big-lines)) |
1140 |
(len (min h2 (length line))) |
(len (min math-rb-h2 (length line))) |
1141 |
(count 1)) |
(count 1)) |
1142 |
(while (> count 0) |
(while (> count 0) |
1143 |
(if (>= h len) |
(if (>= h len) |
1144 |
(if what |
(if what |
1145 |
(math-read-big-error h1 v (format "Unmatched `%s'" what)) |
(math-read-big-error nil v (format "Unmatched `%s'" what)) |
1146 |
(setq count 0)) |
(setq count 0)) |
1147 |
(if (memq (aref line h) '(?\( ?\[)) |
(if (memq (aref line h) '(?\( ?\[)) |
1148 |
(setq count (1+ count)) |
(setq count (1+ count)) |