/[emacs]/emacs/lisp/calc/calc-lang.el
ViewVC logotype

Diff of /emacs/lisp/calc/calc-lang.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.8 by jpb, Thu Nov 11 05:52:17 2004 UTC revision 1.9 by jpb, Mon Nov 22 04:53:51 2004 UTC
# Line 3  Line 3 
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    
# Line 708  Line 707 
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 ?\.)
# Line 843  Line 876 
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
# Line 858  Line 893 
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))
# Line 889  Line 924 
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)))
# Line 898  Line 933 
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))
# Line 923  Line 958 
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                                                    ?\])                                                    ?\])
# Line 934  Line 969 
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)
# Line 958  Line 993 
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) ?\))
# Line 979  Line 1014 
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)))
# Line 1028  Line 1064 
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
# Line 1081  Line 1119 
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))

Legend:
Removed from v.1.8  
changed lines
  Added in v.1.9

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26