mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-01-27 19:31:38 +00:00
Code Issues Releases Activity

Finish making previous changes.

Browse Source
This commit is contained in:
Jay Belanger 2004-11-25 06:29:11 +00:00
parent 95d91710e9
commit 3effaa28f5
1 changed files with 20 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
lisp/calc/calc-units.el
View File

@ -665,25 +665,25 @@ Entries are (SYMBOL EXPR DOC-STRING TEMP-TYPE BASE-UNITS).")
(defvar math-fbu-base)
(defvar math-fbu-entry)
(defun math-find-base-units (entry)
(if (eq (nth 4 entry) 'boom)
(error "Circular definition involving unit %s" (car entry)))
(or (nth 4 entry)
(let (base)
(setcar (nthcdr 4 entry) 'boom)
(math-find-base-units-rec (nth 1 entry) 1)
'(or base
(error "Dimensionless definition for unit %s" (car entry)))
(while (eq (cdr (car base)) 0)
(setq base (cdr base)))
(let ((b base))
(defun math-find-base-units (math-fbu-entry)
(if (eq (nth 4 math-fbu-entry) 'boom)
(error "Circular definition involving unit %s" (car math-fbu-entry)))
(or (nth 4 math-fbu-entry)
(let (math-fbu-base)
(setcar (nthcdr 4 math-fbu-entry) 'boom)
(math-find-base-units-rec (nth 1 math-fbu-entry) 1)
'(or math-fbu-base
(error "Dimensionless definition for unit %s" (car math-fbu-entry)))
(while (eq (cdr (car math-fbu-base)) 0)
(setq math-fbu-base (cdr math-fbu-base)))
(let ((b math-fbu-base))
(while (cdr b)
(if (eq (cdr (car (cdr b))) 0)
(setcdr b (cdr (cdr b)))
(setq b (cdr b)))))
(setq base (sort base 'math-compare-unit-names))
(setcar (nthcdr 4 entry) base)
base)))
(setq math-fbu-base (sort math-fbu-base 'math-compare-unit-names))
(setcar (nthcdr 4 math-fbu-entry) math-fbu-base)
math-fbu-base)))
(defun math-compare-unit-names (a b)
(memq (car b) (cdr (memq (car a) math-cu-unit-list))))
@ -694,10 +694,11 @@ Entries are (SYMBOL EXPR DOC-STRING TEMP-TYPE BASE-UNITS).")
(let ((ulist (math-find-base-units u)))
(while ulist
(let ((p (* (cdr (car ulist)) pow))
(old (assq (car (car ulist)) base)))
(old (assq (car (car ulist)) math-fbu-base)))
(if old
(setcdr old (+ (cdr old) p))
(setq base (cons (cons (car (car ulist)) p) base))))
(setq math-fbu-base
(cons (cons (car (car ulist)) p) math-fbu-base))))
(setq ulist (cdr ulist)))))
((math-scalarp expr))
((and (eq (car expr) '^)
@ -716,8 +717,8 @@ Entries are (SYMBOL EXPR DOC-STRING TEMP-TYPE BASE-UNITS).")
((eq (car expr) 'var)
(or (eq (nth 1 expr) 'pi)
(error "Unknown name %s in defining expression for unit %s"
(nth 1 expr) (car entry))))
(t (error "Malformed defining expression for unit %s" (car entry))))))
(nth 1 expr) (car math-fbu-entry))))
(t (error "Malformed defining expression for unit %s" (car math-fbu-entry))))))
(defun math-units-in-expr-p (expr sub-exprs)