Initial import of Calc 2.02f.

1 files changed, 1352 insertions, 0 deletions

diff --git a/lisp/calc/calc-units.el b/lisp/calc/calc-units.el
new file mode 100644
index 00000000000..80c30622b38
--- /dev/null
+++ b/lisp/calc/calc-units.el
@@ -0,0 +1,1352 @@
+;; Calculator for GNU Emacs, part II [calc-units.el]
+;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc.
+;; Written by Dave Gillespie, daveg@synaptics.com.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY.  No author or distributor
+;; accepts responsibility to anyone for the consequences of using it
+;; or for whether it serves any particular purpose or works at all,
+;; unless he says so in writing.  Refer to the GNU Emacs General Public
+;; License for full details.
+
+;; Everyone is granted permission to copy, modify and redistribute
+;; GNU Emacs, but only under the conditions described in the
+;; GNU Emacs General Public License.   A copy of this license is
+;; supposed to have been given to you along with GNU Emacs so you
+;; can know your rights and responsibilities.  It should be in a
+;; file named COPYING.  Among other things, the copyright notice
+;; and this notice must be preserved on all copies.
+
+
+
+;; This file is autoloaded from calc-ext.el.
+(require 'calc-ext)
+
+(require 'calc-macs)
+
+(defun calc-Need-calc-units () nil)
+
+
+;;; Units commands.
+
+(defun calc-base-units ()
+  (interactive)
+  (calc-slow-wrapper
+   (let ((calc-autorange-units nil))
+     (calc-enter-result 1 "bsun" (math-simplify-units
+				  (math-to-standard-units (calc-top-n 1)
+							  nil)))))
+)
+
+(defun calc-quick-units ()
+  (interactive)
+  (calc-slow-wrapper
+   (let* ((num (- last-command-char ?0))
+	  (pos (if (= num 0) 10 num))
+	  (units (calc-var-value 'var-Units))
+	  (expr (calc-top-n 1)))
+     (or (and (>= num 0) (<= num 9))
+	 (error "Bad unit number"))
+     (or (math-vectorp units)
+	 (error "No \"quick units\" are defined"))
+     (or (< pos (length units))
+	 (error "Unit number %d not defined" pos))
+     (if (math-units-in-expr-p expr nil)
+	 (calc-enter-result 1 (format "cun%d" num)
+			    (math-convert-units expr (nth pos units)))
+       (calc-enter-result 1 (format "*un%d" num)
+			  (math-simplify-units
+			   (math-mul expr (nth pos units)))))))
+)
+
+(defun calc-convert-units (&optional old-units new-units)
+  (interactive)
+  (calc-slow-wrapper
+   (let ((expr (calc-top-n 1))
+	 (uoldname nil)
+	 unew)
+     (or (math-units-in-expr-p expr t)
+	 (let ((uold (or old-units
+			 (progn
+			   (setq uoldname (read-string "Old units: "))
+			   (if (equal uoldname "")
+			       (progn
+				 (setq uoldname "1")
+				 1)
+			     (if (string-match "\\` */" uoldname)
+				 (setq uoldname (concat "1" uoldname)))
+			     (math-read-expr uoldname))))))
+	   (if (eq (car-safe uold) 'error)
+	       (error "Bad format in units expression: %s" (nth 1 uold)))
+	   (setq expr (math-mul expr uold))))
+     (or new-units
+	 (setq new-units (read-string (if uoldname
+					  (concat "Old units: "
+						  uoldname
+						  ", new units: ")
+					"New units: "))))
+     (if (string-match "\\` */" new-units)
+	 (setq new-units (concat "1" new-units)))
+     (setq units (math-read-expr new-units))
+     (if (eq (car-safe units) 'error)
+	 (error "Bad format in units expression: %s" (nth 2 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))))
+	 (or unew
+	     (error "No units specified"))
+	 (calc-enter-result 1 "cvun"
+			    (math-convert-units
+			     expr units
+			     (and uoldname (not (equal uoldname "1")))))))))
+)
+
+(defun calc-autorange-units (arg)
+  (interactive "P")
+  (calc-wrapper
+   (calc-change-mode 'calc-autorange-units arg nil t)
+   (message (if calc-autorange-units
+		"Adjusting target unit prefix automatically."
+	      "Using target units exactly.")))
+)
+
+(defun calc-convert-temperature (&optional old-units new-units)
+  (interactive)
+  (calc-slow-wrapper
+   (let ((expr (calc-top-n 1))
+	 (uold nil)
+	 (uoldname nil)
+	 unew)
+     (setq uold (or old-units
+		    (let ((units (math-single-units-in-expr-p expr)))
+		      (if units
+			  (if (consp units)
+			      (list 'var (car units)
+				    (intern (concat "var-"
+						    (symbol-name
+						     (car units)))))
+			    (error "Not a pure temperature expression"))
+			(math-read-expr
+			 (setq uoldname (read-string
+					 "Old temperature units: ")))))))
+     (if (eq (car-safe uold) 'error)
+	 (error "Bad format in units expression: %s" (nth 2 uold)))
+     (or (math-units-in-expr-p expr nil)
+	 (setq expr (math-mul expr uold)))
+     (setq unew (or new-units
+		    (math-read-expr
+		     (read-string (if uoldname
+				      (concat "Old temperature units: "
+					      uoldname
+					      ", new units: ")
+				    "New temperature units: ")))))
+     (if (eq (car-safe unew) 'error)
+	 (error "Bad format in units expression: %s" (nth 2 unew)))
+     (calc-enter-result 1 "cvtm" (math-simplify-units
+				  (math-convert-temperature expr uold unew
+							    uoldname)))))
+)
+
+(defun calc-remove-units ()
+  (interactive)
+  (calc-slow-wrapper
+   (calc-enter-result 1 "rmun" (math-simplify-units
+				(math-remove-units (calc-top-n 1)))))
+)
+
+(defun calc-extract-units ()
+  (interactive)
+  (calc-slow-wrapper
+   (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)
+  (let ((u (math-check-unit-name expr))
+	pos)
+    (if (and u (not (math-zerop pow)))
+	(let ((name (or (nth 2 u) (symbol-name (car u)))))
+	  (if (eq (aref name 0) ?\*)
+	      (setq name (substring name 1)))
+	  (if (string-match "[^a-zA-Z0-9']" name)
+	      (if (string-match "^[a-zA-Z0-9' ()]*$" name)
+		  (while (setq pos (string-match "[ ()]" name))
+		    (setq name (concat (substring name 0 pos)
+				       (if (eq (aref name pos) 32) "-" "")
+				       (substring name (1+ pos)))))
+		(setq name (concat "(" name ")"))))
+	  (or (eq (nth 1 expr) (car u))
+	      (setq name (concat (nth 2 (assq (aref (symbol-name
+						     (nth 1 expr)) 0)
+					      math-unit-prefixes))
+				 (if (and (string-match "[^a-zA-Z0-9']" name)
+					  (not (memq (car u) '(mHg gf))))
+				     (concat "-" name)
+				   (downcase name)))))
+	  (cond ((or (math-equal-int pow 1)
+		     (math-equal-int pow -1)))
+		((or (math-equal-int pow 2)
+		     (math-equal-int pow -2))
+		 (if (equal (nth 4 u) '((m . 1)))
+		     (setq name (concat "Square-" name))
+		   (setq name (concat name "-squared"))))
+		((or (math-equal-int pow 3)
+		     (math-equal-int pow -3))
+		 (if (equal (nth 4 u) '((m . 1)))
+		     (setq name (concat "Cubic-" name))
+		   (setq name (concat name "-cubed"))))
+		(t
+		 (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)
+	     (calc-explain-units-rec (nth 2 expr) pow))
+	    ((eq (car-safe expr) '/)
+	     (calc-explain-units-rec (nth 1 expr) pow)
+	     (calc-explain-units-rec (nth 2 expr) (- pow)))
+	    ((memq (car-safe expr) '(neg + -))
+	     (calc-explain-units-rec (nth 1 expr) pow))
+	    ((and (eq (car-safe expr) '^)
+		  (math-realp (nth 2 expr)))
+	     (calc-explain-units-rec (nth 1 expr)
+				     (math-mul pow (nth 2 expr)))))))
+)
+
+(defun calc-simplify-units ()
+  (interactive)
+  (calc-slow-wrapper
+   (calc-with-default-simplification
+    (calc-enter-result 1 "smun" (math-simplify-units (calc-top-n 1)))))
+)
+
+(defun calc-view-units-table (n)
+  (interactive "P")
+  (and n (setq math-units-table-buffer-valid nil))
+  (let ((win (get-buffer-window "*Units Table*")))
+    (if (and win
+	     math-units-table
+	     math-units-table-buffer-valid)
+	(progn
+	  (bury-buffer (window-buffer win))
+	  (let ((curwin (selected-window)))
+	    (select-window win)
+	    (switch-to-buffer nil)
+	    (select-window curwin)))
+      (math-build-units-table-buffer nil)))
+)
+
+(defun calc-enter-units-table (n)
+  (interactive "P")
+  (and n (setq math-units-table-buffer-valid nil))
+  (math-build-units-table-buffer t)
+  (message (substitute-command-keys "Type \\[calc] to return to the Calculator."))
+)
+
+(defun calc-define-unit (uname desc)
+  (interactive "SDefine unit name: \nsDescription: ")
+  (calc-wrapper
+   (let ((form (calc-top-n 1))
+	 (unit (assq uname math-additional-units)))
+     (or unit
+	 (setq math-additional-units
+	       (cons (setq unit (list uname nil nil))
+		     math-additional-units)
+	       math-units-table nil))
+     (setcar (cdr unit) (and (not (and (eq (car-safe form) 'var)
+				       (eq (nth 1 form) uname)))
+			     (not (math-equal-int form 1))
+			     (math-format-flat-expr form 0)))
+     (setcar (cdr (cdr unit)) (and (not (equal desc ""))
+				   desc))))
+  (calc-invalidate-units-table)
+)
+
+(defun calc-undefine-unit (uname)
+  (interactive "SUndefine unit name: ")
+  (calc-wrapper
+   (let ((unit (assq uname math-additional-units)))
+     (or unit
+	 (if (assq uname math-standard-units)
+	     (error "\"%s\" is a predefined unit name" uname)
+	   (error "Unit name \"%s\" not found" uname)))
+     (setq math-additional-units (delq unit math-additional-units)
+	   math-units-table nil)))
+  (calc-invalidate-units-table)
+)
+
+(defun calc-invalidate-units-table ()
+  (setq math-units-table nil)
+  (let ((buf (get-buffer "*Units Table*")))
+    (and buf
+	 (save-excursion
+	   (set-buffer buf)
+	   (save-excursion
+	     (goto-char (point-min))
+	     (if (looking-at "Calculator Units Table")
+		 (let ((buffer-read-only nil))
+		   (insert "(Obsolete) ")))))))
+)
+
+(defun calc-get-unit-definition (uname)
+  (interactive "SGet definition for unit: ")
+  (calc-wrapper
+   (math-build-units-table)
+   (let ((unit (assq uname math-units-table)))
+     (or unit
+	 (error "Unit name \"%s\" not found" uname))
+     (let ((msg (nth 2 unit)))
+       (if (stringp msg)
+	   (if (string-match "^\\*" msg)
+	       (setq msg (substring msg 1)))
+	 (setq msg (symbol-name uname)))
+       (if (nth 1 unit)
+	   (progn
+	     (calc-enter-result 0 "ugdf" (nth 1 unit))
+	     (message "Derived unit: %s" msg))
+	 (calc-enter-result 0 "ugdf" (list 'var uname
+					   (intern
+					    (concat "var-"
+						    (symbol-name uname)))))
+	 (message "Base unit: %s" msg)))))
+)
+
+(defun calc-permanent-units ()
+  (interactive)
+  (calc-wrapper
+   (let (pos)
+     (set-buffer (find-file-noselect (substitute-in-file-name
+				      calc-settings-file)))
+     (goto-char (point-min))
+     (if (and (search-forward ";;; Custom units stored by Calc" nil t)
+	      (progn
+		(beginning-of-line)
+		(setq pos (point))
+		(search-forward "\n;;; End of custom units" nil t)))
+	 (progn
+	   (beginning-of-line)
+	   (forward-line 1)
+	   (delete-region pos (point)))
+       (goto-char (point-max))
+       (insert "\n\n")
+       (forward-char -1))
+     (insert ";;; Custom units stored by Calc on " (current-time-string) "\n")
+     (if math-additional-units
+	 (progn
+	   (insert "(setq math-additional-units '(\n")
+	   (let ((list math-additional-units))
+	     (while list
+	       (insert "  (" (symbol-name (car (car list))) " "
+		       (if (nth 1 (car list))
+			   (if (stringp (nth 1 (car list)))
+			       (prin1-to-string (nth 1 (car list)))
+			     (prin1-to-string (math-format-flat-expr
+					       (nth 1 (car list)) 0)))
+			 "nil")
+		       " "
+		       (prin1-to-string (nth 2 (car list)))
+		       ")\n")
+	       (setq list (cdr list))))
+	   (insert "))\n"))
+       (insert ";;; (no custom units defined)\n"))
+     (insert ";;; End of custom units\n")
+     (save-buffer)))
+)
+
+
+
+
+
+;;; Units operations.
+
+;;; Units table last updated 9-Jan-91 by Ulrich Mueller (ulm@vsnhd1.cern.ch)
+;;; with some additions by Przemek Klosowski (przemek@rrdstrad.nist.gov)
+
+(defvar math-standard-units
+  '( ;; Length
+     ( m       nil		     "*Meter" )
+     ( in      "2.54 cm"             "Inch" )
+     ( ft      "12 in"		     "Foot" )
+     ( yd      "3 ft"		     "Yard" )
+     ( mi      "5280 ft"	     "Mile" )
+     ( au      "1.495979e11 m"       "Astronomical Unit" )
+     ( lyr     "9460536207068016 m"  "Light Year" )
+     ( pc      "206264.80625 au"     "Parsec" )
+     ( nmi     "1852 m"		     "Nautical Mile" )
+     ( fath    "6 ft"		     "Fathom" )
+     ( u       "1 um"		     "Micron" )
+     ( mil     "in/1000"	     "Mil" )
+     ( point   "in/72"		     "Point (1/72 inch)" )
+     ( tpt     "in/72.27"	     "Point (TeX conventions)" )
+     ( Ang     "1e-10 m"	     "Angstrom" )
+     ( mfi     "mi+ft+in"	     "Miles + feet + inches" )
+     
+     ;; Area
+     ( hect    "10000 m^2"	     "*Hectare" )
+     ( acre    "mi^2 / 640"	     "Acre" )
+     ( b       "1e-28 m^2"	     "Barn" )
+     
+     ;; Volume
+     ( l       "1e-3 m^3"	     "*Liter" )
+     ( L       "1e-3 m^3"	     "Liter" )
+     ( gal     "4 qt"		     "US Gallon" )
+     ( qt      "2 pt"		     "Quart" )
+     ( pt      "2 cup"		     "Pint" )
+     ( cup     "8 ozfl"		     "Cup" )
+     ( ozfl    "2 tbsp"		     "Fluid Ounce" )
+     ( floz    "2 tbsp"		     "Fluid Ounce" )
+     ( tbsp    "3 tsp"		     "Tablespoon" )
+     ( tsp     "4.92892159375 ml"    "Teaspoon" )
+     ( vol     "tsp+tbsp+ozfl+cup+pt+qt+gal" "Gallons + ... + teaspoons" )
+     ( galC    "4.54609 l"	     "Canadian Gallon" )
+     ( galUK   "4.546092 l"	     "UK Gallon" )
+     
+     ;; Time
+     ( s       nil		     "*Second" )
+     ( sec     "s"		     "Second" )
+     ( min     "60 s"		     "Minute" )
+     ( hr      "60 min"		     "Hour" )
+     ( day     "24 hr"		     "Day" )
+     ( wk      "7 day"		     "Week" )
+     ( hms     "wk+day+hr+min+s"     "Hours, minutes, seconds" )
+     ( yr      "365.25 day"	     "Year" )
+     ( Hz      "1/s"		     "Hertz" )
+
+     ;; Speed
+     ( mph     "mi/hr"		     "*Miles per hour" )
+     ( kph     "km/hr"		     "Kilometers per hour" )
+     ( knot    "nmi/hr"		     "Knot" )
+     ( c       "2.99792458e8 m/s"    "Speed of light" )     
+     
+     ;; Acceleration
+     ( ga      "9.80665 m/s^2"	     "*\"g\" acceleration" )
+
+     ;; Mass
+     ( g       nil                   "*Gram" )
+     ( lb      "16 oz"		     "Pound (mass)" )
+     ( oz      "28.349523125 g"	     "Ounce (mass)" )
+     ( ton     "2000 lb"	     "Ton" )
+     ( tpo     "ton+lb+oz"	     "Tons + pounds + ounces (mass)" )
+     ( t       "1000 kg"	     "Metric ton" )
+     ( tonUK   "1016.0469088 kg"     "UK ton" )
+     ( lbt     "12 ozt"		     "Troy pound" )
+     ( ozt     "31.103475 g"	     "Troy ounce" )
+     ( ct      ".2 g"		     "Carat" )
+     ( amu     "1.6605402e-24 g"     "Unified atomic mass" )
+
+     ;; Force
+     ( N       "m kg/s^2"	     "*Newton" )
+     ( dyn     "1e-5 N"		     "Dyne" )
+     ( gf      "ga g"		     "Gram (force)" )
+     ( lbf     "4.44822161526 N"     "Pound (force)" )
+     ( kip     "1000 lbf"	     "Kilopound (force)" )
+     ( pdl     "0.138255 N"	     "Poundal" )
+
+     ;; Energy
+     ( J       "N m"		     "*Joule" )
+     ( erg     "1e-7 J"		     "Erg" )
+     ( cal     "4.1868 J"	     "International Table Calorie" )
+     ( Btu     "1055.05585262 J"     "International Table Btu" )
+     ( eV      "ech V"               "Electron volt" )
+     ( ev      "eV"                  "Electron volt" )
+     ( therm   "105506000 J"	     "EEC therm" )
+     ( invcm   "h c/cm"	  	     "Energy in inverse centimeters" )
+     ( Kayser  "invcm"		     "Kayser (inverse centimeter energy)" )
+     ( men     "100/invcm"	     "Inverse energy in meters" )
+     ( Hzen    "h Hz"		     "Energy in Hertz")
+     ( Ken     "k K"		     "Energy in Kelvins")
+     ;; ( invcm   "eV / 8065.47835185"    "Energy in inverse centimeters" )
+     ;; ( Hzen    "eV / 2.41796958004e14" "Energy in Hertz")
+     ;; ( Ken     "eV / 11604.7967327"    "Energy in Kelvins")
+
+     ;; Power
+     ( W       "J/s"		     "*Watt" )
+     ( hp      "745.7 W"	     "Horsepower" )
+
+     ;; Temperature
+     ( K       nil                   "*Degree Kelvin"     K )
+     ( dK      "K"		     "Degree Kelvin"	  K )
+     ( degK    "K"		     "Degree Kelvin"	  K )
+     ( dC      "K"		     "Degree Celsius"	  C )
+     ( degC    "K"      	     "Degree Celsius"	  C )
+     ( dF      "(5/9) K"	     "Degree Fahrenheit"  F )
+     ( degF    "(5/9) K"	     "Degree Fahrenheit"  F )
+
+     ;; Pressure
+     ( Pa      "N/m^2"		     "*Pascal" )
+     ( bar     "1e5 Pa"		     "Bar" )
+     ( atm     "101325 Pa"	     "Standard atmosphere" )
+     ( torr    "atm/760"	     "Torr" )
+     ( mHg     "1000 torr"	     "Meter of mercury" )
+     ( inHg    "25.4 mmHg"	     "Inch of mercury" )
+     ( inH2O   "248.84 Pa"	     "Inch of water" )
+     ( psi     "6894.75729317 Pa"    "Pound per square inch" )
+
+     ;; Viscosity
+     ( P       "0.1 Pa s"	     "*Poise" )
+     ( St      "1e-4 m^2/s"	     "Stokes" )
+
+     ;; Electromagnetism
+     ( A       nil                   "*Ampere" )
+     ( C       "A s"		     "Coulomb" )
+     ( Fdy     "ech Nav"  	     "Faraday" )
+     ( e       "1.60217733e-19 C"    "Elementary charge" )
+     ( ech     "1.60217733e-19 C"    "Elementary charge" )
+     ( V       "W/A"		     "Volt" )
+     ( ohm     "V/A"		     "Ohm" )
+     ( mho     "A/V"		     "Mho" )
+     ( S       "A/V"		     "Siemens" )
+     ( F       "C/V"		     "Farad" )
+     ( H       "Wb/A"		     "Henry" )
+     ( T       "Wb/m^2"		     "Tesla" )
+     ( G       "1e-4 T"		     "Gauss" )
+     ( Wb      "V s"		     "Weber" )
+
+     ;; Luminous intensity
+     ( cd      nil                   "*Candela" )
+     ( sb      "1e4 cd/m^2"	     "Stilb" )
+     ( lm      "cd sr"		     "Lumen" )
+     ( lx      "lm/m^2"		     "Lux" )
+     ( ph      "1e4 lx"		     "Phot" )
+     ( fc      "10.76 lx"	     "Footcandle" )
+     ( lam     "1e4 lm/m^2"	     "Lambert" )
+     ( flam    "1.07639104e-3 lam"   "Footlambert" )
+
+     ;; Radioactivity
+     ( Bq      "1/s"  		     "*Becquerel" )
+     ( Ci      "3.7e10 Bq"	     "Curie" )
+     ( Gy      "J/kg"		     "Gray" )
+     ( Sv      "Gy"		     "Sievert" )
+     ( R       "2.58e-4 C/kg"	     "Roentgen" )
+     ( rd      ".01 Gy"		     "Rad" )
+     ( rem     "rd"		     "Rem" )
+
+     ;; Amount of substance
+     ( mol     nil                   "*Mole" )
+
+     ;; Plane angle
+     ( rad     nil                   "*Radian" )
+     ( circ    "2 pi rad"	     "Full circle" )
+     ( rev     "circ"		     "Full revolution" )
+     ( deg     "circ/360"            "Degree" )
+     ( arcmin  "deg/60"		     "Arc minute" )
+     ( arcsec  "arcmin/60"	     "Arc second" )
+     ( grad    "circ/400"            "Grade" )
+     ( rpm     "rev/min"	     "Revolutions per minute" )
+
+     ;; Solid angle
+     ( sr      nil		     "*Steradian" )
+
+     ;; Other physical quantities (Physics Letters B239, 1 (1990))
+     ( h       "6.6260755e-34 J s"   "*Planck's constant" )
+     ( hbar    "h / 2 pi"	     "Planck's constant" )
+     ( mu0     "4 pi 1e-7 H/m"       "Permeability of vacuum" )
+     ( Grav    "6.67259e-11 N m^2/kg^2"  "Gravitational constant" )
+     ( Nav     "6.0221367e23 / mol"  "Avagadro's constant" )
+     ( me      "0.51099906 MeV/c^2"  "Electron rest mass" )
+     ( mp      "1.007276470 amu"     "Proton rest mass" )
+     ( mn      "1.008664904 amu"     "Neutron rest mass" )
+     ( mu      "0.113428913 amu"     "Muon rest mass" )
+     ( Ryd     "1.0973731571e5 invcm" "Rydberg's constant" )
+     ( k       "1.3806513e-23 J/K"   "Boltzmann's constant" )
+     ( fsc     "1 / 137.0359895"     "Fine structure constant" )
+     ( muB     "5.78838263e-11 MeV/T"  "Bohr magneton" )
+     ( muN     "3.15245166e-14 MeV/T"  "Nuclear magneton" )
+     ( mue     "1.001159652193 muB"  "Electron magnetic moment" )
+     ( mup     "2.792847386 muN"     "Proton magnetic moment" )
+     ( R0      "Nav k"               "Molar gas constant" )
+     ( V0      "22.413992 L/mol"     "Standard volume of ideal gas" )
+))
+
+
+(defvar math-additional-units nil
+  "*Additional units table for user-defined units.
+Must be formatted like math-standard-units.
+If this is changed, be sure to set math-units-table to nil to ensure
+that the combined units table will be rebuilt.")
+
+(defvar math-unit-prefixes
+  '( ( ?E  (float 1 18)  "Exa"    )
+     ( ?P  (float 1 15)  "Peta"   )
+     ( ?T  (float 1 12)  "Tera"	  )
+     ( ?G  (float 1 9)   "Giga"	  )
+     ( ?M  (float 1 6)   "Mega"	  )
+     ( ?k  (float 1 3)   "Kilo"	  )
+     ( ?K  (float 1 3)   "Kilo"	  )
+     ( ?h  (float 1 2)   "Hecto"  )
+     ( ?H  (float 1 2)   "Hecto"  )
+     ( ?D  (float 1 1)   "Deka"	  )
+     ( 0   (float 1 0)   nil      )
+     ( ?d  (float 1 -1)  "Deci"	  )
+     ( ?c  (float 1 -2)  "Centi"  )
+     ( ?m  (float 1 -3)  "Milli"  )
+     ( ?u  (float 1 -6)  "Micro"  )
+     ( ?n  (float 1 -9)  "Nano"	  )
+     ( ?p  (float 1 -12) "Pico"	  )
+     ( ?f  (float 1 -15) "Femto"  )
+     ( ?a  (float 1 -18) "Atto"   )
+))
+
+(defvar math-standard-units-systems
+  '( ( base  nil )
+     ( si    ( ( g   '(* (var kg var-kg) (float 1 -3)) ) ) )
+     ( mks   ( ( g   '(* (var kg var-kg) (float 1 -3)) ) ) )
+     ( cgs   ( ( m   '(* (var cm var-cm) 100         ) ) ) )
+))
+
+(defvar math-units-table nil
+  "Internal units table derived from math-defined-units.
+Entries are (SYMBOL EXPR DOC-STRING TEMP-TYPE BASE-UNITS).")
+
+(defvar math-units-table-buffer-valid nil)
+
+
+(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)
+	(setq tab (mapcar (function
+			   (lambda (x)
+			     (list (car x)
+				   (and (nth 1 x)
+					(if (stringp (nth 1 x))
+					    (let ((exp (math-read-plain-expr
+							(nth 1 x))))
+					      (if (eq (car-safe exp) 'error)
+						  (error "Format error in definition of %s in units table: %s"
+							 (car x) (nth 2 exp))
+						exp))
+					  (nth 1 x)))
+				   (nth 2 x)
+				   (nth 3 x)
+				   (and (not (nth 1 x))
+					(list (cons (car x) 1))))))
+			  combined-units))
+	(let ((math-units-table tab))
+	  (mapcar 'math-find-base-units tab))
+	(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)))
+    (cond (u
+	   (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) '^)
+		(integerp (nth 2 expr)))
+	   (math-find-base-units-rec (nth 1 expr) (* pow (nth 2 expr))))
+	  ((eq (car expr) '*)
+	   (math-find-base-units-rec (nth 1 expr) pow)
+	   (math-find-base-units-rec (nth 2 expr) pow))
+	  ((eq (car expr) '/)
+	   (math-find-base-units-rec (nth 1 expr) pow)
+	   (math-find-base-units-rec (nth 2 expr) (- pow)))
+	  ((eq (car expr) 'neg)
+	   (math-find-base-units-rec (nth 1 expr) pow))
+	  ((eq (car expr) '+)
+	   (math-find-base-units-rec (nth 1 expr) pow))
+	  ((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)
+  (and (consp expr)
+       (if (eq (car expr) 'var)
+	   (math-check-unit-name expr)
+	 (and (or sub-exprs
+		  (memq (car expr) '(* / ^)))
+	      (or (math-units-in-expr-p (nth 1 expr) sub-exprs)
+		  (math-units-in-expr-p (nth 2 expr) sub-exprs)))))
+)
+
+(defun math-only-units-in-expr-p (expr)
+  (and (consp expr)
+       (if (eq (car expr) 'var)
+	   (math-check-unit-name expr)
+	 (if (memq (car expr) '(* /))
+	     (and (math-only-units-in-expr-p (nth 1 expr))
+		  (math-only-units-in-expr-p (nth 2 expr)))
+	   (and (eq (car expr) '^)
+		(and (math-only-units-in-expr-p (nth 1 expr))
+		     (math-realp (nth 2 expr)))))))
+)
+
+(defun math-single-units-in-expr-p (expr)
+  (cond ((math-scalarp expr) nil)
+	((eq (car expr) 'var)
+	 (math-check-unit-name expr))
+	((eq (car expr) '*)
+	 (let ((u1 (math-single-units-in-expr-p (nth 1 expr)))
+	       (u2 (math-single-units-in-expr-p (nth 2 expr))))
+	   (or (and u1 u2 'wrong)
+	       u1
+	       u2)))
+	((eq (car expr) '/)
+	 (if (math-units-in-expr-p (nth 2 expr) nil)
+	     'wrong
+	   (math-single-units-in-expr-p (nth 1 expr))))
+	(t 'wrong))
+)
+
+(defun math-check-unit-name (v)
+  (and (eq (car-safe v) 'var)
+       (or (assq (nth 1 v) (or math-units-table (math-build-units-table)))
+	   (let ((name (symbol-name (nth 1 v))))
+	     (and (> (length name) 1)
+		  (assq (aref name 0) math-unit-prefixes)
+		  (or (assq (intern (substring name 1)) math-units-table)
+		      (and (eq (aref name 0) ?M)
+			   (> (length name) 3)
+			   (eq (aref name 1) ?e)
+			   (eq (aref name 2) ?g)
+			   (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)
+  (if (eq (car-safe expr) 'var)
+      (let ((u (math-check-unit-name expr))
+	    (base (nth 1 expr)))
+	(if u
+	    (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)
+				     (intern (concat "var-"
+						     (symbol-name
+						      (car u)))))))))
+	      (or (null u)
+		  (eq base (car u))
+		  (setq expr (list '*
+				   (nth 1 (assq (aref (symbol-name base) 0)
+						math-unit-prefixes))
+				   expr)))
+	      expr)
+	  (if (eq base 'pi)
+	      (math-pi)
+	    expr)))
+    (if (Math-primp expr)
+	expr
+      (cons (car expr)
+	    (mapcar 'math-to-standard-rec (cdr expr)))))
+)
+
+(defun math-apply-units (expr units ulist &optional pure)
+  (if ulist
+      (let ((new 0)
+	    value)
+	(setq expr (math-simplify-units expr))
+	(or (math-numberp expr)
+	    (error "Incompatible units"))
+	(while (cdr ulist)
+	  (setq value (math-div expr (nth 1 (car ulist)))
+		value (math-floor (let ((calc-internal-prec
+					 (1- calc-internal-prec)))
+				    (math-normalize value)))
+		new (math-add new (math-mul value (car (car ulist))))
+		expr (math-sub expr (math-mul value (nth 1 (car ulist))))
+		ulist (cdr ulist)))
+	(math-add new (math-mul (math-div expr (nth 1 (car ulist)))
+				(car (car ulist)))))
+    (math-simplify-units (if pure
+			     expr
+			   (list '* expr units))))
+)
+
+(defun math-decompose-units (units)
+  (let ((u (math-check-unit-name units)))
+    (and u (eq (car-safe (nth 1 u)) '+)
+	 (setq units (nth 1 u))))
+  (setq units (calcFunc-expand units))
+  (and (eq (car-safe units) '+)
+       (let ((entry (list units calc-internal-prec calc-prefer-frac)))
+	 (or (equal entry (car math-decompose-units-cache))
+	     (let ((ulist nil)
+		   (utemp units)
+		   qty unit)
+	       (while (eq (car-safe utemp) '+)
+		 (setq ulist (cons (math-decompose-unit-part (nth 2 utemp))
+				   ulist)
+		       utemp (nth 1 utemp)))
+	       (setq ulist (cons (math-decompose-unit-part utemp) ulist)
+		     utemp ulist)
+	       (while (setq utemp (cdr utemp))
+		 (or (equal (nth 2 (car utemp)) (nth 2 (car ulist)))
+		     (error "Inconsistent units in sum")))
+	       (setq math-decompose-units-cache
+		     (cons entry
+			   (sort ulist
+				 (function
+				  (lambda (x y)
+				    (not (Math-lessp (nth 1 x)
+						     (nth 1 y))))))))))
+	 (cdr math-decompose-units-cache)))
+)
+(setq math-decompose-units-cache nil)
+
+(defun math-decompose-unit-part (unit)
+  (cons unit
+	(math-is-multiple (math-simplify-units (math-to-standard-units
+						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)
+  (cond ((eq (car-safe expr) '*)
+	 (or (math-find-compatible-unit-rec (nth 1 expr) pow)
+	     (math-find-compatible-unit-rec (nth 2 expr) pow)))
+	((eq (car-safe expr) '/)
+	 (or (math-find-compatible-unit-rec (nth 1 expr) pow)
+	     (math-find-compatible-unit-rec (nth 2 expr) (- pow))))
+	((and (eq (car-safe expr) '^)
+	      (integerp (nth 2 expr)))
+	 (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))))
+	(if (setq unit-list (math-decompose-units new-units))
+	    (setq new-units (nth 2 (car unit-list))))
+	(if (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)
+	    (mapcar 'math-convert-units-rec (cdr expr)))))
+)
+
+(defun math-convert-temperature (expr old new &optional pure)
+  (let* ((units (math-single-units-in-expr-p expr))
+	 (uold (if old
+		   (if (or (null units)
+			   (equal (nth 1 old) (car units)))
+		       (math-check-unit-name old)
+		     (error "Inconsistent temperature units"))
+		 units))
+	 (unew (math-check-unit-name new)))
+    (or (and (consp unew) (nth 3 unew))
+	(error "Not a valid temperature unit"))
+    (or (and (consp uold) (nth 3 uold))
+	(error "Not a pure temperature expression"))
+    (let ((v (car uold)))
+      (setq expr (list '/ expr (list 'var v
+				     (intern (concat "var-"
+						     (symbol-name v)))))))
+    (or (eq (nth 3 uold) (nth 3 unew))
+	(cond ((eq (nth 3 uold) 'K)
+	       (setq expr (list '- expr '(float 27315 -2)))
+	       (if (eq (nth 3 unew) 'F)
+		   (setq expr (list '+ (list '* expr '(frac 9 5)) 32))))
+	      ((eq (nth 3 uold) 'C)
+	       (if (eq (nth 3 unew) 'F)
+		   (setq expr (list '+ (list '* expr '(frac 9 5)) 32))
+		 (setq expr (list '+ expr '(float 27315 -2)))))
+	      (t
+	       (setq expr (list '* (list '- expr 32) '(frac 5 9)))
+	       (if (eq (nth 3 unew) 'K)
+		   (setq expr (list '+ expr '(float 27315 -2)))))))
+    (if pure
+	expr
+      (list '* expr new)))
+)
+
+
+
+(defun math-simplify-units (a)
+  (let ((math-simplifying-units t)
+	(calc-matrix-mode 'scalar))
+    (math-simplify a))
+)
+(fset 'calcFunc-usimplify (symbol-function 'math-simplify-units))
+
+(math-defsimplify (+ -)
+  (and math-simplifying-units
+       (math-units-in-expr-p (nth 1 expr) nil)
+       (let* ((units (math-extract-units (nth 1 expr)))
+	      (ratio (math-simplify (math-to-standard-units
+				     (list '/ (nth 2 expr) units) nil))))
+	 (if (math-units-in-expr-p ratio nil)
+	     (progn
+	       (calc-record-why "*Inconsistent units" expr)
+	       expr)
+	   (list '* (math-add (math-remove-units (nth 1 expr))
+			      (if (eq (car expr) '-) (math-neg ratio) ratio))
+		 units))))
+)
+
+(math-defsimplify *
+  (math-simplify-units-prod)
+)
+
+(defun math-simplify-units-prod ()
+  (and math-simplifying-units
+       calc-autorange-units
+       (Math-realp (nth 1 expr))
+       (let* ((num (math-float (nth 1 expr)))
+	      (xpon (calcFunc-xpon num))
+	      (unitp (cdr (cdr expr)))
+	      (unit (car unitp))
+	      (pow (if (eq (car expr) '*) 1 -1))
+	      u)
+	 (and (eq (car-safe unit) '*)
+	      (setq unitp (cdr unit)
+		    unit (car unitp)))
+	 (and (eq (car-safe unit) '^)
+	      (integerp (nth 2 unit))
+	      (setq pow (* pow (nth 2 unit))
+		    unitp (cdr unit)
+		    unit (car unitp)))
+	 (and (setq u (math-check-unit-name unit))
+	      (integerp xpon)
+	      (or (< xpon 0)
+		  (>= xpon (if (eq (car u) 'm) 1 3)))
+	      (let* ((uxpon 0)
+		     (pref (if (< pow 0)
+			       (reverse math-unit-prefixes)
+			     math-unit-prefixes))
+		     (p pref)
+		     pxpon pname)
+		(or (eq (car u) (nth 1 unit))
+		    (setq uxpon (* pow
+				   (nth 2 (nth 1 (assq
+						  (aref (symbol-name
+							 (nth 1 unit)) 0)
+						  math-unit-prefixes))))))
+		(setq xpon (+ xpon uxpon))
+		(while (and p
+			    (or (memq (car (car p)) '(?d ?D ?h ?H))
+				(and (eq (car (car p)) ?c)
+				     (not (eq (car u) 'm)))
+				(< xpon (setq pxpon (* (nth 2 (nth 1 (car p)))
+						       pow)))
+				(progn
+				  (setq pname (math-build-var-name
+					       (if (eq (car (car p)) 0)
+						   (car u)
+						 (concat (char-to-string
+							  (car (car p)))
+							 (symbol-name
+							  (car u))))))
+				  (and (/= (car (car p)) 0)
+				       (assq (nth 1 pname)
+					     math-units-table)))))
+		  (setq p (cdr p)))
+		(and p
+		     (/= pxpon uxpon)
+		     (or (not (eq p pref))
+			 (< xpon (+ pxpon (* (math-abs pow) 3))))
+		     (progn
+		       (setcar (cdr expr)
+			       (let ((calc-prefer-frac nil))
+				 (calcFunc-scf (nth 1 expr)
+					       (- uxpon pxpon))))
+		       (setcar unitp pname)
+		       expr))))))
+)
+
+(math-defsimplify /
+  (and math-simplifying-units
+       (let ((np (cdr expr))
+	     (try-cancel-units 0)
+	     n nn)
+	 (setq n (if (eq (car-safe (nth 2 expr)) '*)
+		     (cdr (nth 2 expr))
+		   (nthcdr 2 expr)))
+	 (if (math-realp (car n))
+	     (progn
+	       (setcar (cdr expr) (math-mul (nth 1 expr)
+					    (let ((calc-prefer-frac nil))
+					      (math-div 1 (car n)))))
+	       (setcar n 1)))
+	 (while (eq (car-safe (setq n (car np))) '*)
+	   (math-simplify-units-divisor (cdr n) (cdr (cdr expr)))
+	   (setq np (cdr (cdr n))))
+	 (math-simplify-units-divisor np (cdr (cdr expr)))
+	 (if (eq try-cancel-units 0)
+	     (let* ((math-simplifying-units nil)
+		    (base (math-simplify (math-to-standard-units expr nil))))
+	       (if (Math-numberp base)
+		   (setq expr base))))
+	 (if (eq (car-safe expr) '/)
+	     (math-simplify-units-prod))
+	 expr))
+)
+
+(defun math-simplify-units-divisor (np dp)
+  (let ((n (car np))
+	d dd temp)
+    (while (eq (car-safe (setq d (car dp))) '*)
+      (if (setq temp (math-simplify-units-quotient n (nth 1 d)))
+	  (progn
+	    (setcar np (setq n temp))
+	    (setcar (cdr d) 1)))
+      (setq dp (cdr (cdr d))))
+    (if (setq temp (math-simplify-units-quotient n d))
+	(progn
+	  (setcar np (setq n temp))
+	  (setcar dp 1))))
+)
+
+;; Simplify, e.g., "in / cm" to "2.54" in a units expression.
+(defun math-simplify-units-quotient (n d)
+  (let ((pow1 1)
+	(pow2 1))
+    (and (eq (car-safe n) '^)
+	 (integerp (nth 2 n))
+	 (setq pow1 (nth 2 n) n (nth 1 n)))
+    (and (eq (car-safe d) '^)
+	 (integerp (nth 2 d))
+	 (setq pow2 (nth 2 d) d (nth 1 d)))
+    (let ((un (math-check-unit-name n))
+	  (ud (math-check-unit-name d)))
+      (and un ud
+	   (if (and (equal (nth 4 un) (nth 4 ud))
+		    (eq pow1 pow2))
+	       (math-to-standard-units (list '/ n d) nil)
+	     (let (ud1)
+	       (setq un (nth 4 un)
+		     ud (nth 4 ud))
+	       (while un
+		 (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)))
+		 (setq un (cdr un)))
+	       nil)))))
+)
+
+(math-defsimplify ^
+  (and math-simplifying-units
+       (math-realp (nth 2 expr))
+       (if (memq (car-safe (nth 1 expr)) '(* /))
+	   (list (car (nth 1 expr))
+		 (list '^ (nth 1 (nth 1 expr)) (nth 2 expr))
+		 (list '^ (nth 2 (nth 1 expr)) (nth 2 expr)))
+	 (math-simplify-units-pow (nth 1 expr) (nth 2 expr))))
+)
+
+(math-defsimplify calcFunc-sqrt
+  (and math-simplifying-units
+       (if (memq (car-safe (nth 1 expr)) '(* /))
+	   (list (car (nth 1 expr))
+		 (list 'calcFunc-sqrt (nth 1 (nth 1 expr)))
+		 (list 'calcFunc-sqrt (nth 2 (nth 1 expr))))
+	 (math-simplify-units-pow (nth 1 expr) '(frac 1 2))))
+)
+
+(math-defsimplify (calcFunc-floor
+		   calcFunc-ceil
+		   calcFunc-round
+		   calcFunc-rounde
+		   calcFunc-roundu
+		   calcFunc-trunc
+		   calcFunc-float
+		   calcFunc-frac
+		   calcFunc-abs
+		   calcFunc-clean)
+  (and math-simplifying-units
+       (= (length expr) 2)
+       (if (math-only-units-in-expr-p (nth 1 expr))
+	   (nth 1 expr)
+	 (if (and (memq (car-safe (nth 1 expr)) '(* /))
+		  (or (math-only-units-in-expr-p
+		       (nth 1 (nth 1 expr)))
+		      (math-only-units-in-expr-p
+		       (nth 2 (nth 1 expr)))))
+	     (list (car (nth 1 expr))
+		   (cons (car expr)
+			 (cons (nth 1 (nth 1 expr))
+			       (cdr (cdr expr))))
+		   (cons (car expr)
+			 (cons (nth 2 (nth 1 expr))
+			       (cdr (cdr expr)))))))))
+
+(defun math-simplify-units-pow (a pow)
+  (if (and (eq (car-safe a) '^)
+	   (math-check-unit-name (nth 1 a))
+	   (math-realp (nth 2 a)))
+      (list '^ (nth 1 a) (math-mul pow (nth 2 a)))
+    (let* ((u (math-check-unit-name a))
+	   (pf (math-to-simple-fraction pow))
+	   (d (and (eq (car-safe pf) 'frac) (nth 2 pf))))
+      (and u d
+	   (math-units-are-multiple u d)
+	   (list '^ (math-to-standard-units a nil) pow))))
+)
+
+
+(defun math-units-are-multiple (u n)
+  (setq u (nth 4 u))
+  (while (and u (= (% (cdr (car u)) n) 0))
+    (setq u (cdr u)))
+  (null u)
+)
+
+(math-defsimplify calcFunc-sin
+  (and math-simplifying-units
+       (math-units-in-expr-p (nth 1 expr) nil)
+       (let ((rad (math-simplify-units
+		   (math-evaluate-expr
+		    (math-to-standard-units (nth 1 expr) nil))))
+	     (calc-angle-mode 'rad))
+	 (and (eq (car-safe rad) '*)
+	      (math-realp (nth 1 rad))
+	      (eq (car-safe (nth 2 rad)) 'var)
+	      (eq (nth 1 (nth 2 rad)) 'rad)
+	      (list 'calcFunc-sin (nth 1 rad)))))
+)
+
+(math-defsimplify calcFunc-cos
+  (and math-simplifying-units
+       (math-units-in-expr-p (nth 1 expr) nil)
+       (let ((rad (math-simplify-units
+		   (math-evaluate-expr
+		    (math-to-standard-units (nth 1 expr) nil))))
+	     (calc-angle-mode 'rad))
+	 (and (eq (car-safe rad) '*)
+	      (math-realp (nth 1 rad))
+	      (eq (car-safe (nth 2 rad)) 'var)
+	      (eq (nth 1 (nth 2 rad)) 'rad)
+	      (list 'calcFunc-cos (nth 1 rad)))))
+)
+
+(math-defsimplify calcFunc-tan
+  (and math-simplifying-units
+       (math-units-in-expr-p (nth 1 expr) nil)
+       (let ((rad (math-simplify-units
+		   (math-evaluate-expr
+		    (math-to-standard-units (nth 1 expr) nil))))
+	     (calc-angle-mode 'rad))
+	 (and (eq (car-safe rad) '*)
+	      (math-realp (nth 1 rad))
+	      (eq (car-safe (nth 2 rad)) 'var)
+	      (eq (nth 1 (nth 2 rad)) 'rad)
+	      (list 'calcFunc-tan (nth 1 rad)))))
+)
+
+
+(defun math-remove-units (expr)
+  (if (math-check-unit-name expr)
+      1
+    (if (Math-primp expr)
+	expr
+      (cons (car expr)
+	    (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))
+)
+
+(defun math-build-units-table-buffer (enter-buffer)
+  (if (not (and math-units-table math-units-table-buffer-valid
+		(get-buffer "*Units Table*")))
+      (let ((buf (get-buffer-create "*Units Table*"))
+	    (uptr (math-build-units-table))
+	    (calc-language (if (eq calc-language 'big) nil calc-language))
+	    (calc-float-format '(float 0))
+	    (calc-group-digits nil)
+	    (calc-number-radix 10)
+	    (calc-point-char ".")
+	    (std nil)
+	    u name shadowed)
+	(save-excursion
+	  (message "Formatting units table...")
+	  (set-buffer buf)
+	  (setq buffer-read-only nil)
+	  (erase-buffer)
+	  (insert "Calculator Units Table:\n\n")
+	  (insert "Unit    Type  Definition                  Description\n\n")
+	  (while uptr
+	    (setq u (car uptr)
+		  name (nth 2 u))
+	    (if (eq (car u) 'm)
+		(setq std t))
+	    (setq shadowed (and std (assq (car u) math-additional-units)))
+	    (if (and name
+		     (> (length name) 1)
+		     (eq (aref name 0) ?\*))
+		(progn
+		  (or (eq uptr math-units-table)
+		      (insert "\n"))
+		  (setq name (substring name 1))))
+	    (insert " ")
+	    (and shadowed (insert "("))
+	    (insert (symbol-name (car u)))
+	    (and shadowed (insert ")"))
+	    (if (nth 3 u)
+		(progn
+		  (indent-to 10)
+		  (insert (symbol-name (nth 3 u))))
+	      (or std
+		  (progn
+		    (indent-to 10)
+		    (insert "U"))))
+	    (indent-to 14)
+	    (and shadowed (insert "("))
+	    (if (nth 1 u)
+		(insert (math-format-value (nth 1 u) 80))
+	      (insert (symbol-name (car u))))
+	    (and shadowed (insert ")"))
+	    (indent-to 41)
+	    (insert " ")
+	    (if name
+		(insert name))
+	    (if shadowed
+		(insert " (redefined above)")
+	      (or (nth 1 u)
+		  (insert " (base unit)")))
+	    (insert "\n")
+	    (setq uptr (cdr uptr)))
+	  (insert "\n\nUnit Prefix Table:\n\n")
+	  (setq uptr math-unit-prefixes)
+	  (while uptr
+	    (setq u (car uptr))
+	    (insert " " (char-to-string (car u)))
+	    (if (equal (nth 1 u) (nth 1 (nth 1 uptr)))
+		(insert " " (char-to-string (car (car (setq uptr (cdr uptr)))))
+			"   ")
+	      (insert "     "))
+	    (insert "10^" (int-to-string (nth 2 (nth 1 u))))
+	    (indent-to 15)
+	    (insert "   " (nth 2 u) "\n")
+	    (while (eq (car (car (setq uptr (cdr uptr)))) 0)))
+	  (insert "\n")
+	  (setq buffer-read-only t)
+	  (message "Formatting units table...done"))
+	(setq math-units-table-buffer-valid t)
+	(let ((oldbuf (current-buffer)))
+	  (set-buffer buf)
+	  (goto-char (point-min))
+	  (set-buffer oldbuf))
+	(if enter-buffer
+	    (pop-to-buffer buf)
+	  (display-buffer buf)))
+    (if enter-buffer
+	(pop-to-buffer (get-buffer "*Units Table*"))
+      (display-buffer (get-buffer "*Units Table*"))))
+)
+
+
+
+