calc-units.el 72.4 KB
Newer Older
1 2
;;; calc-units.el --- unit conversion functions for Calc

3
;; Copyright (C) 1990-1993, 2001-2012  Free Software Foundation, Inc.
4 5

;; Author: David Gillespie <daveg@synaptics.com>
Jay Belanger's avatar
Jay Belanger committed
6
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
Eli Zaretskii's avatar
Eli Zaretskii committed
7 8 9

;; This file is part of GNU Emacs.

10
;; GNU Emacs is free software: you can redistribute it and/or modify
11
;; it under the terms of the GNU General Public License as published by
12 13
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
14

Eli Zaretskii's avatar
Eli Zaretskii committed
15
;; GNU Emacs is distributed in the hope that it will be useful,
16 17 18 19 20
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
21
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
Eli Zaretskii's avatar
Eli Zaretskii committed
22

23
;;; Commentary:
Eli Zaretskii's avatar
Eli Zaretskii committed
24

25
;;; Code:
Eli Zaretskii's avatar
Eli Zaretskii committed
26 27 28

;; This file is autoloaded from calc-ext.el.

Jay Belanger's avatar
Jay Belanger committed
29
(require 'calc-ext)
Eli Zaretskii's avatar
Eli Zaretskii committed
30
(require 'calc-macs)
31 32
(eval-when-compile
  (require 'calc-alg))
Eli Zaretskii's avatar
Eli Zaretskii committed
33

34 35 36 37
;;; 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)
38
;;; Updated April 2002 by Jochen Küpper
39

40 41 42 43
;;; Updated August 2007, using
;;;     CODATA (http://physics.nist.gov/cuu/Constants/index.html)
;;;     NIST   (http://physics.nist.gov/Pubs/SP811/appenB9.html)
;;;     ESUWM  (Encyclopaedia of Scientific Units, Weights and
44
;;;             Measures, by François Cardarelli)
45
;;; All conversions are exact unless otherwise noted.
46 47 48

(defvar math-standard-units
  '( ;; Length
49
    ( m       nil                    "*Meter" )
50
    ( in      "254*10^(-2) cm"       "Inch"  nil
51 52
              "2.54 cm")
    ( ft      "12 in"                "Foot")
53 54
    ( yd      "3 ft"                 "Yard" )
    ( mi      "5280 ft"              "Mile" )
55
    ( au      "149597870691. m"      "Astronomical Unit" nil
56
              "149597870691 m (*)")
57 58
              ;; (approx) NASA JPL (http://neo.jpl.nasa.gov/glossary/au.html)
    ( lyr     "c yr"                 "Light Year" )
59
    ( pc      "3.0856775854*10^16 m" "Parsec  (**)" nil
60
              "3.0856775854 10^16 m (*)") ;; (approx) ESUWM
61 62
    ( nmi     "1852 m"               "Nautical Mile" )
    ( fath    "6 ft"                 "Fathom" )
63
    ( fur     "660 ft"               "Furlong")
64
    ( mu      "1 um"                 "Micron" )
65
    ( mil     "(1/1000) in"          "Mil" )
66
    ( point   "(1/72) in"            "Point  (PostScript convention)" )
67
    ( Ang     "10^(-10) m"           "Angstrom" )
68 69
    ( mfi     "mi+ft+in"             "Miles + feet + inches" )
    ;; TeX lengths
70 71 72 73 74 75
    ( texpt   "(100/7227) in"        "Point  (TeX convention) (**)" )
    ( texpc   "12 texpt"             "Pica  (TeX convention) (**)" )
    ( texbp   "point"                "Big point  (TeX convention) (**)" )
    ( texdd   "(1238/1157) texpt"    "Didot point  (TeX convention) (**)" )
    ( texcc   "12 texdd"             "Cicero  (TeX convention) (**)" )
    ( texsp   "(1/65536) texpt"      "Scaled TeX point (TeX convention) (**)" )
76

77
    ;; Area
78 79
    ( hect    "10000 m^2"            "*Hectare" )
    ( a       "100 m^2"              "Are")
80
    ( acre    "(1/640) mi^2"         "Acre" )
81
    ( b       "10^(-28) m^2"         "Barn" )
82

83
    ;; Volume
84
    ( L       "10^(-3) m^3"          "*Liter" )
85 86 87
    ( l       "L"                    "Liter" )
    ( gal     "4 qt"                 "US Gallon" )
    ( qt      "2 pt"                 "Quart" )
88
    ( pt      "2 cup"                "Pint (**)" )
89 90 91 92
    ( cup     "8 ozfl"               "Cup" )
    ( ozfl    "2 tbsp"               "Fluid Ounce" )
    ( floz    "2 tbsp"               "Fluid Ounce" )
    ( tbsp    "3 tsp"                "Tablespoon" )
93 94
    ;; ESUWM defines a US gallon as 231 in^3.
    ;; That gives the following exact value for tsp.
95
    ( tsp     "492892159375*10^(-11) ml" "Teaspoon" nil
96
              "4.92892159375 ml")
97 98
    ( vol     "tsp+tbsp+ozfl+cup+pt+qt+gal" "Gallons + ... + teaspoons" nil
              "tsp+tbsp+ozfl+cup+pt+qt+gal")
99
    ( galC    "galUK"                "Canadian Gallon" )
100
    ( galUK   "454609*10^(-5) L"     "UK Gallon" nil
101
              "4.54609 L") ;; NIST
102

103
    ;; Time
104 105 106 107 108 109 110
    ( 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" )
111 112
    ( yr      "36525*10^(-2) day"    "Year (Julian)" nil
              "365.25 day")
113
    ( Hz      "1/s"                  "Hertz" )
114 115

    ;; Speed
116 117 118
    ( mph     "mi/hr"                "*Miles per hour" )
    ( kph     "km/hr"                "Kilometers per hour" )
    ( knot    "nmi/hr"               "Knot" )
119
    ( c       "299792458 m/s"        "Speed of light" ) ;;; CODATA
120

121
    ;; Acceleration
122
    ( ga      "980665*10^(-5) m/s^2" "*\"g\" acceleration" nil
123
              "9.80665 m / s^2") ;; CODATA
124 125

    ;; Mass
126 127
    ( g       nil                    "*Gram" )
    ( lb      "16 oz"                "Pound (mass)" )
128
    ( oz      "28349523125*10^(-9) g" "Ounce (mass)" nil
129
              "28.349523125 g") ;; ESUWM
130 131 132
    ( ton     "2000 lb"              "Ton" )
    ( tpo     "ton+lb+oz"            "Tons + pounds + ounces (mass)" )
    ( t       "1000 kg"              "Metric ton" )
133
    ( tonUK   "10160469088*10^(-7) kg" "UK ton" nil
134
              "1016.0469088 kg") ;; ESUWM
135
    ( lbt     "12 ozt"               "Troy pound" )
136
    ( ozt     "311034768*10^(-7) g"        "Troy ounce" nil
137
              "31.10347680 g") ;; ESUWM, 1/12 exact value for lbt
138
    ( ct      "(2/10) g"             "Carat" nil
139
              "0.2 g") ;; ESUWM
140
    ( u       "1.660538782*10^(-27) kg"    "Unified atomic mass" nil
141
              "1.660538782 10^-27 kg (*)");;(approx) CODATA
142 143

    ;; Force
144
    ( N       "m kg/s^2"             "*Newton" )
145
    ( dyn     "10^(-5) N"            "Dyne" )
146
    ( gf      "ga g"                 "Gram (force)" )
147
    ( lbf     "ga lb"                "Pound (force)" )
148
    ( kip     "1000 lbf"             "Kilopound (force)" )
149
    ( pdl     "138254954376*10^(-12) N" "Poundal" nil
150
              "0.138254954376 N") ;; ESUWM
151 152

    ;; Energy
153
    ( J       "N m"                  "*Joule" )
154
    ( erg     "10^(-7) J"            "Erg" )
155
    ( cal     "41868*10^(-4) J"      "International Table Calorie" nil
156
              "4.1868 J") ;; NIST
157
    ( calth   "4184*10^(-3) J"       "Thermochemical Calorie" nil
158 159
              "4.184 J") ;; NIST
    ( Cal     "1000 cal"             "Large Calorie")
160
    ( Btu     "105505585262*10^(-8) J" "International Table Btu" nil
161
              "1055.05585262 J") ;; ESUWM
162 163 164 165 166 167 168 169
    ( 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")
170
    ( Wh      "W hr"                 "Watt hour")
171
    ( Ws      "W s"                  "Watt second")
172 173

    ;; Power
174
    ( W       "J/s"                  "*Watt" )
175 176
    ( hp      "550 ft lbf/s"         "Horsepower") ;;ESUWM
    ( hpm     "75 m kgf/s"           "Metric Horsepower") ;;ESUWM
177 178

    ;; Temperature
179 180 181 182 183 184 185
    ( 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 )
186 187

    ;; Pressure
188
    ( Pa      "N/m^2"                "*Pascal" )
189 190
    ( bar     "10^5 Pa"              "Bar" )
    ( atm     "101325 Pa"            "Standard atmosphere" ) ;; CODATA
191
    ( Torr    "(1/760) atm"          "Torr")
192
    ( mHg     "1000 Torr"            "Meter of mercury" )
193
    ( inHg    "254*10^(-1) mmHg"     "Inch of mercury" nil
194
              "25.4 mmHg")
195
    ( inH2O   "2.490889*10^2 Pa"        "Inch of water" nil
196
              "2.490889 10^2 Pa (*)") ;;(approx) NIST
197
    ( psi     "lbf/in^2"             "Pounds per square inch" )
198 199

    ;; Viscosity
200 201
    ( P       "(1/10) Pa s"           "*Poise" )
    ( St      "10^(-4) m^2/s"         "Stokes" )
202 203

    ;; Electromagnetism
204 205 206
    ( A       nil                     "*Ampere" )
    ( C       "A s"                   "Coulomb" )
    ( Fdy     "ech Nav"               "Faraday" )
207
    ( e       "ech"                   "Elementary charge" )
208
    ( ech     "1.602176487*10^(-19) C"     "Elementary charge" nil
209
              "1.602176487 10^-19 C (*)") ;;(approx) CODATA
210 211
    ( V       "W/A"                   "Volt" )
    ( ohm     "V/A"                   "Ohm" )
212
    ( Ω       "ohm"                   "Ohm" )
213 214 215 216 217
    ( mho     "A/V"                   "Mho" )
    ( S       "A/V"                   "Siemens" )
    ( F       "C/V"                   "Farad" )
    ( H       "Wb/A"                  "Henry" )
    ( T       "Wb/m^2"                "Tesla" )
218
    ( Gs      "10^(-4) T"             "Gauss" )
219
    ( Wb      "V s"                   "Weber" )
220 221

    ;; Luminous intensity
222
    ( cd      nil                     "*Candela" )
223
    ( sb      "10000 cd/m^2"          "Stilb" )
224 225
    ( lm      "cd sr"                 "Lumen" )
    ( lx      "lm/m^2"                "Lux" )
226
    ( ph      "10000 lx"              "Phot" )
227
    ( fc      "lm/ft^2"               "Footcandle") ;; ESUWM
228
    ( lam     "10000 lm/m^2"          "Lambert" )
229
    ( flam    "(1/pi) cd/ft^2"        "Footlambert") ;; ESUWM
230 231

    ;; Radioactivity
232
    ( Bq      "1/s"                    "*Becquerel" )
233
    ( Ci      "37*10^9 Bq"             "Curie" ) ;; ESUWM
234 235
    ( Gy      "J/kg"                   "Gray" )
    ( Sv      "Gy"                     "Sievert" )
236 237
    ( R       "258*10^(-6) C/kg"       "Roentgen" ) ;; NIST
    ( rd      "(1/100) Gy"             "Rad" )
238
    ( rem     "rd"                     "Rem" )
239 240

    ;; Amount of substance
241
    ( mol     nil                      "*Mole" )
242 243

    ;; Plane angle
244 245 246 247 248 249 250 251
    ( 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" )
252 253

    ;; Solid angle
254
    ( sr      nil                      "*Steradian" )
255

256
    ;; Other physical quantities
257
    ;; The values are from CODATA, and are approximate.
258
    ( h       "6.62606896*10^(-34) J s"     "*Planck's constant" nil
259 260 261
              "6.62606896 10^-34 J s (*)")
    ( hbar    "h / (2 pi)"                  "Planck's constant" ) ;; Exact
    ( mu0     "4 pi 10^(-7) H/m"            "Permeability of vacuum") ;; Exact
262
    ( μ0      "mu0"                         "Permeability of vacuum") ;; Exact
263
    ( eps0    "1 / (mu0 c^2)"               "Permittivity of vacuum" )
264
    ( ε0      "eps0"                        "Permittivity of vacuum" )
265
    ( G       "6.67428*10^(-11) m^3/(kg s^2)"    "Gravitational constant" nil
266
              "6.67428 10^-11 m^3/(kg s^2) (*)")
267
    ( Nav     "6.02214179*10^(23) / mol"    "Avogadro's constant" nil
268
              "6.02214179 10^23 / mol (*)")
269
    ( me      "9.10938215*10^(-31) kg"      "Electron rest mass" nil
270
              "9.10938215 10^-31 kg (*)")
271
    ( mp      "1.672621637*10^(-27) kg"     "Proton rest mass" nil
272
              "1.672621637 10^-27 kg (*)")
273
    ( mn      "1.674927211*10^(-27) kg"     "Neutron rest mass" nil
274
              "1.674927211 10^-27 kg (*)")
275
    ( mmu     "1.88353130*10^(-28) kg"      "Muon rest mass" nil
276
              "1.88353130 10^-28 kg (*)")
277 278
    ( mμ      "mmu"                         "Muon rest mass" nil
              "1.88353130 10^-28 kg (*)")
279
    ( Ryd     "10973731.568527 /m"          "Rydberg's constant" nil
280
              "10973731.568527 /m (*)")
281
    ( k       "1.3806504*10^(-23) J/K"      "Boltzmann's constant" nil
282
              "1.3806504 10^-23 J/K (*)")
283
    ( alpha   "7.2973525376*10^(-3)"        "Fine structure constant" nil
284
              "7.2973525376 10^-3 (*)")
285 286
    ( α       "alpha"                        "Fine structure constant" nil
              "7.2973525376 10^-3 (*)")
287
    ( muB     "927.400915*10^(-26) J/T"     "Bohr magneton" nil
288
              "927.400915 10^-26 J/T (*)")
289
    ( muN     "5.05078324*10^(-27) J/T"     "Nuclear magneton" nil
290
              "5.05078324 10^-27 J/T (*)")
291
    ( mue     "-928.476377*10^(-26) J/T"    "Electron magnetic moment" nil
292
              "-928.476377 10^-26 J/T (*)")
293
    ( mup     "1.410606662*10^(-26) J/T"    "Proton magnetic moment" nil
294
              "1.410606662 10^-26 J/T (*)")
295
    ( R0      "8.314472 J/(mol K)"          "Molar gas constant" nil
296
              "8.314472 J/(mol K) (*)")
297
    ( V0      "22.710981*10^(-3) m^3/mol"   "Standard volume of ideal gas" nil
298 299 300 301
              "22.710981 10^-3 m^3/mol (*)")
    ;; Logarithmic units
    ( Np      nil    "*Neper")
    ( dB      "(ln(10)/20) Np" "decibel")))
302 303 304 305


(defvar math-additional-units nil
  "*Additional units table for user-defined units.
306
Must be formatted like `math-standard-units'.
307
If you change this, be sure to set `math-units-table' to nil to ensure
308 309 310
that the combined units table will be rebuilt.")

(defvar math-unit-prefixes
311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327
  '( ( ?Y  (^ 10 24)  "Yotta"  )
     ( ?Z  (^ 10 21)  "Zetta"  )
     ( ?E  (^ 10 18)  "Exa"    )
     ( ?P  (^ 10 15)  "Peta"   )
     ( ?T  (^ 10 12)  "Tera"   )
     ( ?G  (^ 10 9)   "Giga"   )
     ( ?M  (^ 10 6)   "Mega"   )
     ( ?k  (^ 10 3)   "Kilo"   )
     ( ?K  (^ 10 3)   "Kilo"   )
     ( ?h  (^ 10 2)   "Hecto"  )
     ( ?H  (^ 10 2)   "Hecto"  )
     ( ?D  (^ 10 1)   "Deka"   )
     ( 0   (^ 10 0)    nil     )
     ( ?d  (^ 10 -1)  "Deci"   )
     ( ?c  (^ 10 -2)  "Centi"  )
     ( ?m  (^ 10 -3)  "Milli"  )
     ( ?u  (^ 10 -6)  "Micro"  )
Glenn Morris's avatar
Glenn Morris committed
328
     ( ?μ  (^ 10 -6)  "Micro"  )
329 330 331 332 333 334
     ( ?n  (^ 10 -9)  "Nano"   )
     ( ?p  (^ 10 -12) "Pico"   )
     ( ?f  (^ 10 -15) "Femto"  )
     ( ?a  (^ 10 -18) "Atto"   )
     ( ?z  (^ 10 -21) "zepto"  )
     ( ?y  (^ 10 -24) "yocto"  )))
335 336 337

(defvar math-standard-units-systems
  '( ( base  nil )
338 339 340
     ( si    ( ( g   '(/ (var kg var-kg) 1000) ) ) )
     ( mks   ( ( g   '(/ (var kg var-kg) 1000) ) ) )
     ( cgs   ( ( m   '(* (var cm var-cm) 100 ) ) ) )))
341 342

(defvar math-units-table nil
343 344
  "Internal units table.
Derived from `math-standard-units' and `math-additional-units'.
345 346 347
Entries are (SYMBOL EXPR DOC-STRING TEMP-TYPE BASE-UNITS).")

(defvar math-units-table-buffer-valid nil)
Eli Zaretskii's avatar
Eli Zaretskii committed
348 349 350 351 352 353 354 355 356

;;; 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)
357
							  nil))))))
Eli Zaretskii's avatar
Eli Zaretskii committed
358 359 360 361

(defun calc-quick-units ()
  (interactive)
  (calc-slow-wrapper
362
   (let* ((num (- last-command-event ?0))
Eli Zaretskii's avatar
Eli Zaretskii committed
363 364 365
	  (pos (if (= num 0) 10 num))
	  (units (calc-var-value 'var-Units))
	  (expr (calc-top-n 1)))
366
     (unless (and (>= num 0) (<= num 9))
367
       (error "Bad unit number"))
368
     (unless (math-vectorp units)
369
       (error "No \"quick units\" are defined"))
370
     (unless (< pos (length units))
371
       (error "Unit number %d not defined" pos))
Eli Zaretskii's avatar
Eli Zaretskii committed
372 373 374 375 376
     (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
377
			   (math-mul expr (nth pos units))))))))
Eli Zaretskii's avatar
Eli Zaretskii committed
378

379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394
(defun math-get-standard-units (expr)
  "Return the standard units in EXPR."
  (math-simplify-units
   (math-extract-units
    (math-to-standard-units expr nil))))

(defun math-get-units (expr)
  "Return the units in EXPR."
  (math-simplify-units
   (math-extract-units expr)))

(defun math-make-unit-string (expr)
  "Return EXPR in string form.
If EXPR is nil, return nil."
  (if expr
      (let ((cexpr (math-compose-expr expr 0)))
395
        (replace-regexp-in-string
396 397 398 399
         " / " "/"
         (if (stringp cexpr)
             cexpr
           (math-composition-to-string cexpr))))))
400

401
(defvar math-default-units-table
402 403 404 405 406 407 408
  (make-hash-table :test 'equal)
  "A table storing previously converted units.")

(defun math-get-default-units (expr)
  "Get default units to use when converting the units in EXPR."
  (let* ((units (math-get-units expr))
         (standard-units (math-get-standard-units expr))
409
         (default-units (gethash
410 411 412 413 414 415 416 417
                         standard-units
                         math-default-units-table)))
    (if (equal units (car default-units))
        (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."
418 419 420
  (let ((units (math-get-units expr)))
    (unless (eq units 1)
      (let* ((standard-units (math-get-standard-units expr))
421 422 423
         (default-units (gethash
                         standard-units
                         math-default-units-table)))
424 425 426 427 428 429 430
        (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)))))))
431 432


Eli Zaretskii's avatar
Eli Zaretskii committed
433 434 435 436 437
(defun calc-convert-units (&optional old-units new-units)
  (interactive)
  (calc-slow-wrapper
   (let ((expr (calc-top-n 1))
	 (uoldname nil)
438
	 unew
439 440
         units
         defunits)
441 442 443 444 445 446 447 448 449 450 451 452 453 454 455
     (unless (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))))))
	 (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
456
       (setq defunits (math-get-default-units expr))
457
       (setq new-units
458 459 460 461 462 463 464 465
             (read-string (concat
                           (if uoldname
                               (concat "Old units: "
                                       uoldname
                                       ", new units")
                            "New units")
                           (if defunits
                               (concat
466
                                " (default "
467 468 469
                                defunits
                                "): ")
                             ": "))))
470

471 472 473 474
       (if (and
            (string= new-units "")
            defunits)
           (setq new-units defunits)))
475 476
     (when (string-match "\\` */" new-units)
       (setq new-units (concat "1" new-units)))
Eli Zaretskii's avatar
Eli Zaretskii committed
477
     (setq units (math-read-expr new-units))
478 479
     (when (eq (car-safe units) 'error)
       (error "Bad format in units expression: %s" (nth 2 units)))
480
     (math-put-default-units units)
Eli Zaretskii's avatar
Eli Zaretskii committed
481 482 483 484 485 486 487
     (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))))
488 489
	 (unless unew
	   (error "No units specified"))
Eli Zaretskii's avatar
Eli Zaretskii committed
490 491 492
	 (calc-enter-result 1 "cvun"
			    (math-convert-units
			     expr units
493
			     (and uoldname (not (equal uoldname "1"))))))))))
Eli Zaretskii's avatar
Eli Zaretskii committed
494 495 496 497 498 499

(defun calc-autorange-units (arg)
  (interactive "P")
  (calc-wrapper
   (calc-change-mode 'calc-autorange-units arg nil t)
   (message (if calc-autorange-units
500 501
		"Adjusting target unit prefix automatically"
	      "Using target units exactly"))))
Eli Zaretskii's avatar
Eli Zaretskii committed
502 503 504 505 506 507 508

(defun calc-convert-temperature (&optional old-units new-units)
  (interactive)
  (calc-slow-wrapper
   (let ((expr (calc-top-n 1))
	 (uold nil)
	 (uoldname nil)
509 510
	 unew
         defunits)
Eli Zaretskii's avatar
Eli Zaretskii committed
511 512 513 514 515 516 517 518 519 520 521 522
     (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: ")))))))
523 524
     (when (eq (car-safe uold) 'error)
       (error "Bad format in units expression: %s" (nth 2 uold)))
Eli Zaretskii's avatar
Eli Zaretskii committed
525 526
     (or (math-units-in-expr-p expr nil)
	 (setq expr (math-mul expr uold)))
527
     (setq defunits (math-get-default-units expr))
Eli Zaretskii's avatar
Eli Zaretskii committed
528
     (setq unew (or new-units
529 530 531 532 533 534 535 536 537 538 539 540 541
                    (read-string
                     (concat
                      (if uoldname
                          (concat "Old temperature units: "
                                  uoldname
                                  ", new units")
                        "New temperature units")
                      (if defunits
                          (concat " (default "
                                  defunits
                                  "): ")
                        ": ")))))
     (setq unew (math-read-expr (if (string= unew "") defunits unew)))
542 543
     (when (eq (car-safe unew) 'error)
       (error "Bad format in units expression: %s" (nth 2 unew)))
544
     (math-put-default-units unew)
545 546 547 548 549 550 551 552
     (let ((ntemp (calc-normalize
                   (math-simplify-units
                    (math-convert-temperature expr uold unew
                                              uoldname)))))
       (if (Math-zerop ntemp)
           (setq ntemp (list '* ntemp unew)))
       (let ((calc-simplify-mode 'none))
         (calc-enter-result 1 "cvtm" ntemp))))))
Eli Zaretskii's avatar
Eli Zaretskii committed
553 554 555 556 557

(defun calc-remove-units ()
  (interactive)
  (calc-slow-wrapper
   (calc-enter-result 1 "rmun" (math-simplify-units
558
				(math-remove-units (calc-top-n 1))))))
Eli Zaretskii's avatar
Eli Zaretskii committed
559 560 561 562 563

(defun calc-extract-units ()
  (interactive)
  (calc-slow-wrapper
   (calc-enter-result 1 "rmun" (math-simplify-units
564
				(math-extract-units (calc-top-n 1))))))
Eli Zaretskii's avatar
Eli Zaretskii committed
565

566
;; The variables calc-num-units and calc-den-units are local to
567 568 569 570 571
;; 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)

Eli Zaretskii's avatar
Eli Zaretskii committed
572 573 574
(defun calc-explain-units ()
  (interactive)
  (calc-wrapper
575 576
   (let ((calc-num-units nil)
	 (calc-den-units nil))
Eli Zaretskii's avatar
Eli Zaretskii committed
577
     (calc-explain-units-rec (calc-top-n 1) 1)
578 579 580 581 582 583 584 585
     (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)
586
	 (message "No units in expression"))))))
Eli Zaretskii's avatar
Eli Zaretskii committed
587 588 589 590 591 592 593 594

(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)))
595 596
	  (if (string-match "[^a-zA-Zα-ωΑ-Ω0-9']" name)
	      (if (string-match "^[a-zA-Zα-ωΑ-Ω0-9' ()]*$" name)
Eli Zaretskii's avatar
Eli Zaretskii committed
597 598 599 600 601 602 603 604 605
		  (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))
606
				 (if (and (string-match "[^a-zA-Zα-ωΑ-Ω0-9']" name)
Eli Zaretskii's avatar
Eli Zaretskii committed
607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625
					  (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)
626 627
	      (setq calc-num-units (if calc-num-units
				  (concat calc-num-units " " name)
Eli Zaretskii's avatar
Eli Zaretskii committed
628
				name))
629 630
	    (setq calc-den-units (if calc-den-units
				(concat calc-den-units " " name)
Eli Zaretskii's avatar
Eli Zaretskii committed
631 632 633 634 635 636 637 638 639 640 641 642
			      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)
643
				     (math-mul pow (nth 2 expr))))))))
Eli Zaretskii's avatar
Eli Zaretskii committed
644 645 646 647 648

(defun calc-simplify-units ()
  (interactive)
  (calc-slow-wrapper
   (calc-with-default-simplification
649
    (calc-enter-result 1 "smun" (math-simplify-units (calc-top-n 1))))))
Eli Zaretskii's avatar
Eli Zaretskii committed
650 651 652 653 654 655 656 657 658 659 660 661 662 663

(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)))
664
      (math-build-units-table-buffer nil))))
Eli Zaretskii's avatar
Eli Zaretskii committed
665 666 667 668 669

(defun calc-enter-units-table (n)
  (interactive "P")
  (and n (setq math-units-table-buffer-valid nil))
  (math-build-units-table-buffer t)
670
  (message "%s" (substitute-command-keys "Type \\[calc] to return to the Calculator")))
Eli Zaretskii's avatar
Eli Zaretskii committed
671

672 673 674
(defun calc-define-unit (uname desc &optional disp)
  (interactive "SDefine unit name: \nsDescription: \nP")
  (if disp (setq disp (read-string "Display definition: ")))
Eli Zaretskii's avatar
Eli Zaretskii committed
675 676 677 678 679
  (calc-wrapper
   (let ((form (calc-top-n 1))
	 (unit (assq uname math-additional-units)))
     (or unit
	 (setq math-additional-units
680
	       (cons (setq unit (list uname nil nil nil nil))
Eli Zaretskii's avatar
Eli Zaretskii committed
681 682 683 684 685 686 687
		     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 ""))
688 689 690
				   desc))
     (if disp
         (setcar (cdr (cdr (cdr (cdr unit)))) disp))))
691
  (calc-invalidate-units-table))
Eli Zaretskii's avatar
Eli Zaretskii committed
692 693 694 695 696 697 698 699 700 701 702

(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)))
703
  (calc-invalidate-units-table))
Eli Zaretskii's avatar
Eli Zaretskii committed
704 705 706 707 708

(defun calc-invalidate-units-table ()
  (setq math-units-table nil)
  (let ((buf (get-buffer "*Units Table*")))
    (and buf
709
	 (with-current-buffer buf
Eli Zaretskii's avatar
Eli Zaretskii committed
710 711 712
	   (save-excursion
	     (goto-char (point-min))
	     (if (looking-at "Calculator Units Table")
713
		 (let ((inhibit-read-only t))
714
		   (insert "(Obsolete) "))))))))
Eli Zaretskii's avatar
Eli Zaretskii committed
715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735

(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)))))
736
	 (message "Base unit: %s" msg))))))
Eli Zaretskii's avatar
Eli Zaretskii committed
737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776

(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")
777
     (save-buffer))))
Eli Zaretskii's avatar
Eli Zaretskii committed
778 779


780 781 782 783 784 785
;; 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)
Eli Zaretskii's avatar
Eli Zaretskii committed
786 787 788 789 790

(defun math-build-units-table ()
  (or math-units-table
      (let* ((combined-units (append math-additional-units
				     math-standard-units))
791
	     (math-cu-unit-list (mapcar 'car combined-units))
Eli Zaretskii's avatar
Eli Zaretskii committed
792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809
	     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))
810 811
					(list (cons (car x) 1)))
                                   (nth 4 x))))
Eli Zaretskii's avatar
Eli Zaretskii committed
812 813
			  combined-units))
	(let ((math-units-table tab))
814
	  (mapc 'math-find-base-units tab))
Eli Zaretskii's avatar
Eli Zaretskii committed
815
	(message "Building units table...done")
816
	(setq math-units-table tab))))
Eli Zaretskii's avatar
Eli Zaretskii committed
817

818 819 820 821 822 823
;; 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)

Jay Belanger's avatar
Jay Belanger committed
824 825 826 827 828 829 830 831 832 833 834 835
(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))
Eli Zaretskii's avatar
Eli Zaretskii committed
836 837 838 839
	  (while (cdr b)
	    (if (eq (cdr (car (cdr b))) 0)
		(setcdr b (cdr (cdr b)))
	      (setq b (cdr b)))))
Jay Belanger's avatar
Jay Belanger committed
840 841 842
	(setq math-fbu-base (sort math-fbu-base 'math-compare-unit-names))
	(setcar (nthcdr 4 math-fbu-entry) math-fbu-base)
	math-fbu-base)))
Eli Zaretskii's avatar
Eli Zaretskii committed
843 844

(defun math-compare-unit-names (a b)
845
  (memq (car b) (cdr (memq (car a) math-cu-unit-list))))
Eli Zaretskii's avatar
Eli Zaretskii committed
846 847 848 849 850 851 852

(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))
Jay Belanger's avatar
Jay Belanger committed
853
		     (old (assq (car (car ulist)) math-fbu-base)))
Eli Zaretskii's avatar
Eli Zaretskii committed
854 855
		 (if old
		     (setcdr old (+ (cdr old) p))
856
		   (setq math-fbu-base
Jay Belanger's avatar
Jay Belanger committed
857
                         (cons (cons (car (car ulist)) p) math-fbu-base))))
Eli Zaretskii's avatar
Eli Zaretskii committed
858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875
	       (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"
Jay Belanger's avatar
Jay Belanger committed
876
		      (nth 1 expr) (car math-fbu-entry))))
877
          ((equal expr '(calcFunc-ln 10)))
Jay Belanger's avatar
Jay Belanger committed
878
	  (t (error "Malformed defining expression for unit %s" (car math-fbu-entry))))))
Eli Zaretskii's avatar
Eli Zaretskii committed
879 880 881 882 883 884 885 886 887


(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)
888
		  (math-units-in-expr-p (nth 2 expr) sub-exprs))))))
Eli Zaretskii's avatar
Eli Zaretskii committed
889 890 891 892 893 894 895 896 897 898

(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))
899
		     (math-realp (nth 2 expr))))))))
Eli Zaretskii's avatar
Eli Zaretskii committed
900 901 902 903 904 905 906 907 908 909 910 911 912 913 914

(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))))
915
	(t 'wrong)))
Eli Zaretskii's avatar
Eli Zaretskii committed
916 917 918 919 920 921 922 923 924 925 926 927 928

(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))
929
				 math-units-table))))))))
Eli Zaretskii's avatar
Eli Zaretskii committed
930

931 932 933 934
;; 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)
Eli Zaretskii's avatar
Eli Zaretskii committed
935

936
(defun math-to-standard-units (expr math-which-standard)
937
  (math-to-standard-rec expr))
Eli Zaretskii's avatar
Eli Zaretskii committed
938 939 940 941 942 943 944 945 946

(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)))
947
		(let ((st (assq (car u) math-which-standard)))
Eli Zaretskii's avatar
Eli Zaretskii committed
948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963
		  (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)))
964 965 966 967
    (if (or
         (Math-primp expr)
         (and (eq (car-safe expr) 'calcFunc-subscr)
              (eq (car-safe (nth 1 expr)) 'var)))
Eli Zaretskii's avatar
Eli Zaretskii committed
968 969
	expr
      (cons (car expr)
970
	    (mapcar 'math-to-standard-rec (cdr expr))))))
Eli Zaretskii's avatar
Eli Zaretskii committed
971 972

(defun math-apply-units (expr units ulist &optional pure)
973
  (setq expr (math-simplify-units expr))
Eli Zaretskii's avatar
Eli Zaretskii committed
974 975 976 977 978 979 980 981 982 983 984 985 986 987 988
  (if ulist
      (let ((new 0)
	    value)
	(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)))))
989 990 991
    (if pure
        expr
      (math-simplify-units (list '* expr units)))))
Eli Zaretskii's avatar
Eli Zaretskii committed
992

993
(defvar math-decompose-units-cache nil)
Eli Zaretskii's avatar
Eli Zaretskii committed
994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011
(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))
1012 1013
		 (unless (equal (nth 2 (car utemp)) (nth 2 (car ulist)))
		   (error "Inconsistent units in sum")))
Eli Zaretskii's avatar
Eli Zaretskii committed
1014 1015 1016 1017 1018 1019 1020
	       (setq math-decompose-units-cache
		     (cons entry
			   (sort ulist
				 (function
				  (lambda (x y)
				    (not (Math-lessp (nth 1 x)
						     (nth 1 y))))))))))
1021
	 (cdr math-decompose-units-cache))))
Eli Zaretskii's avatar
Eli Zaretskii committed
1022 1023 1024 1025 1026

(defun math-decompose-unit-part (unit)
  (cons unit
	(math-is-multiple (math-simplify-units (math-to-standard-units
						unit nil))
1027
			  t)))
Eli Zaretskii's avatar
Eli Zaretskii committed
1028

1029 1030 1031 1032 1033
;; 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)

Eli Zaretskii's avatar
Eli Zaretskii committed
1034
(defun math-find-compatible-unit (expr unit)
1035 1036
  (let ((math-fcu-u (math-check-unit-name unit)))
    (if math-fcu-u
1037
	(math-find-compatible-unit-rec expr 1))))
Eli Zaretskii's avatar
Eli Zaretskii committed
1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050

(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)))
1051
	   (if (equal (nth 4 math-fcu-u) (nth 4 u2))
1052
	       (cons expr pow))))))
Eli Zaretskii's avatar
Eli Zaretskii committed
1053

1054 1055
;; The variables math-cu-new-units and math-cu-pure are local to
;; math-convert-units, but are used by math-convert-units-rec,
1056 1057 1058 1059 1060
;; 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)
1061 1062 1063 1064 1065
  (if (eq (car-safe math-cu-new-units) 'var)
      (let ((unew (assq (nth 1 math-cu-new-units)
                        (math-build-units-table))))
        (if (eq (car-safe (nth 1 unew)) '+)
            (setq math-cu-new-units (nth 1 unew)))))
Eli Zaretskii's avatar
Eli Zaretskii committed
1066
  (math-with-extra-prec 2
1067
    (let ((compat (and (not math-cu-pure)
1068 1069
                       (math-find-compatible-unit expr math-cu-new-units)))
	  (math-cu-unit-list nil)
Eli Zaretskii's avatar
Eli Zaretskii committed
1070 1071 1072 1073 1074 1075
	  (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))))
1076
			       (math-pow math-cu-new-units (cdr compat)))
Eli Zaretskii's avatar
Eli Zaretskii committed
1077 1078
		     (math-simplify-units
		      (math-to-standard-units
1079
		       (math-pow (math-div (car compat) math-cu-new-units)
Eli Zaretskii's avatar
Eli Zaretskii committed
1080 1081