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

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

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

revision 1.3.4.2 by miles, Tue Oct 14 23:35:49 2003 UTC revision 1.3.4.3 by miles, Fri Nov 12 04:21:20 2004 UTC
# Line 1466  Line 1466 
1466  (defun math-read-brackets (space-sep close)  (defun math-read-brackets (space-sep close)
1467    (and space-sep (setq space-sep (not (math-check-for-commas))))    (and space-sep (setq space-sep (not (math-check-for-commas))))
1468    (math-read-token)    (math-read-token)
1469    (while (eq exp-token 'space)    (while (eq math-exp-token 'space)
1470      (math-read-token))      (math-read-token))
1471    (if (or (equal exp-data close)    (if (or (equal math-expr-data close)
1472            (eq exp-token 'end))            (eq math-exp-token 'end))
1473        (progn        (progn
1474          (math-read-token)          (math-read-token)
1475          '(vec))          '(vec))
1476      (let ((save-exp-pos exp-pos)      (let ((save-exp-pos math-exp-pos)
1477            (save-exp-old-pos exp-old-pos)            (save-exp-old-pos math-exp-old-pos)
1478            (save-exp-token exp-token)            (save-exp-token math-exp-token)
1479            (save-exp-data exp-data)            (save-exp-data math-expr-data)
1480            (vals (let ((exp-keep-spaces space-sep))            (vals (let ((math-exp-keep-spaces space-sep))
1481                    (if (or (equal exp-data "\\dots")                    (if (or (equal math-expr-data "\\dots")
1482                            (equal exp-data "\\ldots"))                            (equal math-expr-data "\\ldots"))
1483                        '(vec (neg (var inf var-inf)))                        '(vec (neg (var inf var-inf)))
1484                      (catch 'syntax (math-read-vector))))))                      (catch 'syntax (math-read-vector))))))
1485        (if (stringp vals)        (if (stringp vals)
1486            (if space-sep            (if space-sep
1487                (let ((error-exp-pos exp-pos)                (let ((error-exp-pos math-exp-pos)
1488                      (error-exp-old-pos exp-old-pos)                      (error-exp-old-pos math-exp-old-pos)
1489                      vals2)                      vals2)
1490                  (setq exp-pos save-exp-pos                  (setq math-exp-pos save-exp-pos
1491                        exp-old-pos save-exp-old-pos                        math-exp-old-pos save-exp-old-pos
1492                        exp-token save-exp-token                        math-exp-token save-exp-token
1493                        exp-data save-exp-data)                        math-expr-data save-exp-data)
1494                  (let ((exp-keep-spaces nil))                  (let ((math-exp-keep-spaces nil))
1495                    (setq vals2 (catch 'syntax (math-read-vector))))                    (setq vals2 (catch 'syntax (math-read-vector))))
1496                  (if (and (not (stringp vals2))                  (if (and (not (stringp vals2))
1497                           (or (assoc exp-data '(("\\ldots") ("\\dots") (";")))                           (or (assoc math-expr-data '(("\\ldots") ("\\dots") (";")))
1498                               (equal exp-data close)                               (equal math-expr-data close)
1499                               (eq exp-token 'end)))                               (eq math-exp-token 'end)))
1500                      (setq space-sep nil                      (setq space-sep nil
1501                            vals vals2)                            vals vals2)
1502                    (setq exp-pos error-exp-pos                    (setq math-exp-pos error-exp-pos
1503                          exp-old-pos error-exp-old-pos)                          math-exp-old-pos error-exp-old-pos)
1504                    (throw 'syntax vals)))                    (throw 'syntax vals)))
1505              (throw 'syntax vals)))              (throw 'syntax vals)))
1506        (if (or (equal exp-data "\\dots")        (if (or (equal math-expr-data "\\dots")
1507                (equal exp-data "\\ldots"))                (equal math-expr-data "\\ldots"))
1508            (progn            (progn
1509              (math-read-token)              (math-read-token)
1510              (setq vals (if (> (length vals) 2)              (setq vals (if (> (length vals) 2)
1511                             (cons 'calcFunc-mul (cdr vals)) (nth 1 vals)))                             (cons 'calcFunc-mul (cdr vals)) (nth 1 vals)))
1512              (let ((exp2 (if (or (equal exp-data close)              (let ((exp2 (if (or (equal math-expr-data close)
1513                                  (equal exp-data ")")                                  (equal math-expr-data ")")
1514                                  (eq exp-token 'end))                                  (eq math-exp-token 'end))
1515                              '(var inf var-inf)                              '(var inf var-inf)
1516                            (math-read-expr-level 0))))                            (math-read-expr-level 0))))
1517                (setq vals                (setq vals
1518                      (list 'intv                      (list 'intv
1519                            (if (equal exp-data ")") 2 3)                            (if (equal math-expr-data ")") 2 3)
1520                            vals                            vals
1521                            exp2)))                            exp2)))
1522              (if (not (or (equal exp-data close)              (if (not (or (equal math-expr-data close)
1523                           (equal exp-data ")")                           (equal math-expr-data ")")
1524                           (eq exp-token 'end)))                           (eq math-exp-token 'end)))
1525                  (throw 'syntax "Expected `]'")))                  (throw 'syntax "Expected `]'")))
1526          (if (equal exp-data ";")          (if (equal math-expr-data ";")
1527              (let ((exp-keep-spaces space-sep))              (let ((math-exp-keep-spaces space-sep))
1528                (setq vals (cons 'vec (math-read-matrix (list vals))))))                (setq vals (cons 'vec (math-read-matrix (list vals))))))
1529          (if (not (or (equal exp-data close)          (if (not (or (equal math-expr-data close)
1530                       (eq exp-token 'end)))                       (eq math-exp-token 'end)))
1531              (throw 'syntax "Expected `]'")))              (throw 'syntax "Expected `]'")))
1532        (or (eq exp-token 'end)        (or (eq math-exp-token 'end)
1533            (math-read-token))            (math-read-token))
1534        vals)))        vals)))
1535    
1536  (defun math-check-for-commas (&optional balancing)  (defun math-check-for-commas (&optional balancing)
1537    (let ((count 0)    (let ((count 0)
1538          (pos (1- exp-pos)))          (pos (1- math-exp-pos)))
1539      (while (and (>= count 0)      (while (and (>= count 0)
1540                  (setq pos (string-match                  (setq pos (string-match
1541                             (if balancing "[],[{}()<>]" "[],[{}()]")                             (if balancing "[],[{}()<>]" "[],[{}()]")
1542                             exp-str (1+ pos)))                             math-exp-str (1+ pos)))
1543                  (or (/= (aref exp-str pos) ?,) (> count 0) balancing))                  (or (/= (aref math-exp-str pos) ?,) (> count 0) balancing))
1544        (cond ((memq (aref exp-str pos) '(?\[ ?\{ ?\( ?\<))        (cond ((memq (aref math-exp-str pos) '(?\[ ?\{ ?\( ?\<))
1545               (setq count (1+ count)))               (setq count (1+ count)))
1546              ((memq (aref exp-str pos) '(?\] ?\} ?\) ?\>))              ((memq (aref math-exp-str pos) '(?\] ?\} ?\) ?\>))
1547               (setq count (1- count)))))               (setq count (1- count)))))
1548      (if balancing      (if balancing
1549          pos          pos
1550        (and pos (= (aref exp-str pos) ?,)))))        (and pos (= (aref math-exp-str pos) ?,)))))
1551    
1552  (defun math-read-vector ()  (defun math-read-vector ()
1553    (let* ((val (list (math-read-expr-level 0)))    (let* ((val (list (math-read-expr-level 0)))
1554           (last val))           (last val))
1555      (while (progn      (while (progn
1556               (while (eq exp-token 'space)               (while (eq math-exp-token 'space)
1557                 (math-read-token))                 (math-read-token))
1558               (and (not (eq exp-token 'end))               (and (not (eq math-exp-token 'end))
1559                    (not (equal exp-data ";"))                    (not (equal math-expr-data ";"))
1560                    (not (equal exp-data close))                    (not (equal math-expr-data close))
1561                    (not (equal exp-data "\\dots"))                    (not (equal math-expr-data "\\dots"))
1562                    (not (equal exp-data "\\ldots"))))                    (not (equal math-expr-data "\\ldots"))))
1563        (if (equal exp-data ",")        (if (equal math-expr-data ",")
1564            (math-read-token))            (math-read-token))
1565        (while (eq exp-token 'space)        (while (eq math-exp-token 'space)
1566          (math-read-token))          (math-read-token))
1567        (let ((rest (list (math-read-expr-level 0))))        (let ((rest (list (math-read-expr-level 0))))
1568          (setcdr last rest)          (setcdr last rest)
# Line 1570  Line 1570 
1570      (cons 'vec val)))      (cons 'vec val)))
1571    
1572  (defun math-read-matrix (mat)  (defun math-read-matrix (mat)
1573    (while (equal exp-data ";")    (while (equal math-expr-data ";")
1574      (math-read-token)      (math-read-token)
1575      (while (eq exp-token 'space)      (while (eq math-exp-token 'space)
1576        (math-read-token))        (math-read-token))
1577      (setq mat (nconc mat (list (math-read-vector)))))      (setq mat (nconc mat (list (math-read-vector)))))
1578    mat)    mat)

Legend:
Removed from v.1.3.4.2  
changed lines
  Added in v.1.3.4.3

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