[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] Changes to emacs/lisp/calc/calc-units.el [emacs-unicode-2]
|
From: |
Miles Bader |
|
Subject: |
[Emacs-diffs] Changes to emacs/lisp/calc/calc-units.el [emacs-unicode-2] |
|
Date: |
Wed, 08 Dec 2004 01:05:10 -0500 |
Index: emacs/lisp/calc/calc-units.el
diff -c emacs/lisp/calc/calc-units.el:1.6.4.3
emacs/lisp/calc/calc-units.el:1.6.4.4
*** emacs/lisp/calc/calc-units.el:1.6.4.3 Fri Nov 19 06:55:08 2004
--- emacs/lisp/calc/calc-units.el Wed Dec 8 05:02:17 2004
***************
*** 27,38 ****
;;; Code:
;; This file is autoloaded from calc-ext.el.
- (require 'calc-ext)
(require 'calc-macs)
- (defun calc-Need-calc-units () nil)
-
;;; Units operations.
;;; Units table last updated 9-Jan-91 by Ulrich Mueller (address@hidden)
--- 27,36 ----
;;; Code:
;; This file is autoloaded from calc-ext.el.
+ (require 'calc-ext)
(require 'calc-macs)
;;; Units operations.
;;; Units table last updated 9-Jan-91 by Ulrich Mueller (address@hidden)
***************
*** 313,319 ****
(calc-slow-wrapper
(let ((expr (calc-top-n 1))
(uoldname nil)
! unew)
(unless (math-units-in-expr-p expr t)
(let ((uold (or old-units
(progn
--- 311,318 ----
(calc-slow-wrapper
(let ((expr (calc-top-n 1))
(uoldname nil)
! unew
! units)
(unless (math-units-in-expr-p expr t)
(let ((uold (or old-units
(progn
***************
*** 409,428 ****
(calc-enter-result 1 "rmun" (math-simplify-units
(math-extract-units (calc-top-n 1))))))
(defun calc-explain-units ()
(interactive)
(calc-wrapper
! (let ((num-units nil)
! (den-units nil))
(calc-explain-units-rec (calc-top-n 1) 1)
! (and den-units (string-match "^[^(].* .*[^)]$" den-units)
! (setq den-units (concat "(" den-units ")")))
! (if num-units
! (if den-units
! (message "%s per %s" num-units den-units)
! (message "%s" num-units))
! (if den-units
! (message "1 per %s" den-units)
(message "No units in expression"))))))
(defun calc-explain-units-rec (expr pow)
--- 408,433 ----
(calc-enter-result 1 "rmun" (math-simplify-units
(math-extract-units (calc-top-n 1))))))
+ ;; The variables calc-num-units and calc-den-units are local to
+ ;; calc-explain-units, but are used by calc-explain-units-rec,
+ ;; which is called by calc-explain-units.
+ (defvar calc-num-units)
+ (defvar calc-den-units)
+
(defun calc-explain-units ()
(interactive)
(calc-wrapper
! (let ((calc-num-units nil)
! (calc-den-units nil))
(calc-explain-units-rec (calc-top-n 1) 1)
! (and calc-den-units (string-match "^[^(].* .*[^)]$" calc-den-units)
! (setq calc-den-units (concat "(" calc-den-units ")")))
! (if calc-num-units
! (if calc-den-units
! (message "%s per %s" calc-num-units calc-den-units)
! (message "%s" calc-num-units))
! (if calc-den-units
! (message "1 per %s" calc-den-units)
(message "No units in expression"))))))
(defun calc-explain-units-rec (expr pow)
***************
*** 463,473 ****
(setq name (concat name "^"
(math-format-number (math-abs pow))))))
(if (math-posp pow)
! (setq num-units (if num-units
! (concat num-units " " name)
name))
! (setq den-units (if den-units
! (concat den-units " " name)
name))))
(cond ((eq (car-safe expr) '*)
(calc-explain-units-rec (nth 1 expr) pow)
--- 468,478 ----
(setq name (concat name "^"
(math-format-number (math-abs pow))))))
(if (math-posp pow)
! (setq calc-num-units (if calc-num-units
! (concat calc-num-units " " name)
name))
! (setq calc-den-units (if calc-den-units
! (concat calc-den-units " " name)
name))))
(cond ((eq (car-safe expr) '*)
(calc-explain-units-rec (nth 1 expr) pow)
***************
*** 615,626 ****
(save-buffer))))
(defun math-build-units-table ()
(or math-units-table
(let* ((combined-units (append math-additional-units
math-standard-units))
! (unit-list (mapcar 'car combined-units))
tab)
(message "Building units table...")
(setq math-units-table-buffer-valid nil)
--- 620,637 ----
(save-buffer))))
+ ;; The variable math-cu-unit-list is local to math-build-units-table,
+ ;; but is used by math-compare-unit-names, which is called (indirectly)
+ ;; by math-build-units-table.
+ ;; math-cu-unit-list is also local to math-convert-units, but is used
+ ;; by math-convert-units-rec, which is called by math-convert-units.
+ (defvar math-cu-unit-list)
(defun math-build-units-table ()
(or math-units-table
(let* ((combined-units (append math-additional-units
math-standard-units))
! (math-cu-unit-list (mapcar 'car combined-units))
tab)
(message "Building units table...")
(setq math-units-table-buffer-valid nil)
***************
*** 646,673 ****
(message "Building units table...done")
(setq math-units-table tab))))
! (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))
(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)))
(defun math-compare-unit-names (a b)
! (memq (car b) (cdr (memq (car a) unit-list))))
(defun math-find-base-units-rec (expr pow)
(let ((u (math-check-unit-name expr)))
--- 657,690 ----
(message "Building units table...done")
(setq math-units-table tab))))
! ;; The variables math-fbu-base and math-fbu-entry are local to
! ;; math-find-base-units, but are used by math-find-base-units-rec,
! ;; which is called by math-find-base-units.
! (defvar math-fbu-base)
! (defvar math-fbu-entry)
!
! (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 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))))
(defun math-find-base-units-rec (expr pow)
(let ((u (math-check-unit-name expr)))
***************
*** 675,684 ****
(let ((ulist (math-find-base-units u)))
(while ulist
(let ((p (* (cdr (car ulist)) pow))
! (old (assq (car (car ulist)) base)))
(if old
(setcdr old (+ (cdr old) p))
! (setq base (cons (cons (car (car ulist)) p) base))))
(setq ulist (cdr ulist)))))
((math-scalarp expr))
((and (eq (car expr) '^)
--- 692,702 ----
(let ((ulist (math-find-base-units u)))
(while ulist
(let ((p (* (cdr (car ulist)) pow))
! (old (assq (car (car ulist)) math-fbu-base)))
(if old
(setcdr old (+ (cdr old) p))
! (setq math-fbu-base
! (cons (cons (car (car ulist)) p) math-fbu-base))))
(setq ulist (cdr ulist)))))
((math-scalarp expr))
((and (eq (car expr) '^)
***************
*** 697,704 ****
((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))))))
(defun math-units-in-expr-p (expr sub-exprs)
--- 715,722 ----
((eq (car expr) 'var)
(or (eq (nth 1 expr) 'pi)
(error "Unknown name %s in defining expression for unit %s"
! (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)
***************
*** 751,758 ****
(assq (intern (substring name 3))
math-units-table))))))))
! (defun math-to-standard-units (expr which-standard)
(math-to-standard-rec expr))
(defun math-to-standard-rec (expr)
--- 769,780 ----
(assq (intern (substring name 3))
math-units-table))))))))
+ ;; The variable math-which-standard is local to math-to-standard-units,
+ ;; but is used by math-to-standard-rec, which is called by
+ ;; math-to-standard-units.
+ (defvar math-which-standard)
! (defun math-to-standard-units (expr math-which-standard)
(math-to-standard-rec expr))
(defun math-to-standard-rec (expr)
***************
*** 763,769 ****
(progn
(if (nth 1 u)
(setq expr (math-to-standard-rec (nth 1 u)))
! (let ((st (assq (car u) which-standard)))
(if st
(setq expr (nth 1 st))
(setq expr (list 'var (car u)
--- 785,791 ----
(progn
(if (nth 1 u)
(setq expr (math-to-standard-rec (nth 1 u)))
! (let ((st (assq (car u) math-which-standard)))
(if st
(setq expr (nth 1 st))
(setq expr (list 'var (car u)
***************
*** 842,850 ****
unit nil))
t)))
(defun math-find-compatible-unit (expr unit)
! (let ((u (math-check-unit-name unit)))
! (if u
(math-find-compatible-unit-rec expr 1))))
(defun math-find-compatible-unit-rec (expr pow)
--- 864,877 ----
unit nil))
t)))
+ ;; The variable math-fcu-u is local to math-find-compatible-unit,
+ ;; but is used by math-find-compatible-rec which is called by
+ ;; math-find-compatible-unit.
+ (defvar math-fcu-u)
+
(defun math-find-compatible-unit (expr unit)
! (let ((math-fcu-u (math-check-unit-name unit)))
! (if math-fcu-u
(math-find-compatible-unit-rec expr 1))))
(defun math-find-compatible-unit-rec (expr pow)
***************
*** 859,897 ****
(math-find-compatible-unit-rec (nth 1 expr) (* pow (nth 2 expr))))
(t
(let ((u2 (math-check-unit-name expr)))
! (if (equal (nth 4 u) (nth 4 u2))
(cons expr pow))))))
! (defun math-convert-units (expr new-units &optional pure)
(math-with-extra-prec 2
! (let ((compat (and (not pure) (math-find-compatible-unit expr new-units)))
! (unit-list nil)
(math-combining-units nil))
(if compat
(math-simplify-units
(math-mul (math-mul (math-simplify-units
(math-div expr (math-pow (car compat)
(cdr compat))))
! (math-pow new-units (cdr compat)))
(math-simplify-units
(math-to-standard-units
! (math-pow (math-div (car compat) new-units)
(cdr compat))
nil))))
! (when (setq unit-list (math-decompose-units new-units))
! (setq new-units (nth 2 (car unit-list))))
(when (eq (car-safe expr) '+)
(setq expr (math-simplify-units expr)))
(if (math-units-in-expr-p expr t)
(math-convert-units-rec expr)
(math-apply-units (math-to-standard-units
! (list '/ expr new-units) nil)
! new-units unit-list pure))))))
(defun math-convert-units-rec (expr)
(if (math-units-in-expr-p expr nil)
! (math-apply-units (math-to-standard-units (list '/ expr new-units) nil)
! new-units unit-list pure)
(if (Math-primp expr)
expr
(cons (car expr)
--- 886,932 ----
(math-find-compatible-unit-rec (nth 1 expr) (* pow (nth 2 expr))))
(t
(let ((u2 (math-check-unit-name expr)))
! (if (equal (nth 4 math-fcu-u) (nth 4 u2))
(cons expr pow))))))
! ;; The variables math-cu-new-units and math-cu-pure are local to
! ;; math-convert-units, but are used by math-convert-units-rec,
! ;; which is called by math-convert-units.
! (defvar math-cu-new-units)
! (defvar math-cu-pure)
!
! (defun math-convert-units (expr math-cu-new-units &optional math-cu-pure)
(math-with-extra-prec 2
! (let ((compat (and (not math-cu-pure)
! (math-find-compatible-unit expr math-cu-new-units)))
! (math-cu-unit-list nil)
(math-combining-units nil))
(if compat
(math-simplify-units
(math-mul (math-mul (math-simplify-units
(math-div expr (math-pow (car compat)
(cdr compat))))
! (math-pow math-cu-new-units (cdr compat)))
(math-simplify-units
(math-to-standard-units
! (math-pow (math-div (car compat) math-cu-new-units)
(cdr compat))
nil))))
! (when (setq math-cu-unit-list (math-decompose-units math-cu-new-units))
! (setq math-cu-new-units (nth 2 (car math-cu-unit-list))))
(when (eq (car-safe expr) '+)
(setq expr (math-simplify-units expr)))
(if (math-units-in-expr-p expr t)
(math-convert-units-rec expr)
(math-apply-units (math-to-standard-units
! (list '/ expr math-cu-new-units) nil)
! math-cu-new-units math-cu-unit-list
math-cu-pure))))))
(defun math-convert-units-rec (expr)
(if (math-units-in-expr-p expr nil)
! (math-apply-units (math-to-standard-units
! (list '/ expr math-cu-new-units) nil)
! math-cu-new-units math-cu-unit-list math-cu-pure)
(if (Math-primp expr)
expr
(cons (car expr)
***************
*** 1026,1035 ****
(setcar unitp pname)
math-simplify-expr)))))))
(math-defsimplify /
(and math-simplifying-units
(let ((np (cdr math-simplify-expr))
! (try-cancel-units 0)
n nn)
(setq n (if (eq (car-safe (nth 2 math-simplify-expr)) '*)
(cdr (nth 2 math-simplify-expr))
--- 1061,1072 ----
(setcar unitp pname)
math-simplify-expr)))))))
+ (defvar math-try-cancel-units)
+
(math-defsimplify /
(and math-simplifying-units
(let ((np (cdr math-simplify-expr))
! (math-try-cancel-units 0)
n nn)
(setq n (if (eq (car-safe (nth 2 math-simplify-expr)) '*)
(cdr (nth 2 math-simplify-expr))
***************
*** 1044,1050 ****
(math-simplify-units-divisor (cdr n) (cdr (cdr math-simplify-expr)))
(setq np (cdr (cdr n))))
(math-simplify-units-divisor np (cdr (cdr math-simplify-expr)))
! (if (eq try-cancel-units 0)
(let* ((math-simplifying-units nil)
(base (math-simplify
(math-to-standard-units math-simplify-expr nil))))
--- 1081,1087 ----
(math-simplify-units-divisor (cdr n) (cdr (cdr math-simplify-expr)))
(setq np (cdr (cdr n))))
(math-simplify-units-divisor np (cdr (cdr math-simplify-expr)))
! (if (eq math-try-cancel-units 0)
(let* ((math-simplifying-units nil)
(base (math-simplify
(math-to-standard-units math-simplify-expr nil))))
***************
*** 1089,1096 ****
(setq ud1 ud)
(while ud1
(and (eq (car (car un)) (car (car ud1)))
! (setq try-cancel-units
! (+ try-cancel-units
(- (* (cdr (car un)) pow1)
(* (cdr (car ud)) pow2)))))
(setq ud1 (cdr ud1)))
--- 1126,1133 ----
(setq ud1 ud)
(while ud1
(and (eq (car (car un)) (car (car ud1)))
! (setq math-try-cancel-units
! (+ math-try-cancel-units
(- (* (cdr (car un)) pow1)
(* (cdr (car ud)) pow2)))))
(setq ud1 (cdr ud1)))
***************
*** 1304,1309 ****
--- 1341,1348 ----
(pop-to-buffer (get-buffer "*Units Table*"))
(display-buffer (get-buffer "*Units Table*")))))
+ (provide 'calc-units)
+
;; Local Variables:
;; coding: iso-latin-1
;; End:
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] Changes to emacs/lisp/calc/calc-units.el [emacs-unicode-2],
Miles Bader <=