;;; calc-units.el --- unit conversion functions for Calc
-;; Copyright (C) 1990-1993, 2001-2012 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2014 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
(math-composition-to-string cexpr))))))
(defvar math-default-units-table
- #s(hash-table test equal data (1 (1)))
+ (make-hash-table :test 'equal)
"A table storing previously converted units.")
(defun math-get-default-units (expr)
(list new-units (car default-units))
math-default-units-table))))))
+(defvar calc-allow-units-as-numbers t)
+
(defun calc-convert-units (&optional old-units new-units)
(interactive)
(calc-slow-wrapper
(let ((expr (calc-top-n 1))
(uoldname nil)
+ (unitscancel nil)
+ (nouold nil)
unew
units
defunits)
- (unless (math-units-in-expr-p expr t)
+ (if (or (not (math-units-in-expr-p expr t))
+ (setq unitscancel (and
+ (if (get 'calc-allow-units-as-numbers 'saved-value)
+ (car (get 'calc-allow-units-as-numbers 'saved-value))
+ calc-allow-units-as-numbers)
+ (eq (math-get-standard-units expr) 1))))
(let ((uold (or old-units
(progn
- (setq uoldname (read-string "Old units: "))
+ (setq uoldname
+ (if unitscancel
+ (read-string
+ "(The expression is unitless when simplified) Old Units: ")
+ (read-string "Old units: ")))
(if (equal uoldname "")
(progn
+ (setq nouold unitscancel)
(setq uoldname "1")
1)
(if (string-match "\\` */" uoldname)
(error "Bad format in units expression: %s" (nth 1 uold)))
(setq expr (math-mul expr uold))))
(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"))
- (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)))))))
+ (unless new-units
+ (setq new-units
+ (read-string (concat
+ (if (and uoldname (not nouold))
+ (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"))
+ (let* ((noold (and uoldname (not (equal uoldname "1"))))
+ (res
+ (if std
+ (math-simplify-units (math-to-standard-units expr (nth 1 std)))
+ (math-convert-units expr units noold))))
+ (unless std
+ (math-put-default-units (if noold units res) (if comp units)))
+ (calc-enter-result 1 "cvun" res))))))
(defun calc-autorange-units (arg)
(interactive "P")
(mapcar 'math-remove-units (cdr expr))))))
(defun math-extract-units (expr)
- (if (memq (car-safe expr) '(* /))
- (cons (car expr)
- (mapcar 'math-extract-units (cdr expr)))
- (if (math-check-unit-name expr) expr 1)))
+ (cond
+ ((memq (car-safe expr) '(* /))
+ (cons (car expr)
+ (mapcar 'math-extract-units (cdr expr))))
+ ((eq (car-safe expr) '^)
+ (list '^ (math-extract-units (nth 1 expr)) (nth 2 expr)))
+ ((math-check-unit-name expr) expr)
+ (t 1)))
(defun math-build-units-table-buffer (enter-buffer)
(if (not (and math-units-table math-units-table-buffer-valid