aboutsummaryrefslogtreecommitdiffstats
path: root/lisp
diff options
context:
space:
mode:
authorJay Belanger2012-08-11 23:32:28 -0500
committerJay Belanger2012-08-11 23:32:28 -0500
commit0fd0912879f70f410cd336e538d8c515508126c7 (patch)
tree445a6ded9606f9404bb269851b570c700735d94a /lisp
parent38a414f0f1a5f658f8b9fa6c8914d468e9394586 (diff)
downloademacs-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/ChangeLog9
-rw-r--r--lisp/calc/calc-units.el117
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 @@
12012-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
12012-08-11 Glenn Morris <rgm@gnu.org> 102012-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))) 423If 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")