diff options
| author | Jay Belanger | 2012-08-11 23:32:28 -0500 |
|---|---|---|
| committer | Jay Belanger | 2012-08-11 23:32:28 -0500 |
| commit | 0fd0912879f70f410cd336e538d8c515508126c7 (patch) | |
| tree | 445a6ded9606f9404bb269851b570c700735d94a /lisp | |
| parent | 38a414f0f1a5f658f8b9fa6c8914d468e9394586 (diff) | |
| download | emacs-0fd0912879f70f410cd336e538d8c515508126c7.tar.gz emacs-0fd0912879f70f410cd336e538d8c515508126c7.zip | |
calc/calc-units.el (math-default-units-table): Give it an
initial value.
(math-put-default-units): Add options to put composite units and unit
systems in default units table.
(calc-convert-units): Send composite units to `math-put-default-units'
when appropriate.
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/ChangeLog | 9 | ||||
| -rw-r--r-- | lisp/calc/calc-units.el | 117 |
2 files changed, 69 insertions, 57 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 5dbd592448c..716555f2ffe 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,3 +1,12 @@ | |||
| 1 | 2012-08-12 Jay Belanger <jay.p.belanger@gmail.com> | ||
| 2 | |||
| 3 | * calc/calc-units.el (math-default-units-table): Give an | ||
| 4 | initial value. | ||
| 5 | (math-put-default-units): Add options to put composite units and | ||
| 6 | unit systems in the default units table. | ||
| 7 | (calc-convert-units): Send composite units to | ||
| 8 | `math-put-default-units' when appropriate. | ||
| 9 | |||
| 1 | 2012-08-11 Glenn Morris <rgm@gnu.org> | 10 | 2012-08-11 Glenn Morris <rgm@gnu.org> |
| 2 | 11 | ||
| 3 | * emacs-lisp/copyright.el (copyright-update-directory): Logic fix. | 12 | * emacs-lisp/copyright.el (copyright-update-directory): Logic fix. |
diff --git a/lisp/calc/calc-units.el b/lisp/calc/calc-units.el index e5c7b6737fb..39f710f8322 100644 --- a/lisp/calc/calc-units.el +++ b/lisp/calc/calc-units.el | |||
| @@ -404,7 +404,7 @@ If EXPR is nil, return nil." | |||
| 404 | (math-composition-to-string cexpr)))))) | 404 | (math-composition-to-string cexpr)))))) |
| 405 | 405 | ||
| 406 | (defvar math-default-units-table | 406 | (defvar math-default-units-table |
| 407 | (make-hash-table :test 'equal) | 407 | #s(hash-table test equal data (1 (1))) |
| 408 | "A table storing previously converted units.") | 408 | "A table storing previously converted units.") |
| 409 | 409 | ||
| 410 | (defun math-get-default-units (expr) | 410 | (defun math-get-default-units (expr) |
| @@ -418,22 +418,24 @@ If EXPR is nil, return nil." | |||
| 418 | (math-make-unit-string (cadr default-units)) | 418 | (math-make-unit-string (cadr default-units)) |
| 419 | (math-make-unit-string (car default-units))))) | 419 | (math-make-unit-string (car default-units))))) |
| 420 | 420 | ||
| 421 | (defun math-put-default-units (expr) | 421 | (defun math-put-default-units (expr &optional comp std) |
| 422 | "Put the units in EXPR in the default units table." | 422 | "Put the units in EXPR in the default units table. |
| 423 | (let ((units (math-get-units expr))) | 423 | If COMP or STD is non-nil, put that in the units table instead." |
| 424 | (unless (eq units 1) | 424 | (let* ((new-units (or comp std (math-get-units expr))) |
| 425 | (let* ((standard-units (math-get-standard-units expr)) | 425 | (standard-units (math-get-standard-units |
| 426 | (default-units (gethash | 426 | (cond |
| 427 | standard-units | 427 | (comp (math-simplify-units expr)) |
| 428 | math-default-units-table))) | 428 | (std expr) |
| 429 | (cond | 429 | (t new-units)))) |
| 430 | ((not default-units) | 430 | (default-units (gethash standard-units math-default-units-table))) |
| 431 | (puthash standard-units (list units) math-default-units-table)) | 431 | (unless (eq standard-units 1) |
| 432 | ((not (equal units (car default-units))) | 432 | (cond |
| 433 | (puthash standard-units | 433 | ((not default-units) |
| 434 | (list units (car default-units)) | 434 | (puthash standard-units (list new-units) math-default-units-table)) |
| 435 | math-default-units-table))))))) | 435 | ((not (equal new-units (car default-units))) |
| 436 | 436 | (puthash standard-units | |
| 437 | (list new-units (car default-units)) | ||
| 438 | math-default-units-table)))))) | ||
| 437 | 439 | ||
| 438 | (defun calc-convert-units (&optional old-units new-units) | 440 | (defun calc-convert-units (&optional old-units new-units) |
| 439 | (interactive) | 441 | (interactive) |
| @@ -457,47 +459,48 @@ If EXPR is nil, return nil." | |||
| 457 | (when (eq (car-safe uold) 'error) | 459 | (when (eq (car-safe uold) 'error) |
| 458 | (error "Bad format in units expression: %s" (nth 1 uold))) | 460 | (error "Bad format in units expression: %s" (nth 1 uold))) |
| 459 | (setq expr (math-mul expr uold)))) | 461 | (setq expr (math-mul expr uold)))) |
| 460 | (unless new-units | 462 | (setq defunits (math-get-default-units expr)) |
| 461 | (setq defunits (math-get-default-units expr)) | 463 | (if (equal defunits "1") |
| 462 | (setq new-units | 464 | (progn |
| 463 | (read-string (concat | 465 | (calc-enter-result 1 "cvun" (math-simplify-units expr)) |
| 464 | (if uoldname | 466 | (message "All units in expression cancel")) |
| 465 | (concat "Old units: " | 467 | (unless new-units |
| 466 | uoldname | 468 | (setq new-units |
| 467 | ", new units") | 469 | (read-string (concat |
| 468 | "New units") | 470 | (if uoldname |
| 469 | (if defunits | 471 | (concat "Old units: " |
| 470 | (concat | 472 | uoldname |
| 471 | " (default " | 473 | ", new units") |
| 472 | defunits | 474 | "New units") |
| 473 | "): ") | 475 | (if defunits |
| 474 | ": ")))) | 476 | (concat |
| 475 | 477 | " (default " | |
| 476 | (if (and | 478 | defunits |
| 477 | (string= new-units "") | 479 | "): ") |
| 478 | defunits) | 480 | ": ")))) |
| 479 | (setq new-units defunits))) | 481 | (if (and |
| 480 | (when (string-match "\\` */" new-units) | 482 | (string= new-units "") |
| 481 | (setq new-units (concat "1" new-units))) | 483 | defunits) |
| 482 | (setq units (math-read-expr new-units)) | 484 | (setq new-units defunits))) |
| 483 | (when (eq (car-safe units) 'error) | 485 | (when (string-match "\\` */" new-units) |
| 484 | (error "Bad format in units expression: %s" (nth 2 units))) | 486 | (setq new-units (concat "1" new-units))) |
| 485 | (if calc-ensure-consistent-units | 487 | (setq units (math-read-expr new-units)) |
| 486 | (math-check-unit-consistency expr units)) | 488 | (when (eq (car-safe units) 'error) |
| 487 | (math-put-default-units units) | 489 | (error "Bad format in units expression: %s" (nth 2 units))) |
| 488 | (let ((unew (math-units-in-expr-p units t)) | 490 | (if calc-ensure-consistent-units |
| 489 | (std (and (eq (car-safe units) 'var) | 491 | (math-check-unit-consistency expr units)) |
| 490 | (assq (nth 1 units) math-standard-units-systems)))) | 492 | (let ((unew (math-units-in-expr-p units t)) |
| 491 | (if std | 493 | (std (and (eq (car-safe units) 'var) |
| 492 | (calc-enter-result 1 "cvun" (math-simplify-units | 494 | (assq (nth 1 units) math-standard-units-systems))) |
| 493 | (math-to-standard-units expr | 495 | (comp (eq (car-safe units) '+))) |
| 494 | (nth 1 std)))) | 496 | (unless (or unew std) |
| 495 | (unless unew | ||
| 496 | (error "No units specified")) | 497 | (error "No units specified")) |
| 497 | (calc-enter-result 1 "cvun" | 498 | (let ((res |
| 498 | (math-convert-units | 499 | (if std |
| 499 | expr units | 500 | (math-simplify-units (math-to-standard-units expr (nth 1 std))) |
| 500 | (and uoldname (not (equal uoldname "1")))))))))) | 501 | (math-convert-units expr units (and uoldname (not (equal uoldname "1"))))))) |
| 502 | (math-put-default-units res (if comp units)) | ||
| 503 | (calc-enter-result 1 "cvun" res))))))) | ||
| 501 | 504 | ||
| 502 | (defun calc-autorange-units (arg) | 505 | (defun calc-autorange-units (arg) |
| 503 | (interactive "P") | 506 | (interactive "P") |