/[emacs]/emacs/lisp/calc/calc-units.el
ViewVC logotype

Diff of /emacs/lisp/calc/calc-units.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by eliz, Tue Nov 6 18:59:06 2001 UTC revision 1.2 by walters, Wed Nov 14 09:08:03 2001 UTC
# Line 1  Line 1 
1  ;; Calculator for GNU Emacs, part II [calc-units.el]  ;; Calculator for GNU Emacs, part II [calc-units.el]
2  ;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc.  ;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
3  ;; Written by Dave Gillespie, daveg@synaptics.com.  ;; Written by Dave Gillespie, daveg@synaptics.com.
4    
5  ;; This file is part of GNU Emacs.  ;; This file is part of GNU Emacs.
# Line 37  Line 37 
37     (let ((calc-autorange-units nil))     (let ((calc-autorange-units nil))
38       (calc-enter-result 1 "bsun" (math-simplify-units       (calc-enter-result 1 "bsun" (math-simplify-units
39                                    (math-to-standard-units (calc-top-n 1)                                    (math-to-standard-units (calc-top-n 1)
40                                                            nil)))))                                                            nil))))))
 )  
41    
42  (defun calc-quick-units ()  (defun calc-quick-units ()
43    (interactive)    (interactive)
# Line 58  Line 57 
57                              (math-convert-units expr (nth pos units)))                              (math-convert-units expr (nth pos units)))
58         (calc-enter-result 1 (format "*un%d" num)         (calc-enter-result 1 (format "*un%d" num)
59                            (math-simplify-units                            (math-simplify-units
60                             (math-mul expr (nth pos units)))))))                             (math-mul expr (nth pos units))))))))
 )  
61    
62  (defun calc-convert-units (&optional old-units new-units)  (defun calc-convert-units (&optional old-units new-units)
63    (interactive)    (interactive)
# Line 104  Line 102 
102           (calc-enter-result 1 "cvun"           (calc-enter-result 1 "cvun"
103                              (math-convert-units                              (math-convert-units
104                               expr units                               expr units
105                               (and uoldname (not (equal uoldname "1")))))))))                               (and uoldname (not (equal uoldname "1"))))))))))
 )  
106    
107  (defun calc-autorange-units (arg)  (defun calc-autorange-units (arg)
108    (interactive "P")    (interactive "P")
# Line 113  Line 110 
110     (calc-change-mode 'calc-autorange-units arg nil t)     (calc-change-mode 'calc-autorange-units arg nil t)
111     (message (if calc-autorange-units     (message (if calc-autorange-units
112                  "Adjusting target unit prefix automatically."                  "Adjusting target unit prefix automatically."
113                "Using target units exactly.")))                "Using target units exactly."))))
 )  
114    
115  (defun calc-convert-temperature (&optional old-units new-units)  (defun calc-convert-temperature (&optional old-units new-units)
116    (interactive)    (interactive)
# Line 150  Line 146 
146           (error "Bad format in units expression: %s" (nth 2 unew)))           (error "Bad format in units expression: %s" (nth 2 unew)))
147       (calc-enter-result 1 "cvtm" (math-simplify-units       (calc-enter-result 1 "cvtm" (math-simplify-units
148                                    (math-convert-temperature expr uold unew                                    (math-convert-temperature expr uold unew
149                                                              uoldname)))))                                                              uoldname))))))
 )  
150    
151  (defun calc-remove-units ()  (defun calc-remove-units ()
152    (interactive)    (interactive)
153    (calc-slow-wrapper    (calc-slow-wrapper
154     (calc-enter-result 1 "rmun" (math-simplify-units     (calc-enter-result 1 "rmun" (math-simplify-units
155                                  (math-remove-units (calc-top-n 1)))))                                  (math-remove-units (calc-top-n 1))))))
 )  
156    
157  (defun calc-extract-units ()  (defun calc-extract-units ()
158    (interactive)    (interactive)
159    (calc-slow-wrapper    (calc-slow-wrapper
160     (calc-enter-result 1 "rmun" (math-simplify-units     (calc-enter-result 1 "rmun" (math-simplify-units
161                                  (math-extract-units (calc-top-n 1)))))                                  (math-extract-units (calc-top-n 1))))))
 )  
162    
163  (defun calc-explain-units ()  (defun calc-explain-units ()
164    (interactive)    (interactive)
# Line 181  Line 174 
174             (message "%s" num-units))             (message "%s" num-units))
175         (if den-units         (if den-units
176             (message "1 per %s" den-units)             (message "1 per %s" den-units)
177           (message "No units in expression")))))           (message "No units in expression"))))))
 )  
178    
179  (defun calc-explain-units-rec (expr pow)  (defun calc-explain-units-rec (expr pow)
180    (let ((u (math-check-unit-name expr))    (let ((u (math-check-unit-name expr))
# Line 239  Line 231 
231              ((and (eq (car-safe expr) '^)              ((and (eq (car-safe expr) '^)
232                    (math-realp (nth 2 expr)))                    (math-realp (nth 2 expr)))
233               (calc-explain-units-rec (nth 1 expr)               (calc-explain-units-rec (nth 1 expr)
234                                       (math-mul pow (nth 2 expr)))))))                                       (math-mul pow (nth 2 expr))))))))
 )  
235    
236  (defun calc-simplify-units ()  (defun calc-simplify-units ()
237    (interactive)    (interactive)
238    (calc-slow-wrapper    (calc-slow-wrapper
239     (calc-with-default-simplification     (calc-with-default-simplification
240      (calc-enter-result 1 "smun" (math-simplify-units (calc-top-n 1)))))      (calc-enter-result 1 "smun" (math-simplify-units (calc-top-n 1))))))
 )  
241    
242  (defun calc-view-units-table (n)  (defun calc-view-units-table (n)
243    (interactive "P")    (interactive "P")
# Line 262  Line 252 
252              (select-window win)              (select-window win)
253              (switch-to-buffer nil)              (switch-to-buffer nil)
254              (select-window curwin)))              (select-window curwin)))
255        (math-build-units-table-buffer nil)))        (math-build-units-table-buffer nil))))
 )  
256    
257  (defun calc-enter-units-table (n)  (defun calc-enter-units-table (n)
258    (interactive "P")    (interactive "P")
259    (and n (setq math-units-table-buffer-valid nil))    (and n (setq math-units-table-buffer-valid nil))
260    (math-build-units-table-buffer t)    (math-build-units-table-buffer t)
261    (message (substitute-command-keys "Type \\[calc] to return to the Calculator."))    (message (substitute-command-keys "Type \\[calc] to return to the Calculator.")))
 )  
262    
263  (defun calc-define-unit (uname desc)  (defun calc-define-unit (uname desc)
264    (interactive "SDefine unit name: \nsDescription: ")    (interactive "SDefine unit name: \nsDescription: ")
# Line 288  Line 276 
276                               (math-format-flat-expr form 0)))                               (math-format-flat-expr form 0)))
277       (setcar (cdr (cdr unit)) (and (not (equal desc ""))       (setcar (cdr (cdr unit)) (and (not (equal desc ""))
278                                     desc))))                                     desc))))
279    (calc-invalidate-units-table)    (calc-invalidate-units-table))
 )  
280    
281  (defun calc-undefine-unit (uname)  (defun calc-undefine-unit (uname)
282    (interactive "SUndefine unit name: ")    (interactive "SUndefine unit name: ")
# Line 301  Line 288 
288             (error "Unit name \"%s\" not found" uname)))             (error "Unit name \"%s\" not found" uname)))
289       (setq math-additional-units (delq unit math-additional-units)       (setq math-additional-units (delq unit math-additional-units)
290             math-units-table nil)))             math-units-table nil)))
291    (calc-invalidate-units-table)    (calc-invalidate-units-table))
 )  
292    
293  (defun calc-invalidate-units-table ()  (defun calc-invalidate-units-table ()
294    (setq math-units-table nil)    (setq math-units-table nil)
# Line 314  Line 300 
300               (goto-char (point-min))               (goto-char (point-min))
301               (if (looking-at "Calculator Units Table")               (if (looking-at "Calculator Units Table")
302                   (let ((buffer-read-only nil))                   (let ((buffer-read-only nil))
303                     (insert "(Obsolete) ")))))))                     (insert "(Obsolete) "))))))))
 )  
304    
305  (defun calc-get-unit-definition (uname)  (defun calc-get-unit-definition (uname)
306    (interactive "SGet definition for unit: ")    (interactive "SGet definition for unit: ")
# Line 337  Line 322 
322                                             (intern                                             (intern
323                                              (concat "var-"                                              (concat "var-"
324                                                      (symbol-name uname)))))                                                      (symbol-name uname)))))
325           (message "Base unit: %s" msg)))))           (message "Base unit: %s" msg))))))
 )  
326    
327  (defun calc-permanent-units ()  (defun calc-permanent-units ()
328    (interactive)    (interactive)
# Line 379  Line 363 
363             (insert "))\n"))             (insert "))\n"))
364         (insert ";;; (no custom units defined)\n"))         (insert ";;; (no custom units defined)\n"))
365       (insert ";;; End of custom units\n")       (insert ";;; End of custom units\n")
366       (save-buffer)))       (save-buffer))))
 )  
367    
368    
369    
# Line 658  Entries are (SYMBOL EXPR DOC-STRING TEMP Line 641  Entries are (SYMBOL EXPR DOC-STRING TEMP
641          (let ((math-units-table tab))          (let ((math-units-table tab))
642            (mapcar 'math-find-base-units tab))            (mapcar 'math-find-base-units tab))
643          (message "Building units table...done")          (message "Building units table...done")
644          (setq math-units-table tab)))          (setq math-units-table tab))))
 )  
645    
646  (defun math-find-base-units (entry)  (defun math-find-base-units (entry)
647    (if (eq (nth 4 entry) 'boom)    (if (eq (nth 4 entry) 'boom)
# Line 679  Entries are (SYMBOL EXPR DOC-STRING TEMP Line 661  Entries are (SYMBOL EXPR DOC-STRING TEMP
661                (setq b (cdr b)))))                (setq b (cdr b)))))
662          (setq base (sort base 'math-compare-unit-names))          (setq base (sort base 'math-compare-unit-names))
663          (setcar (nthcdr 4 entry) base)          (setcar (nthcdr 4 entry) base)
664          base))          base)))
 )  
665    
666  (defun math-compare-unit-names (a b)  (defun math-compare-unit-names (a b)
667    (memq (car b) (cdr (memq (car a) unit-list)))    (memq (car b) (cdr (memq (car a) unit-list))))
 )  
668    
669  (defun math-find-base-units-rec (expr pow)  (defun math-find-base-units-rec (expr pow)
670    (let ((u (math-check-unit-name expr)))    (let ((u (math-check-unit-name expr)))
# Line 715  Entries are (SYMBOL EXPR DOC-STRING TEMP Line 695  Entries are (SYMBOL EXPR DOC-STRING TEMP
695             (or (eq (nth 1 expr) 'pi)             (or (eq (nth 1 expr) 'pi)
696                 (error "Unknown name %s in defining expression for unit %s"                 (error "Unknown name %s in defining expression for unit %s"
697                        (nth 1 expr) (car entry))))                        (nth 1 expr) (car entry))))
698            (t (error "Malformed defining expression for unit %s" (car entry)))))            (t (error "Malformed defining expression for unit %s" (car entry))))))
 )  
699    
700    
701  (defun math-units-in-expr-p (expr sub-exprs)  (defun math-units-in-expr-p (expr sub-exprs)
# Line 726  Entries are (SYMBOL EXPR DOC-STRING TEMP Line 705  Entries are (SYMBOL EXPR DOC-STRING TEMP
705           (and (or sub-exprs           (and (or sub-exprs
706                    (memq (car expr) '(* / ^)))                    (memq (car expr) '(* / ^)))
707                (or (math-units-in-expr-p (nth 1 expr) sub-exprs)                (or (math-units-in-expr-p (nth 1 expr) sub-exprs)
708                    (math-units-in-expr-p (nth 2 expr) sub-exprs)))))                    (math-units-in-expr-p (nth 2 expr) sub-exprs))))))
 )  
709    
710  (defun math-only-units-in-expr-p (expr)  (defun math-only-units-in-expr-p (expr)
711    (and (consp expr)    (and (consp expr)
# Line 738  Entries are (SYMBOL EXPR DOC-STRING TEMP Line 716  Entries are (SYMBOL EXPR DOC-STRING TEMP
716                    (math-only-units-in-expr-p (nth 2 expr)))                    (math-only-units-in-expr-p (nth 2 expr)))
717             (and (eq (car expr) '^)             (and (eq (car expr) '^)
718                  (and (math-only-units-in-expr-p (nth 1 expr))                  (and (math-only-units-in-expr-p (nth 1 expr))
719                       (math-realp (nth 2 expr)))))))                       (math-realp (nth 2 expr))))))))
 )  
720    
721  (defun math-single-units-in-expr-p (expr)  (defun math-single-units-in-expr-p (expr)
722    (cond ((math-scalarp expr) nil)    (cond ((math-scalarp expr) nil)
# Line 755  Entries are (SYMBOL EXPR DOC-STRING TEMP Line 732  Entries are (SYMBOL EXPR DOC-STRING TEMP
732           (if (math-units-in-expr-p (nth 2 expr) nil)           (if (math-units-in-expr-p (nth 2 expr) nil)
733               'wrong               'wrong
734             (math-single-units-in-expr-p (nth 1 expr))))             (math-single-units-in-expr-p (nth 1 expr))))
735          (t 'wrong))          (t 'wrong)))
 )  
736    
737  (defun math-check-unit-name (v)  (defun math-check-unit-name (v)
738    (and (eq (car-safe v) 'var)    (and (eq (car-safe v) 'var)
# Line 770  Entries are (SYMBOL EXPR DOC-STRING TEMP Line 746  Entries are (SYMBOL EXPR DOC-STRING TEMP
746                             (eq (aref name 1) ?e)                             (eq (aref name 1) ?e)
747                             (eq (aref name 2) ?g)                             (eq (aref name 2) ?g)
748                             (assq (intern (substring name 3))                             (assq (intern (substring name 3))
749                                   math-units-table)))))))                                   math-units-table))))))))
 )  
750    
751    
752  (defun math-to-standard-units (expr which-standard)  (defun math-to-standard-units (expr which-standard)
753    (math-to-standard-rec expr)    (math-to-standard-rec expr))
 )  
754    
755  (defun math-to-standard-rec (expr)  (defun math-to-standard-rec (expr)
756    (if (eq (car-safe expr) 'var)    (if (eq (car-safe expr) 'var)
# Line 806  Entries are (SYMBOL EXPR DOC-STRING TEMP Line 780  Entries are (SYMBOL EXPR DOC-STRING TEMP
780      (if (Math-primp expr)      (if (Math-primp expr)
781          expr          expr
782        (cons (car expr)        (cons (car expr)
783              (mapcar 'math-to-standard-rec (cdr expr)))))              (mapcar 'math-to-standard-rec (cdr expr))))))
 )  
784    
785  (defun math-apply-units (expr units ulist &optional pure)  (defun math-apply-units (expr units ulist &optional pure)
786    (if ulist    (if ulist
# Line 828  Entries are (SYMBOL EXPR DOC-STRING TEMP Line 801  Entries are (SYMBOL EXPR DOC-STRING TEMP
801                                  (car (car ulist)))))                                  (car (car ulist)))))
802      (math-simplify-units (if pure      (math-simplify-units (if pure
803                               expr                               expr
804                             (list '* expr units))))                             (list '* expr units)))))
 )  
805    
806  (defun math-decompose-units (units)  (defun math-decompose-units (units)
807    (let ((u (math-check-unit-name units)))    (let ((u (math-check-unit-name units)))
# Line 858  Entries are (SYMBOL EXPR DOC-STRING TEMP Line 830  Entries are (SYMBOL EXPR DOC-STRING TEMP
830                                    (lambda (x y)                                    (lambda (x y)
831                                      (not (Math-lessp (nth 1 x)                                      (not (Math-lessp (nth 1 x)
832                                                       (nth 1 y))))))))))                                                       (nth 1 y))))))))))
833           (cdr math-decompose-units-cache)))           (cdr math-decompose-units-cache))))
 )  
834  (setq math-decompose-units-cache nil)  (setq math-decompose-units-cache nil)
835    
836  (defun math-decompose-unit-part (unit)  (defun math-decompose-unit-part (unit)
837    (cons unit    (cons unit
838          (math-is-multiple (math-simplify-units (math-to-standard-units          (math-is-multiple (math-simplify-units (math-to-standard-units
839                                                  unit nil))                                                  unit nil))
840                            t))                            t)))
 )  
841    
842  (defun math-find-compatible-unit (expr unit)  (defun math-find-compatible-unit (expr unit)
843    (let ((u (math-check-unit-name unit)))    (let ((u (math-check-unit-name unit)))
844      (if u      (if u
845          (math-find-compatible-unit-rec expr 1)))          (math-find-compatible-unit-rec expr 1))))
 )  
846    
847  (defun math-find-compatible-unit-rec (expr pow)  (defun math-find-compatible-unit-rec (expr pow)
848    (cond ((eq (car-safe expr) '*)    (cond ((eq (car-safe expr) '*)
# Line 888  Entries are (SYMBOL EXPR DOC-STRING TEMP Line 857  Entries are (SYMBOL EXPR DOC-STRING TEMP
857          (t          (t
858           (let ((u2 (math-check-unit-name expr)))           (let ((u2 (math-check-unit-name expr)))
859             (if (equal (nth 4 u) (nth 4 u2))             (if (equal (nth 4 u) (nth 4 u2))
860                 (cons expr pow)))))                 (cons expr pow))))))
 )  
861    
862  (defun math-convert-units (expr new-units &optional pure)  (defun math-convert-units (expr new-units &optional pure)
863    (math-with-extra-prec 2    (math-with-extra-prec 2
# Line 915  Entries are (SYMBOL EXPR DOC-STRING TEMP Line 883  Entries are (SYMBOL EXPR DOC-STRING TEMP
883              (math-convert-units-rec expr)              (math-convert-units-rec expr)
884            (math-apply-units (math-to-standard-units            (math-apply-units (math-to-standard-units
885                               (list '/ expr new-units) nil)                               (list '/ expr new-units) nil)
886                              new-units unit-list pure)))))                              new-units unit-list pure))))))
 )  
887    
888  (defun math-convert-units-rec (expr)  (defun math-convert-units-rec (expr)
889    (if (math-units-in-expr-p expr nil)    (if (math-units-in-expr-p expr nil)
# Line 925  Entries are (SYMBOL EXPR DOC-STRING TEMP Line 892  Entries are (SYMBOL EXPR DOC-STRING TEMP
892      (if (Math-primp expr)      (if (Math-primp expr)
893          expr          expr
894        (cons (car expr)        (cons (car expr)
895              (mapcar 'math-convert-units-rec (cdr expr)))))              (mapcar 'math-convert-units-rec (cdr expr))))))
 )  
896    
897  (defun math-convert-temperature (expr old new &optional pure)  (defun math-convert-temperature (expr old new &optional pure)
898    (let* ((units (math-single-units-in-expr-p expr))    (let* ((units (math-single-units-in-expr-p expr))
# Line 960  Entries are (SYMBOL EXPR DOC-STRING TEMP Line 926  Entries are (SYMBOL EXPR DOC-STRING TEMP
926                     (setq expr (list '+ expr '(float 27315 -2)))))))                     (setq expr (list '+ expr '(float 27315 -2)))))))
927      (if pure      (if pure
928          expr          expr
929        (list '* expr new)))        (list '* expr new))))
 )  
930    
931    
932    
933  (defun math-simplify-units (a)  (defun math-simplify-units (a)
934    (let ((math-simplifying-units t)    (let ((math-simplifying-units t)
935          (calc-matrix-mode 'scalar))          (calc-matrix-mode 'scalar))
936      (math-simplify a))      (math-simplify a)))
937  )  (defalias calcFunc-usimplify 'math-simplify-units)
 (fset 'calcFunc-usimplify (symbol-function 'math-simplify-units))  
938    
939  (math-defsimplify (+ -)  (math-defsimplify (+ -)
940    (and math-simplifying-units    (and math-simplifying-units
# Line 984  Entries are (SYMBOL EXPR DOC-STRING TEMP Line 948  Entries are (SYMBOL EXPR DOC-STRING TEMP
948                 expr)                 expr)
949             (list '* (math-add (math-remove-units (nth 1 expr))             (list '* (math-add (math-remove-units (nth 1 expr))
950                                (if (eq (car expr) '-) (math-neg ratio) ratio))                                (if (eq (car expr) '-) (math-neg ratio) ratio))
951                   units))))                   units)))))
 )  
952    
953  (math-defsimplify *  (math-defsimplify *
954    (math-simplify-units-prod)    (math-simplify-units-prod))
 )  
955    
956  (defun math-simplify-units-prod ()  (defun math-simplify-units-prod ()
957    (and math-simplifying-units    (and math-simplifying-units
# Line 1054  Entries are (SYMBOL EXPR DOC-STRING TEMP Line 1016  Entries are (SYMBOL EXPR DOC-STRING TEMP
1016                                   (calcFunc-scf (nth 1 expr)                                   (calcFunc-scf (nth 1 expr)
1017                                                 (- uxpon pxpon))))                                                 (- uxpon pxpon))))
1018                         (setcar unitp pname)                         (setcar unitp pname)
1019                         expr))))))                         expr)))))))
 )  
1020    
1021  (math-defsimplify /  (math-defsimplify /
1022    (and math-simplifying-units    (and math-simplifying-units
# Line 1082  Entries are (SYMBOL EXPR DOC-STRING TEMP Line 1043  Entries are (SYMBOL EXPR DOC-STRING TEMP
1043                     (setq expr base))))                     (setq expr base))))
1044           (if (eq (car-safe expr) '/)           (if (eq (car-safe expr) '/)
1045               (math-simplify-units-prod))               (math-simplify-units-prod))
1046           expr))           expr)))
 )  
1047    
1048  (defun math-simplify-units-divisor (np dp)  (defun math-simplify-units-divisor (np dp)
1049    (let ((n (car np))    (let ((n (car np))
# Line 1097  Entries are (SYMBOL EXPR DOC-STRING TEMP Line 1057  Entries are (SYMBOL EXPR DOC-STRING TEMP
1057      (if (setq temp (math-simplify-units-quotient n d))      (if (setq temp (math-simplify-units-quotient n d))
1058          (progn          (progn
1059            (setcar np (setq n temp))            (setcar np (setq n temp))
1060            (setcar dp 1))))            (setcar dp 1)))))
 )  
1061    
1062  ;; Simplify, e.g., "in / cm" to "2.54" in a units expression.  ;; Simplify, e.g., "in / cm" to "2.54" in a units expression.
1063  (defun math-simplify-units-quotient (n d)  (defun math-simplify-units-quotient (n d)
# Line 1129  Entries are (SYMBOL EXPR DOC-STRING TEMP Line 1088  Entries are (SYMBOL EXPR DOC-STRING TEMP
1088                                      (* (cdr (car ud)) pow2)))))                                      (* (cdr (car ud)) pow2)))))
1089                     (setq ud1 (cdr ud1)))                     (setq ud1 (cdr ud1)))
1090                   (setq un (cdr un)))                   (setq un (cdr un)))
1091                 nil)))))                 nil))))))
 )  
1092    
1093  (math-defsimplify ^  (math-defsimplify ^
1094    (and math-simplifying-units    (and math-simplifying-units
# Line 1139  Entries are (SYMBOL EXPR DOC-STRING TEMP Line 1097  Entries are (SYMBOL EXPR DOC-STRING TEMP
1097             (list (car (nth 1 expr))             (list (car (nth 1 expr))
1098                   (list '^ (nth 1 (nth 1 expr)) (nth 2 expr))                   (list '^ (nth 1 (nth 1 expr)) (nth 2 expr))
1099                   (list '^ (nth 2 (nth 1 expr)) (nth 2 expr)))                   (list '^ (nth 2 (nth 1 expr)) (nth 2 expr)))
1100           (math-simplify-units-pow (nth 1 expr) (nth 2 expr))))           (math-simplify-units-pow (nth 1 expr) (nth 2 expr)))))
 )  
1101    
1102  (math-defsimplify calcFunc-sqrt  (math-defsimplify calcFunc-sqrt
1103    (and math-simplifying-units    (and math-simplifying-units
# Line 1148  Entries are (SYMBOL EXPR DOC-STRING TEMP Line 1105  Entries are (SYMBOL EXPR DOC-STRING TEMP
1105             (list (car (nth 1 expr))             (list (car (nth 1 expr))
1106                   (list 'calcFunc-sqrt (nth 1 (nth 1 expr)))                   (list 'calcFunc-sqrt (nth 1 (nth 1 expr)))
1107                   (list 'calcFunc-sqrt (nth 2 (nth 1 expr))))                   (list 'calcFunc-sqrt (nth 2 (nth 1 expr))))
1108           (math-simplify-units-pow (nth 1 expr) '(frac 1 2))))           (math-simplify-units-pow (nth 1 expr) '(frac 1 2)))))
 )  
1109    
1110  (math-defsimplify (calcFunc-floor  (math-defsimplify (calcFunc-floor
1111                     calcFunc-ceil                     calcFunc-ceil
# Line 1188  Entries are (SYMBOL EXPR DOC-STRING TEMP Line 1144  Entries are (SYMBOL EXPR DOC-STRING TEMP
1144             (d (and (eq (car-safe pf) 'frac) (nth 2 pf))))             (d (and (eq (car-safe pf) 'frac) (nth 2 pf))))
1145        (and u d        (and u d
1146             (math-units-are-multiple u d)             (math-units-are-multiple u d)
1147             (list '^ (math-to-standard-units a nil) pow))))             (list '^ (math-to-standard-units a nil) pow)))))
 )  
1148    
1149    
1150  (defun math-units-are-multiple (u n)  (defun math-units-are-multiple (u n)
1151    (setq u (nth 4 u))    (setq u (nth 4 u))
1152    (while (and u (= (% (cdr (car u)) n) 0))    (while (and u (= (% (cdr (car u)) n) 0))
1153      (setq u (cdr u)))      (setq u (cdr u)))
1154    (null u)    (null u))
 )  
1155    
1156  (math-defsimplify calcFunc-sin  (math-defsimplify calcFunc-sin
1157    (and math-simplifying-units    (and math-simplifying-units
# Line 1210  Entries are (SYMBOL EXPR DOC-STRING TEMP Line 1164  Entries are (SYMBOL EXPR DOC-STRING TEMP
1164                (math-realp (nth 1 rad))                (math-realp (nth 1 rad))
1165                (eq (car-safe (nth 2 rad)) 'var)                (eq (car-safe (nth 2 rad)) 'var)
1166                (eq (nth 1 (nth 2 rad)) 'rad)                (eq (nth 1 (nth 2 rad)) 'rad)
1167                (list 'calcFunc-sin (nth 1 rad)))))                (list 'calcFunc-sin (nth 1 rad))))))
 )  
1168    
1169  (math-defsimplify calcFunc-cos  (math-defsimplify calcFunc-cos
1170    (and math-simplifying-units    (and math-simplifying-units
# Line 1224  Entries are (SYMBOL EXPR DOC-STRING TEMP Line 1177  Entries are (SYMBOL EXPR DOC-STRING TEMP
1177                (math-realp (nth 1 rad))                (math-realp (nth 1 rad))
1178                (eq (car-safe (nth 2 rad)) 'var)                (eq (car-safe (nth 2 rad)) 'var)
1179                (eq (nth 1 (nth 2 rad)) 'rad)                (eq (nth 1 (nth 2 rad)) 'rad)
1180                (list 'calcFunc-cos (nth 1 rad)))))                (list 'calcFunc-cos (nth 1 rad))))))
 )  
1181    
1182  (math-defsimplify calcFunc-tan  (math-defsimplify calcFunc-tan
1183    (and math-simplifying-units    (and math-simplifying-units
# Line 1238  Entries are (SYMBOL EXPR DOC-STRING TEMP Line 1190  Entries are (SYMBOL EXPR DOC-STRING TEMP
1190                (math-realp (nth 1 rad))                (math-realp (nth 1 rad))
1191                (eq (car-safe (nth 2 rad)) 'var)                (eq (car-safe (nth 2 rad)) 'var)
1192                (eq (nth 1 (nth 2 rad)) 'rad)                (eq (nth 1 (nth 2 rad)) 'rad)
1193                (list 'calcFunc-tan (nth 1 rad)))))                (list 'calcFunc-tan (nth 1 rad))))))
 )  
1194    
1195    
1196  (defun math-remove-units (expr)  (defun math-remove-units (expr)
# Line 1248  Entries are (SYMBOL EXPR DOC-STRING TEMP Line 1199  Entries are (SYMBOL EXPR DOC-STRING TEMP
1199      (if (Math-primp expr)      (if (Math-primp expr)
1200          expr          expr
1201        (cons (car expr)        (cons (car expr)
1202              (mapcar 'math-remove-units (cdr expr)))))              (mapcar 'math-remove-units (cdr expr))))))
 )  
1203    
1204  (defun math-extract-units (expr)  (defun math-extract-units (expr)
1205    (if (memq (car-safe expr) '(* /))    (if (memq (car-safe expr) '(* /))
1206        (cons (car expr)        (cons (car expr)
1207              (mapcar 'math-extract-units (cdr expr)))              (mapcar 'math-extract-units (cdr expr)))
1208      (if (math-check-unit-name expr) expr 1))      (if (math-check-unit-name expr) expr 1)))
 )  
1209    
1210  (defun math-build-units-table-buffer (enter-buffer)  (defun math-build-units-table-buffer (enter-buffer)
1211    (if (not (and math-units-table math-units-table-buffer-valid    (if (not (and math-units-table math-units-table-buffer-valid
# Line 1344  Entries are (SYMBOL EXPR DOC-STRING TEMP Line 1293  Entries are (SYMBOL EXPR DOC-STRING TEMP
1293            (display-buffer buf)))            (display-buffer buf)))
1294      (if enter-buffer      (if enter-buffer
1295          (pop-to-buffer (get-buffer "*Units Table*"))          (pop-to-buffer (get-buffer "*Units Table*"))
1296        (display-buffer (get-buffer "*Units Table*"))))        (display-buffer (get-buffer "*Units Table*")))))
 )  
   
   
   
1297    
1298    ;;; calc-units.el ends here

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26