[Emacs-diffs] /srv/bzr/emacs/trunk r109572: calc/calc-units.el (math-default-units-table): Give it an

[Jay Belanger]

------------------------------------------------------------
revno: 109572
committer: Jay Belanger <address@hidden>
branch nick: trunk
timestamp: Sat 2012-08-11 23:32:28 -0500
message:
  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.
modified:
  lisp/ChangeLog
  lisp/calc/calc-units.el

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2012-08-11 04:46:38 +0000
+++ b/lisp/ChangeLog    2012-08-12 04:32:28 +0000
@@ -1,3 +1,12 @@
+2012-08-12  Jay Belanger  <address@hidden>
+
+       * 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  <address@hidden>
 
        * emacs-lisp/copyright.el (copyright-update-directory): Logic fix.

=== modified file 'lisp/calc/calc-units.el'
--- a/lisp/calc/calc-units.el   2012-05-19 14:59:47 +0000
+++ b/lisp/calc/calc-units.el   2012-08-12 04:32:28 +0000
@@ -404,7 +404,7 @@
            (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 @@
         (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 @@
         (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")