;; Calculator for GNU Emacs, part II [calc-units.el]
-;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc.
+;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Written by Dave Gillespie, daveg@synaptics.com.
;; This file is part of GNU Emacs.
(let ((calc-autorange-units nil))
(calc-enter-result 1 "bsun" (math-simplify-units
(math-to-standard-units (calc-top-n 1)
- nil)))))
-)
+ nil))))))
(defun calc-quick-units ()
(interactive)
(math-convert-units expr (nth pos units)))
(calc-enter-result 1 (format "*un%d" num)
(math-simplify-units
- (math-mul expr (nth pos units)))))))
-)
+ (math-mul expr (nth pos units))))))))
(defun calc-convert-units (&optional old-units new-units)
(interactive)
(calc-enter-result 1 "cvun"
(math-convert-units
expr units
- (and uoldname (not (equal uoldname "1")))))))))
-)
+ (and uoldname (not (equal uoldname "1"))))))))))
(defun calc-autorange-units (arg)
(interactive "P")
(calc-change-mode 'calc-autorange-units arg nil t)
(message (if calc-autorange-units
"Adjusting target unit prefix automatically."
- "Using target units exactly.")))
-)
+ "Using target units exactly."))))
(defun calc-convert-temperature (&optional old-units new-units)
(interactive)
(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)))))
-)
+ uoldname))))))
(defun calc-remove-units ()
(interactive)
(calc-slow-wrapper
(calc-enter-result 1 "rmun" (math-simplify-units
- (math-remove-units (calc-top-n 1)))))
-)
+ (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)))))
-)
+ (math-extract-units (calc-top-n 1))))))
(defun calc-explain-units ()
(interactive)
(message "%s" num-units))
(if den-units
(message "1 per %s" den-units)
- (message "No units in expression")))))
-)
+ (message "No units in expression"))))))
(defun calc-explain-units-rec (expr pow)
(let ((u (math-check-unit-name expr))
((and (eq (car-safe expr) '^)
(math-realp (nth 2 expr)))
(calc-explain-units-rec (nth 1 expr)
- (math-mul pow (nth 2 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)))))
-)
+ (calc-enter-result 1 "smun" (math-simplify-units (calc-top-n 1))))))
(defun calc-view-units-table (n)
(interactive "P")
(select-window win)
(switch-to-buffer nil)
(select-window curwin)))
- (math-build-units-table-buffer nil)))
-)
+ (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."))
-)
+ (message (substitute-command-keys "Type \\[calc] to return to the Calculator.")))
(defun calc-define-unit (uname desc)
(interactive "SDefine unit name: \nsDescription: ")
(math-format-flat-expr form 0)))
(setcar (cdr (cdr unit)) (and (not (equal desc ""))
desc))))
- (calc-invalidate-units-table)
-)
+ (calc-invalidate-units-table))
(defun calc-undefine-unit (uname)
(interactive "SUndefine unit name: ")
(error "Unit name \"%s\" not found" uname)))
(setq math-additional-units (delq unit math-additional-units)
math-units-table nil)))
- (calc-invalidate-units-table)
-)
+ (calc-invalidate-units-table))
(defun calc-invalidate-units-table ()
(setq math-units-table nil)
(goto-char (point-min))
(if (looking-at "Calculator Units Table")
(let ((buffer-read-only nil))
- (insert "(Obsolete) ")))))))
-)
+ (insert "(Obsolete) "))))))))
(defun calc-get-unit-definition (uname)
(interactive "SGet definition for unit: ")
(intern
(concat "var-"
(symbol-name uname)))))
- (message "Base unit: %s" msg)))))
-)
+ (message "Base unit: %s" msg))))))
(defun calc-permanent-units ()
(interactive)
(insert "))\n"))
(insert ";;; (no custom units defined)\n"))
(insert ";;; End of custom units\n")
- (save-buffer)))
-)
+ (save-buffer))))
(let ((math-units-table tab))
(mapcar 'math-find-base-units tab))
(message "Building units table...done")
- (setq math-units-table tab)))
-)
+ (setq math-units-table tab))))
(defun math-find-base-units (entry)
(if (eq (nth 4 entry) 'boom)
(setq b (cdr b)))))
(setq base (sort base 'math-compare-unit-names))
(setcar (nthcdr 4 entry) base)
- base))
-)
+ base)))
(defun math-compare-unit-names (a b)
- (memq (car b) (cdr (memq (car a) unit-list)))
-)
+ (memq (car b) (cdr (memq (car a) unit-list))))
(defun math-find-base-units-rec (expr pow)
(let ((u (math-check-unit-name expr)))
(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)))))
-)
+ (t (error "Malformed defining expression for unit %s" (car entry))))))
(defun math-units-in-expr-p (expr sub-exprs)
(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)))))
-)
+ (math-units-in-expr-p (nth 2 expr) sub-exprs))))))
(defun math-only-units-in-expr-p (expr)
(and (consp 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)))))))
-)
+ (math-realp (nth 2 expr))))))))
(defun math-single-units-in-expr-p (expr)
(cond ((math-scalarp expr) nil)
(if (math-units-in-expr-p (nth 2 expr) nil)
'wrong
(math-single-units-in-expr-p (nth 1 expr))))
- (t 'wrong))
-)
+ (t 'wrong)))
(defun math-check-unit-name (v)
(and (eq (car-safe v) 'var)
(eq (aref name 1) ?e)
(eq (aref name 2) ?g)
(assq (intern (substring name 3))
- math-units-table)))))))
-)
+ math-units-table))))))))
(defun math-to-standard-units (expr which-standard)
- (math-to-standard-rec expr)
-)
+ (math-to-standard-rec expr))
(defun math-to-standard-rec (expr)
(if (eq (car-safe expr) 'var)
(if (Math-primp expr)
expr
(cons (car expr)
- (mapcar 'math-to-standard-rec (cdr expr)))))
-)
+ (mapcar 'math-to-standard-rec (cdr expr))))))
(defun math-apply-units (expr units ulist &optional pure)
(if ulist
(car (car ulist)))))
(math-simplify-units (if pure
expr
- (list '* expr units))))
-)
+ (list '* expr units)))))
(defun math-decompose-units (units)
(let ((u (math-check-unit-name units)))
(lambda (x y)
(not (Math-lessp (nth 1 x)
(nth 1 y))))))))))
- (cdr math-decompose-units-cache)))
-)
+ (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))
-)
+ t)))
(defun math-find-compatible-unit (expr unit)
(let ((u (math-check-unit-name unit)))
(if u
- (math-find-compatible-unit-rec expr 1)))
-)
+ (math-find-compatible-unit-rec expr 1))))
(defun math-find-compatible-unit-rec (expr pow)
(cond ((eq (car-safe expr) '*)
(t
(let ((u2 (math-check-unit-name expr)))
(if (equal (nth 4 u) (nth 4 u2))
- (cons expr pow)))))
-)
+ (cons expr pow))))))
(defun math-convert-units (expr new-units &optional pure)
(math-with-extra-prec 2
(math-convert-units-rec expr)
(math-apply-units (math-to-standard-units
(list '/ expr new-units) nil)
- new-units unit-list pure)))))
-)
+ new-units unit-list pure))))))
(defun math-convert-units-rec (expr)
(if (math-units-in-expr-p expr nil)
(if (Math-primp expr)
expr
(cons (car expr)
- (mapcar 'math-convert-units-rec (cdr 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))
(setq expr (list '+ expr '(float 27315 -2)))))))
(if pure
expr
- (list '* expr new)))
-)
+ (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-simplify a)))
+(defalias calcFunc-usimplify 'math-simplify-units)
(math-defsimplify (+ -)
(and math-simplifying-units
expr)
(list '* (math-add (math-remove-units (nth 1 expr))
(if (eq (car expr) '-) (math-neg ratio) ratio))
- units))))
-)
+ units)))))
(math-defsimplify *
- (math-simplify-units-prod)
-)
+ (math-simplify-units-prod))
(defun math-simplify-units-prod ()
(and math-simplifying-units
(calcFunc-scf (nth 1 expr)
(- uxpon pxpon))))
(setcar unitp pname)
- expr))))))
-)
+ expr)))))))
(math-defsimplify /
(and math-simplifying-units
(setq expr base))))
(if (eq (car-safe expr) '/)
(math-simplify-units-prod))
- expr))
-)
+ expr)))
(defun math-simplify-units-divisor (np dp)
(let ((n (car np))
(if (setq temp (math-simplify-units-quotient n d))
(progn
(setcar np (setq n temp))
- (setcar dp 1))))
-)
+ (setcar dp 1)))))
;; Simplify, e.g., "in / cm" to "2.54" in a units expression.
(defun math-simplify-units-quotient (n d)
(* (cdr (car ud)) pow2)))))
(setq ud1 (cdr ud1)))
(setq un (cdr un)))
- nil)))))
-)
+ nil))))))
(math-defsimplify ^
(and math-simplifying-units
(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-simplify-units-pow (nth 1 expr) (nth 2 expr)))))
(math-defsimplify calcFunc-sqrt
(and math-simplifying-units
(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-simplify-units-pow (nth 1 expr) '(frac 1 2)))))
(math-defsimplify (calcFunc-floor
calcFunc-ceil
(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))))
-)
+ (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)
-)
+ (null u))
(math-defsimplify calcFunc-sin
(and math-simplifying-units
(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)))))
-)
+ (list 'calcFunc-sin (nth 1 rad))))))
(math-defsimplify calcFunc-cos
(and math-simplifying-units
(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)))))
-)
+ (list 'calcFunc-cos (nth 1 rad))))))
(math-defsimplify calcFunc-tan
(and math-simplifying-units
(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)))))
-)
+ (list 'calcFunc-tan (nth 1 rad))))))
(defun math-remove-units (expr)
(if (Math-primp expr)
expr
(cons (car expr)
- (mapcar 'math-remove-units (cdr 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))
-)
+ (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
(display-buffer buf)))
(if enter-buffer
(pop-to-buffer (get-buffer "*Units Table*"))
- (display-buffer (get-buffer "*Units Table*"))))
-)
-
-
-
+ (display-buffer (get-buffer "*Units Table*")))))
+;;; calc-units.el ends here