;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
-;; Maintainer: Colin Walters <walters@debian.org>
+;; Maintainer: Jay Belanger <belanger@truman.edu>
;; This file is part of GNU Emacs.
;;; Units table last updated 9-Jan-91 by Ulrich Mueller (ulm@vsnhd1.cern.ch)
;;; with some additions by Przemek Klosowski (przemek@rrdstrad.nist.gov)
+;;; Updated April 2002 by Jochen Küpper
+
+;;; for CODATA 1998 see one of
+;;; - Journal of Physical and Chemical Reference Data, 28(6), 1713-1852, 1999.
+;;; - Reviews of Modern Physics, 72(2), 351-495, 2000.
+;;; - http://physics.nist.gov/cuu/Constants/index.html
(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" )))
+ ( m nil "*Meter" )
+ ( in "2.54 cm" "Inch" )
+ ( ft "12 in" "Foot" )
+ ( yd "3 ft" "Yard" )
+ ( mi "5280 ft" "Mile" )
+ ( au "149597870691 m" "Astronomical Unit" ) ;; NASA JPL (http://neo.jpl.nasa.gov/glossary/au.html)
+ ( 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.66053873e-27 kg" "Unified atomic mass" ) ;; CODATA 1998
+
+ ;; 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")
+ ( Wh "W h" "Watt hour")
+ ( Ws "W s" "Watt second")
+
+ ;; 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 " 1.333224e2 Pa" "Torr" ) ;; NIST (http://physics.nist.gov/Pubs/SP811/appenB9.html)
+ ( mHg "1000 torr" "Meter of mercury" )
+ ( inHg "25.4 mmHg" "Inch of mercury" )
+ ( inH2O "2.490889e2 Pa" "Inch of water" ) ;; NIST (http://physics.nist.gov/Pubs/SP811/appenB9.html)
+ ( 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.602176462e-19 C" "Elementary charge" ) ;; CODATA 1998
+ ( ech "1.602176462e-19 C" "Elementary charge" ) ;; CODATA 1998
+ ( 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.76391 lx" "Footcandle" ) ;; NIST (http://physics.nist.gov/Pubs/SP811/appenB9.html)
+ ( lam "1e4 lm/m^2" "Lambert" )
+ ( flam "3.426259 cd/m^2" "Footlambert" ) ;; NIST (http://physics.nist.gov/Pubs/SP811/appenB9.html)
+
+ ;; 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 (CODATA 1998)
+ ( h "6.62606876e-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.673e-11 m^3/kg^1/s^2" "Gravitational constant" )
+ ( Nav "6.02214199e23 / mol" "Avagadro's constant" )
+ ( me "9.10938188e-31 kg" "Electron rest mass" )
+ ( mp "1.67262158e-27 kg" "Proton rest mass" )
+ ( mn "1.67492716e-27 kg" "Neutron rest mass" )
+ ( mu "1.88353109e-28 kg" "Muon rest mass" )
+ ( Ryd "10973731.568549 /m" "Rydberg's constant" )
+ ( k "1.3806503e-23 J/K" "Boltzmann's constant" )
+ ( fsc "7.297352533e-3" "Fine structure constant" )
+ ( muB "927.400899e-26 J/T" "Bohr magneton" )
+ ( muN "5.05078317e-27 J/T" "Nuclear magneton" )
+ ( mue "-928.476362e-26 J/T" "Electron magnetic moment" )
+ ( mup "1.410606633e-26 J/T" "Proton magnetic moment" )
+ ( R0 "8.314472 J/mol/K" "Molar gas constant" )
+ ( V0 "22.710981e-3 m^3/mol" "Standard volume of ideal gas" )))
(defvar math-additional-units nil
(units (calc-var-value 'var-Units))
(expr (calc-top-n 1)))
(unless (and (>= num 0) (<= num 9))
- (errunless "Bad unit number"))
+ (error "Bad unit number"))
(unless (math-vectorp units)
- (errunless "No \"quick units\" are defined"))
+ (error "No \"quick units\" are defined"))
(unless (< pos (length units))
- (errunless "Unit number %d not defined" pos))
+ (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-slow-wrapper
(let ((expr (calc-top-n 1))
(uoldname nil)
- unew)
+ unew
+ units)
(unless (math-units-in-expr-p expr t)
(let ((uold (or old-units
(progn
(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 ((num-units nil)
- (den-units nil))
+ (let ((calc-num-units nil)
+ (calc-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)
+ (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)
(setq name (concat name "^"
(math-format-number (math-abs pow))))))
(if (math-posp pow)
- (setq num-units (if num-units
- (concat num-units " " name)
+ (setq calc-num-units (if calc-num-units
+ (concat calc-num-units " " name)
name))
- (setq den-units (if den-units
- (concat den-units " " 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)
(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))
- (unit-list (mapcar 'car combined-units))
+ (math-cu-unit-list (mapcar 'car combined-units))
tab)
(message "Building units table...")
(setq math-units-table-buffer-valid nil)
(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))
+;; 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 base (sort base 'math-compare-unit-names))
- (setcar (nthcdr 4 entry) base)
- base)))
+ (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) unit-list))))
+ (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)))
(let ((ulist (math-find-base-units u)))
(while ulist
(let ((p (* (cdr (car ulist)) pow))
- (old (assq (car (car ulist)) base)))
+ (old (assq (car (car ulist)) math-fbu-base)))
(if old
(setcdr old (+ (cdr old) p))
- (setq base (cons (cons (car (car ulist)) p) base))))
+ (setq math-fbu-base
+ (cons (cons (car (car ulist)) p) math-fbu-base))))
(setq ulist (cdr ulist)))))
((math-scalarp expr))
((and (eq (car expr) '^)
((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))))))
+ (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)
(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 which-standard)
+(defun math-to-standard-units (expr math-which-standard)
(math-to-standard-rec expr))
(defun math-to-standard-rec (expr)
(progn
(if (nth 1 u)
(setq expr (math-to-standard-rec (nth 1 u)))
- (let ((st (assq (car u) which-standard)))
+ (let ((st (assq (car u) math-which-standard)))
(if st
(setq expr (nth 1 st))
(setq expr (list 'var (car u)
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 ((u (math-check-unit-name unit)))
- (if u
+ (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)
(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))
+ (if (equal (nth 4 math-fcu-u) (nth 4 u2))
(cons expr pow))))))
-(defun math-convert-units (expr new-units &optional pure)
+;; 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 pure) (math-find-compatible-unit expr new-units)))
- (unit-list nil)
+ (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 new-units (cdr compat)))
+ (math-pow math-cu-new-units (cdr compat)))
(math-simplify-units
(math-to-standard-units
- (math-pow (math-div (car compat) new-units)
+ (math-pow (math-div (car compat) math-cu-new-units)
(cdr compat))
nil))))
- (when (setq unit-list (math-decompose-units new-units))
- (setq new-units (nth 2 (car unit-list))))
+ (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 new-units) nil)
- new-units unit-list pure))))))
+ (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 new-units) nil)
- new-units unit-list pure)
+ (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)
(math-simplify a)))
(defalias 'calcFunc-usimplify 'math-simplify-units)
+;; The function created by math-defsimplify uses the variable
+;; math-simplify-expr, and so is used by functions in math-defsimplify
+(defvar math-simplify-expr)
+
(math-defsimplify (+ -)
(and math-simplifying-units
- (math-units-in-expr-p (nth 1 expr) nil)
- (let* ((units (math-extract-units (nth 1 expr)))
+ (math-units-in-expr-p (nth 1 math-simplify-expr) nil)
+ (let* ((units (math-extract-units (nth 1 math-simplify-expr)))
(ratio (math-simplify (math-to-standard-units
- (list '/ (nth 2 expr) units) nil))))
+ (list '/ (nth 2 math-simplify-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))
+ (calc-record-why "*Inconsistent units" math-simplify-expr)
+ math-simplify-expr)
+ (list '* (math-add (math-remove-units (nth 1 math-simplify-expr))
+ (if (eq (car math-simplify-expr) '-)
+ (math-neg ratio) ratio))
units)))))
(math-defsimplify *
(defun math-simplify-units-prod ()
(and math-simplifying-units
calc-autorange-units
- (Math-realp (nth 1 expr))
- (let* ((num (math-float (nth 1 expr)))
+ (Math-realp (nth 1 math-simplify-expr))
+ (let* ((num (math-float (nth 1 math-simplify-expr)))
(xpon (calcFunc-xpon num))
- (unitp (cdr (cdr expr)))
+ (unitp (cdr (cdr math-simplify-expr)))
(unit (car unitp))
- (pow (if (eq (car expr) '*) 1 -1))
+ (pow (if (eq (car math-simplify-expr) '*) 1 -1))
u)
(and (eq (car-safe unit) '*)
(setq unitp (cdr unit)
(or (not (eq p pref))
(< xpon (+ pxpon (* (math-abs pow) 3))))
(progn
- (setcar (cdr expr)
+ (setcar (cdr math-simplify-expr)
(let ((calc-prefer-frac nil))
- (calcFunc-scf (nth 1 expr)
+ (calcFunc-scf (nth 1 math-simplify-expr)
(- uxpon pxpon))))
(setcar unitp pname)
- expr)))))))
+ math-simplify-expr)))))))
+
+(defvar math-try-cancel-units)
(math-defsimplify /
(and math-simplifying-units
- (let ((np (cdr expr))
- (try-cancel-units 0)
+ (let ((np (cdr math-simplify-expr))
+ (math-try-cancel-units 0)
n nn)
- (setq n (if (eq (car-safe (nth 2 expr)) '*)
- (cdr (nth 2 expr))
- (nthcdr 2 expr)))
+ (setq n (if (eq (car-safe (nth 2 math-simplify-expr)) '*)
+ (cdr (nth 2 math-simplify-expr))
+ (nthcdr 2 math-simplify-expr)))
(if (math-realp (car n))
(progn
- (setcar (cdr expr) (math-mul (nth 1 expr)
+ (setcar (cdr math-simplify-expr) (math-mul (nth 1 math-simplify-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)))
+ (math-simplify-units-divisor (cdr n) (cdr (cdr math-simplify-expr)))
(setq np (cdr (cdr n))))
- (math-simplify-units-divisor np (cdr (cdr expr)))
- (if (eq try-cancel-units 0)
+ (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 expr nil))))
+ (base (math-simplify
+ (math-to-standard-units math-simplify-expr nil))))
(if (Math-numberp base)
- (setq expr base))))
- (if (eq (car-safe expr) '/)
+ (setq math-simplify-expr base))))
+ (if (eq (car-safe math-simplify-expr) '/)
(math-simplify-units-prod))
- expr)))
+ math-simplify-expr)))
(defun math-simplify-units-divisor (np dp)
(let ((n (car np))
(setq ud1 ud)
(while ud1
(and (eq (car (car un)) (car (car ud1)))
- (setq try-cancel-units
- (+ try-cancel-units
+ (setq math-try-cancel-units
+ (+ math-try-cancel-units
(- (* (cdr (car un)) pow1)
(* (cdr (car ud)) pow2)))))
(setq ud1 (cdr ud1)))
(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-realp (nth 2 math-simplify-expr))
+ (if (memq (car-safe (nth 1 math-simplify-expr)) '(* /))
+ (list (car (nth 1 math-simplify-expr))
+ (list '^ (nth 1 (nth 1 math-simplify-expr))
+ (nth 2 math-simplify-expr))
+ (list '^ (nth 2 (nth 1 math-simplify-expr))
+ (nth 2 math-simplify-expr)))
+ (math-simplify-units-pow (nth 1 math-simplify-expr)
+ (nth 2 math-simplify-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)))))
+ (if (memq (car-safe (nth 1 math-simplify-expr)) '(* /))
+ (list (car (nth 1 math-simplify-expr))
+ (list 'calcFunc-sqrt (nth 1 (nth 1 math-simplify-expr)))
+ (list 'calcFunc-sqrt (nth 2 (nth 1 math-simplify-expr))))
+ (math-simplify-units-pow (nth 1 math-simplify-expr) '(frac 1 2)))))
(math-defsimplify (calcFunc-floor
calcFunc-ceil
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)) '(* /))
+ (= (length math-simplify-expr) 2)
+ (if (math-only-units-in-expr-p (nth 1 math-simplify-expr))
+ (nth 1 math-simplify-expr)
+ (if (and (memq (car-safe (nth 1 math-simplify-expr)) '(* /))
(or (math-only-units-in-expr-p
- (nth 1 (nth 1 expr)))
+ (nth 1 (nth 1 math-simplify-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)))))))))
+ (nth 2 (nth 1 math-simplify-expr)))))
+ (list (car (nth 1 math-simplify-expr))
+ (cons (car math-simplify-expr)
+ (cons (nth 1 (nth 1 math-simplify-expr))
+ (cdr (cdr math-simplify-expr))))
+ (cons (car math-simplify-expr)
+ (cons (nth 2 (nth 1 math-simplify-expr))
+ (cdr (cdr math-simplify-expr)))))))))
(defun math-simplify-units-pow (a pow)
(if (and (eq (car-safe a) '^)
(math-defsimplify calcFunc-sin
(and math-simplifying-units
- (math-units-in-expr-p (nth 1 expr) nil)
+ (math-units-in-expr-p (nth 1 math-simplify-expr) nil)
(let ((rad (math-simplify-units
(math-evaluate-expr
- (math-to-standard-units (nth 1 expr) nil))))
+ (math-to-standard-units (nth 1 math-simplify-expr) nil))))
(calc-angle-mode 'rad))
(and (eq (car-safe rad) '*)
(math-realp (nth 1 rad))
(math-defsimplify calcFunc-cos
(and math-simplifying-units
- (math-units-in-expr-p (nth 1 expr) nil)
+ (math-units-in-expr-p (nth 1 math-simplify-expr) nil)
(let ((rad (math-simplify-units
(math-evaluate-expr
- (math-to-standard-units (nth 1 expr) nil))))
+ (math-to-standard-units (nth 1 math-simplify-expr) nil))))
(calc-angle-mode 'rad))
(and (eq (car-safe rad) '*)
(math-realp (nth 1 rad))
(math-defsimplify calcFunc-tan
(and math-simplifying-units
- (math-units-in-expr-p (nth 1 expr) nil)
+ (math-units-in-expr-p (nth 1 math-simplify-expr) nil)
(let ((rad (math-simplify-units
(math-evaluate-expr
- (math-to-standard-units (nth 1 expr) nil))))
+ (math-to-standard-units (nth 1 math-simplify-expr) nil))))
(calc-angle-mode 'rad))
(and (eq (car-safe rad) '*)
(math-realp (nth 1 rad))
(pop-to-buffer (get-buffer "*Units Table*"))
(display-buffer (get-buffer "*Units Table*")))))
+;; Local Variables:
+;; coding: iso-latin-1
+;; End:
+
+;;; arch-tag: e993314f-3adc-4191-be61-4ef8874881c4
;;; calc-units.el ends here
HCoop / bpt / emacs.git / blobdiff