[Emacs-diffs] Changes to emacs/lisp/calc/calc-units.el [lexbind]

[Miles Bader]

Index: emacs/lisp/calc/calc-units.el
diff -c emacs/lisp/calc/calc-units.el:1.4.2.3 
emacs/lisp/calc/calc-units.el:1.4.2.4
*** emacs/lisp/calc/calc-units.el:1.4.2.3       Wed Oct  6 05:21:53 2004
--- emacs/lisp/calc/calc-units.el       Wed Dec  8 23:31:43 2004
***************
*** 3,10 ****
  ;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
  
  ;; Author: David Gillespie <address@hidden>
! ;; Maintainers: D. Goel <address@hidden>
! ;;              Colin Walters <address@hidden>
  
  ;; This file is part of GNU Emacs.
  
--- 3,9 ----
  ;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
  
  ;; Author: David Gillespie <address@hidden>
! ;; Maintainer: Jay Belanger <address@hidden>
  
  ;; This file is part of GNU Emacs.
  
***************
*** 940,957 ****
      (math-simplify a)))
  (defalias 'calcFunc-usimplify 'math-simplify-units)
  
  (math-defsimplify (+ -)
    (and math-simplifying-units
!        (math-units-in-expr-p (nth 1 expr) nil)
!        (let* ((units (math-extract-units (nth 1 expr)))
              (ratio (math-simplify (math-to-standard-units
!                                    (list '/ (nth 2 expr) units) nil))))
         (if (math-units-in-expr-p ratio nil)
             (progn
!              (calc-record-why "*Inconsistent units" expr)
!              expr)
!          (list '* (math-add (math-remove-units (nth 1 expr))
!                             (if (eq (car expr) '-) (math-neg ratio) ratio))
                 units)))))
  
  (math-defsimplify *
--- 939,961 ----
      (math-simplify a)))
  (defalias 'calcFunc-usimplify 'math-simplify-units)
  
+ ;; The function created by math-defsimplify uses the variable
+ ;; math-simplify-expr, and so is used by functions in math-defsimplify
+ (defvar math-simplify-expr)
+ 
  (math-defsimplify (+ -)
    (and math-simplifying-units
!        (math-units-in-expr-p (nth 1 math-simplify-expr) nil)
!        (let* ((units (math-extract-units (nth 1 math-simplify-expr)))
              (ratio (math-simplify (math-to-standard-units
!                                    (list '/ (nth 2 math-simplify-expr) units) 
nil))))
         (if (math-units-in-expr-p ratio nil)
             (progn
!              (calc-record-why "*Inconsistent units" math-simplify-expr)
!              math-simplify-expr)
!          (list '* (math-add (math-remove-units (nth 1 math-simplify-expr))
!                             (if (eq (car math-simplify-expr) '-) 
!                                   (math-neg ratio) ratio))
                 units)))))
  
  (math-defsimplify *
***************
*** 960,971 ****
  (defun math-simplify-units-prod ()
    (and math-simplifying-units
         calc-autorange-units
!        (Math-realp (nth 1 expr))
!        (let* ((num (math-float (nth 1 expr)))
              (xpon (calcFunc-xpon num))
!             (unitp (cdr (cdr expr)))
              (unit (car unitp))
!             (pow (if (eq (car expr) '*) 1 -1))
              u)
         (and (eq (car-safe unit) '*)
              (setq unitp (cdr unit)
--- 964,975 ----
  (defun math-simplify-units-prod ()
    (and math-simplifying-units
         calc-autorange-units
!        (Math-realp (nth 1 math-simplify-expr))
!        (let* ((num (math-float (nth 1 math-simplify-expr)))
              (xpon (calcFunc-xpon num))
!             (unitp (cdr (cdr math-simplify-expr)))
              (unit (car unitp))
!             (pow (if (eq (car math-simplify-expr) '*) 1 -1))
              u)
         (and (eq (car-safe unit) '*)
              (setq unitp (cdr unit)
***************
*** 1015,1053 ****
                     (or (not (eq p pref))
                         (< xpon (+ pxpon (* (math-abs pow) 3))))
                     (progn
!                      (setcar (cdr expr)
                               (let ((calc-prefer-frac nil))
!                                (calcFunc-scf (nth 1 expr)
                                               (- uxpon pxpon))))
                       (setcar unitp pname)
!                      expr)))))))
  
  (math-defsimplify /
    (and math-simplifying-units
!        (let ((np (cdr expr))
             (try-cancel-units 0)
             n nn)
!        (setq n (if (eq (car-safe (nth 2 expr)) '*)
!                    (cdr (nth 2 expr))
!                  (nthcdr 2 expr)))
         (if (math-realp (car n))
             (progn
!              (setcar (cdr expr) (math-mul (nth 1 expr)
                                            (let ((calc-prefer-frac nil))
                                              (math-div 1 (car n)))))
               (setcar n 1)))
         (while (eq (car-safe (setq n (car np))) '*)
!          (math-simplify-units-divisor (cdr n) (cdr (cdr expr)))
           (setq np (cdr (cdr n))))
!        (math-simplify-units-divisor np (cdr (cdr expr)))
         (if (eq try-cancel-units 0)
             (let* ((math-simplifying-units nil)
!                   (base (math-simplify (math-to-standard-units expr nil))))
               (if (Math-numberp base)
!                  (setq expr base))))
!        (if (eq (car-safe expr) '/)
             (math-simplify-units-prod))
!        expr)))
  
  (defun math-simplify-units-divisor (np dp)
    (let ((n (car np))
--- 1019,1058 ----
                     (or (not (eq p pref))
                         (< xpon (+ pxpon (* (math-abs pow) 3))))
                     (progn
!                      (setcar (cdr math-simplify-expr)
                               (let ((calc-prefer-frac nil))
!                                (calcFunc-scf (nth 1 math-simplify-expr)
                                               (- uxpon pxpon))))
                       (setcar unitp pname)
!                      math-simplify-expr)))))))
  
  (math-defsimplify /
    (and math-simplifying-units
!        (let ((np (cdr math-simplify-expr))
             (try-cancel-units 0)
             n nn)
!        (setq n (if (eq (car-safe (nth 2 math-simplify-expr)) '*)
!                    (cdr (nth 2 math-simplify-expr))
!                  (nthcdr 2 math-simplify-expr)))
         (if (math-realp (car n))
             (progn
!              (setcar (cdr math-simplify-expr) (math-mul (nth 1 
math-simplify-expr)
                                            (let ((calc-prefer-frac nil))
                                              (math-div 1 (car n)))))
               (setcar n 1)))
         (while (eq (car-safe (setq n (car np))) '*)
!          (math-simplify-units-divisor (cdr n) (cdr (cdr math-simplify-expr)))
           (setq np (cdr (cdr n))))
!        (math-simplify-units-divisor np (cdr (cdr math-simplify-expr)))
         (if (eq try-cancel-units 0)
             (let* ((math-simplifying-units nil)
!                   (base (math-simplify 
!                            (math-to-standard-units math-simplify-expr nil))))
               (if (Math-numberp base)
!                  (setq math-simplify-expr base))))
!        (if (eq (car-safe math-simplify-expr) '/)
             (math-simplify-units-prod))
!        math-simplify-expr)))
  
  (defun math-simplify-units-divisor (np dp)
    (let ((n (car np))
***************
*** 1094,1113 ****
  
  (math-defsimplify ^
    (and math-simplifying-units
!        (math-realp (nth 2 expr))
!        (if (memq (car-safe (nth 1 expr)) '(* /))
!          (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-defsimplify calcFunc-sqrt
    (and math-simplifying-units
!        (if (memq (car-safe (nth 1 expr)) '(* /))
!          (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-defsimplify (calcFunc-floor
                   calcFunc-ceil
--- 1099,1121 ----
  
  (math-defsimplify ^
    (and math-simplifying-units
!        (math-realp (nth 2 math-simplify-expr))
!        (if (memq (car-safe (nth 1 math-simplify-expr)) '(* /))
!          (list (car (nth 1 math-simplify-expr))
!                (list '^ (nth 1 (nth 1 math-simplify-expr)) 
!                        (nth 2 math-simplify-expr))
!                (list '^ (nth 2 (nth 1 math-simplify-expr)) 
!                        (nth 2 math-simplify-expr)))
!        (math-simplify-units-pow (nth 1 math-simplify-expr) 
!                                   (nth 2 math-simplify-expr)))))
  
  (math-defsimplify calcFunc-sqrt
    (and math-simplifying-units
!        (if (memq (car-safe (nth 1 math-simplify-expr)) '(* /))
!          (list (car (nth 1 math-simplify-expr))
!                (list 'calcFunc-sqrt (nth 1 (nth 1 math-simplify-expr)))
!                (list 'calcFunc-sqrt (nth 2 (nth 1 math-simplify-expr))))
!        (math-simplify-units-pow (nth 1 math-simplify-expr) '(frac 1 2)))))
  
  (math-defsimplify (calcFunc-floor
                   calcFunc-ceil
***************
*** 1120,1140 ****
                   calcFunc-abs
                   calcFunc-clean)
    (and math-simplifying-units
!        (= (length expr) 2)
!        (if (math-only-units-in-expr-p (nth 1 expr))
!          (nth 1 expr)
!        (if (and (memq (car-safe (nth 1 expr)) '(* /))
                  (or (math-only-units-in-expr-p
!                      (nth 1 (nth 1 expr)))
                      (math-only-units-in-expr-p
!                      (nth 2 (nth 1 expr)))))
!            (list (car (nth 1 expr))
!                  (cons (car expr)
!                        (cons (nth 1 (nth 1 expr))
!                              (cdr (cdr expr))))
!                  (cons (car expr)
!                        (cons (nth 2 (nth 1 expr))
!                              (cdr (cdr expr)))))))))
  
  (defun math-simplify-units-pow (a pow)
    (if (and (eq (car-safe a) '^)
--- 1128,1148 ----
                   calcFunc-abs
                   calcFunc-clean)
    (and math-simplifying-units
!        (= (length math-simplify-expr) 2)
!        (if (math-only-units-in-expr-p (nth 1 math-simplify-expr))
!          (nth 1 math-simplify-expr)
!        (if (and (memq (car-safe (nth 1 math-simplify-expr)) '(* /))
                  (or (math-only-units-in-expr-p
!                      (nth 1 (nth 1 math-simplify-expr)))
                      (math-only-units-in-expr-p
!                      (nth 2 (nth 1 math-simplify-expr)))))
!            (list (car (nth 1 math-simplify-expr))
!                  (cons (car math-simplify-expr)
!                        (cons (nth 1 (nth 1 math-simplify-expr))
!                              (cdr (cdr math-simplify-expr))))
!                  (cons (car math-simplify-expr)
!                        (cons (nth 2 (nth 1 math-simplify-expr))
!                              (cdr (cdr math-simplify-expr)))))))))
  
  (defun math-simplify-units-pow (a pow)
    (if (and (eq (car-safe a) '^)
***************
*** 1157,1166 ****
  
  (math-defsimplify calcFunc-sin
    (and math-simplifying-units
!        (math-units-in-expr-p (nth 1 expr) nil)
         (let ((rad (math-simplify-units
                   (math-evaluate-expr
!                   (math-to-standard-units (nth 1 expr) nil))))
             (calc-angle-mode 'rad))
         (and (eq (car-safe rad) '*)
              (math-realp (nth 1 rad))
--- 1165,1174 ----
  
  (math-defsimplify calcFunc-sin
    (and math-simplifying-units
!        (math-units-in-expr-p (nth 1 math-simplify-expr) nil)
         (let ((rad (math-simplify-units
                   (math-evaluate-expr
!                   (math-to-standard-units (nth 1 math-simplify-expr) nil))))
             (calc-angle-mode 'rad))
         (and (eq (car-safe rad) '*)
              (math-realp (nth 1 rad))
***************
*** 1170,1179 ****
  
  (math-defsimplify calcFunc-cos
    (and math-simplifying-units
!        (math-units-in-expr-p (nth 1 expr) nil)
         (let ((rad (math-simplify-units
                   (math-evaluate-expr
!                   (math-to-standard-units (nth 1 expr) nil))))
             (calc-angle-mode 'rad))
         (and (eq (car-safe rad) '*)
              (math-realp (nth 1 rad))
--- 1178,1187 ----
  
  (math-defsimplify calcFunc-cos
    (and math-simplifying-units
!        (math-units-in-expr-p (nth 1 math-simplify-expr) nil)
         (let ((rad (math-simplify-units
                   (math-evaluate-expr
!                   (math-to-standard-units (nth 1 math-simplify-expr) nil))))
             (calc-angle-mode 'rad))
         (and (eq (car-safe rad) '*)
              (math-realp (nth 1 rad))
***************
*** 1183,1192 ****
  
  (math-defsimplify calcFunc-tan
    (and math-simplifying-units
!        (math-units-in-expr-p (nth 1 expr) nil)
         (let ((rad (math-simplify-units
                   (math-evaluate-expr
!                   (math-to-standard-units (nth 1 expr) nil))))
             (calc-angle-mode 'rad))
         (and (eq (car-safe rad) '*)
              (math-realp (nth 1 rad))
--- 1191,1200 ----
  
  (math-defsimplify calcFunc-tan
    (and math-simplifying-units
!        (math-units-in-expr-p (nth 1 math-simplify-expr) nil)
         (let ((rad (math-simplify-units
                   (math-evaluate-expr
!                   (math-to-standard-units (nth 1 math-simplify-expr) nil))))
             (calc-angle-mode 'rad))
         (and (eq (car-safe rad) '*)
              (math-realp (nth 1 rad))