diff options
author | Jay Belanger <jay.p.belanger@gmail.com> | 2012-08-11 23:32:28 -0500 |
---|---|---|
committer | Jay Belanger <jay.p.belanger@gmail.com> | 2012-08-11 23:32:28 -0500 |
commit | 0fd0912879f70f410cd336e538d8c515508126c7 (patch) | |
tree | 445a6ded9606f9404bb269851b570c700735d94a /lisp | |
parent | 38a414f0f1a5f658f8b9fa6c8914d468e9394586 (diff) | |
download | emacs-0fd0912879f70f410cd336e538d8c515508126c7.tar.gz |
calc/calc-units.el (math-default-units-table): Give it an
initial value.
(math-put-default-units): Add options to put composite units and unit
systems in default units table.
(calc-convert-units): Send composite units to `math-put-default-units'
when appropriate.
Diffstat (limited to 'lisp')
-rw-r--r-- | lisp/ChangeLog | 9 | ||||
-rw-r--r-- | lisp/calc/calc-units.el | 117 |
2 files changed, 69 insertions, 57 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 5dbd592448c..716555f2ffe 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,12 @@ +2012-08-12 Jay Belanger <jay.p.belanger@gmail.com> + + * calc/calc-units.el (math-default-units-table): Give an + initial value. + (math-put-default-units): Add options to put composite units and + unit systems in the default units table. + (calc-convert-units): Send composite units to + `math-put-default-units' when appropriate. + 2012-08-11 Glenn Morris <rgm@gnu.org> * emacs-lisp/copyright.el (copyright-update-directory): Logic fix. diff --git a/lisp/calc/calc-units.el b/lisp/calc/calc-units.el index e5c7b6737fb..39f710f8322 100644 --- a/lisp/calc/calc-units.el +++ b/lisp/calc/calc-units.el @@ -404,7 +404,7 @@ If EXPR is nil, return nil." (math-composition-to-string cexpr)))))) (defvar math-default-units-table - (make-hash-table :test 'equal) + #s(hash-table test equal data (1 (1))) "A table storing previously converted units.") (defun math-get-default-units (expr) @@ -418,22 +418,24 @@ If EXPR is nil, return nil." (math-make-unit-string (cadr default-units)) (math-make-unit-string (car default-units))))) -(defun math-put-default-units (expr) - "Put the units in EXPR in the default units table." - (let ((units (math-get-units expr))) - (unless (eq units 1) - (let* ((standard-units (math-get-standard-units expr)) - (default-units (gethash - standard-units - math-default-units-table))) - (cond - ((not default-units) - (puthash standard-units (list units) math-default-units-table)) - ((not (equal units (car default-units))) - (puthash standard-units - (list units (car default-units)) - math-default-units-table))))))) - +(defun math-put-default-units (expr &optional comp std) + "Put the units in EXPR in the default units table. +If COMP or STD is non-nil, put that in the units table instead." + (let* ((new-units (or comp std (math-get-units expr))) + (standard-units (math-get-standard-units + (cond + (comp (math-simplify-units expr)) + (std expr) + (t new-units)))) + (default-units (gethash standard-units math-default-units-table))) + (unless (eq standard-units 1) + (cond + ((not default-units) + (puthash standard-units (list new-units) math-default-units-table)) + ((not (equal new-units (car default-units))) + (puthash standard-units + (list new-units (car default-units)) + math-default-units-table)))))) (defun calc-convert-units (&optional old-units new-units) (interactive) @@ -457,47 +459,48 @@ If EXPR is nil, return nil." (when (eq (car-safe uold) 'error) (error "Bad format in units expression: %s" (nth 1 uold))) (setq expr (math-mul expr uold)))) - (unless new-units - (setq defunits (math-get-default-units expr)) - (setq new-units - (read-string (concat - (if uoldname - (concat "Old units: " - uoldname - ", new units") - "New units") - (if defunits - (concat - " (default " - defunits - "): ") - ": ")))) - - (if (and - (string= new-units "") - defunits) - (setq new-units defunits))) - (when (string-match "\\` */" new-units) - (setq new-units (concat "1" new-units))) - (setq units (math-read-expr new-units)) - (when (eq (car-safe units) 'error) - (error "Bad format in units expression: %s" (nth 2 units))) - (if calc-ensure-consistent-units - (math-check-unit-consistency expr units)) - (math-put-default-units units) - (let ((unew (math-units-in-expr-p units t)) - (std (and (eq (car-safe units) 'var) - (assq (nth 1 units) math-standard-units-systems)))) - (if std - (calc-enter-result 1 "cvun" (math-simplify-units - (math-to-standard-units expr - (nth 1 std)))) - (unless unew + (setq defunits (math-get-default-units expr)) + (if (equal defunits "1") + (progn + (calc-enter-result 1 "cvun" (math-simplify-units expr)) + (message "All units in expression cancel")) + (unless new-units + (setq new-units + (read-string (concat + (if uoldname + (concat "Old units: " + uoldname + ", new units") + "New units") + (if defunits + (concat + " (default " + defunits + "): ") + ": ")))) + (if (and + (string= new-units "") + defunits) + (setq new-units defunits))) + (when (string-match "\\` */" new-units) + (setq new-units (concat "1" new-units))) + (setq units (math-read-expr new-units)) + (when (eq (car-safe units) 'error) + (error "Bad format in units expression: %s" (nth 2 units))) + (if calc-ensure-consistent-units + (math-check-unit-consistency expr units)) + (let ((unew (math-units-in-expr-p units t)) + (std (and (eq (car-safe units) 'var) + (assq (nth 1 units) math-standard-units-systems))) + (comp (eq (car-safe units) '+))) + (unless (or unew std) (error "No units specified")) - (calc-enter-result 1 "cvun" - (math-convert-units - expr units - (and uoldname (not (equal uoldname "1")))))))))) + (let ((res + (if std + (math-simplify-units (math-to-standard-units expr (nth 1 std))) + (math-convert-units expr units (and uoldname (not (equal uoldname "1"))))))) + (math-put-default-units res (if comp units)) + (calc-enter-result 1 "cvun" res))))))) (defun calc-autorange-units (arg) (interactive "P") |