1 files changed, 96 insertions, 105 deletions

diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el
index 4ace5fb6780..6480b1960a5 100644
--- a/lisp/calc/calc.el
+++ b/lisp/calc/calc.el
@@ -654,6 +654,20 @@ If nil, selections displayed but ignored.")
                                 calc-word-size
                                 calc-internal-prec))
 
+(defvar calc-mode-hook nil
+  "Hook run when entering calc-mode.")
+
+(defvar calc-trail-mode-hook nil
+  "Hook run when entering calc-trail-mode.")
+
+(defvar calc-start-hook nil
+  "Hook run when calc is started.")
+
+(defvar calc-end-hook nil
+  "Hook run when calc is quit.")
+
+(defvar calc-load-hook nil
+  "Hook run when calc.el is loaded.")
 
 ;; Verify that Calc is running on the right kind of system.
 (defvar calc-emacs-type-lucid (not (not (string-match "Lucid" emacs-version))))
@@ -1056,9 +1070,6 @@ Notations:  3.14e6     3.14 * 10^6
       (progn
         (setq calc-loaded-settings-file t)
         (load calc-settings-file t)))   ; t = missing-ok
-  (if (and (eq window-system 'x) (boundp 'mouse-map))
-      (substitute-key-definition 'x-paste-text 'calc-x-paste-text
-                                 mouse-map))
   (let ((p command-line-args))
     (while p
       (and (equal (car p) "-f")
@@ -1069,14 +1080,6 @@ Notations:  3.14e6     3.14 * 10^6
   (run-hooks 'calc-mode-hook)
   (calc-refresh t)
   (calc-set-mode-line)
-  ;; The calc-defs variable is a relic.  Use calc-define properties instead.
-  (when (and (boundp 'calc-defs)
-             calc-defs)
-    (message "Evaluating calc-defs...")
-    (calc-need-macros)
-    (eval (cons 'progn calc-defs))
-    (setq calc-defs nil)
-    (calc-set-mode-line))
   (calc-check-defines))
 
 (defvar calc-check-defines 'calc-check-defines)  ; suitable for run-hooks
@@ -1163,20 +1166,18 @@ commands given here will actually operate on the *Calculator* stack."
             (switch-to-buffer (current-buffer) t)
           (if (get-buffer-window (current-buffer))
               (select-window (get-buffer-window (current-buffer)))
-            (if (and (boundp 'calc-window-hook) calc-window-hook)
-                (run-hooks 'calc-window-hook)
-              (let ((w (get-largest-window)))
-                (if (and pop-up-windows
-                         (> (window-height w)
-                            (+ window-min-height calc-window-height 2)))
-                    (progn
-                      (setq w (split-window w
-                                            (- (window-height w)
-                                               calc-window-height 2)
-                                            nil))
-                      (set-window-buffer w (current-buffer))
-                      (select-window w))
-                  (pop-to-buffer (current-buffer)))))))
+            (let ((w (get-largest-window)))
+              (if (and pop-up-windows
+                       (> (window-height w)
+                          (+ window-min-height calc-window-height 2)))
+                  (progn
+                    (setq w (split-window w
+                                          (- (window-height w)
+                                             calc-window-height 2)
+                                          nil))
+                    (set-window-buffer w (current-buffer))
+                    (select-window w))
+                (pop-to-buffer (current-buffer))))))
         (save-excursion
           (set-buffer (calc-trail-buffer))
           (and calc-display-trail
@@ -1722,27 +1723,6 @@ See calc-keypad for details."
          (calc-refresh align)))
   (setq calc-refresh-count (1+ calc-refresh-count)))
 
-
-(defun calc-x-paste-text (arg)
-  "Move point to mouse position and insert window system cut buffer contents.
-If mouse is pressed in Calc window, push cut buffer contents onto the stack."
-  (x-mouse-select arg)
-  (if (memq major-mode '(calc-mode calc-trail-mode))
-      (progn
-        (calc-wrapper
-         (calc-extensions)
-         (let* ((buf (x-get-cut-buffer))
-                (val (math-read-exprs (calc-clean-newlines buf))))
-           (if (eq (car-safe val) 'error)
-               (progn
-                 (setq val (math-read-exprs buf))
-                 (if (eq (car-safe val) 'error)
-                     (error "%s in yanked data" (nth 2 val)))))
-           (calc-enter-result 0 "Xynk" val))))
-    (x-paste-text arg)))
-
-
-
 ;;;; The Calc Trail buffer.
 
 (defun calc-check-trail-aligned ()
@@ -1808,10 +1788,8 @@ If mouse is pressed in Calc window, push cut buffer contents onto the stack."
               (not (if flag (memq flag '(nil 0)) win)))
         (if (null win)
             (progn
-              (if (and (boundp 'calc-trail-window-hook) calc-trail-window-hook)
-                  (run-hooks 'calc-trail-window-hook)
-                (let ((w (split-window nil (/ (* (window-width) 2) 3) t)))
-                  (set-window-buffer w calc-trail-buffer)))
+              (let ((w (split-window nil (/ (* (window-width) 2) 3) t)))
+                (set-window-buffer w calc-trail-buffer))
               (calc-wrapper
                (setq overlay-arrow-string calc-trail-overlay
                      overlay-arrow-position calc-trail-pointer)
@@ -2254,62 +2232,72 @@ If mouse is pressed in Calc window, push cut buffer contents onto the stack."
 (defvar math-eval-rules-cache)
 (defvar math-eval-rules-cache-other)
 ;;; Reduce an object to canonical (normalized) form.  [O o; Z Z] [Public]
-(defun math-normalize (a)
+
+(defvar math-normalize-a)
+(defun math-normalize (math-normalize-a)
   (cond
-   ((not (consp a))
-    (if (integerp a)
-        (if (or (>= a 1000000) (<= a -1000000))
-            (math-bignum a)
-          a)
-      a))
-   ((eq (car a) 'bigpos)
-    (if (eq (nth (1- (length a)) a) 0)
-        (let* ((last (setq a (copy-sequence a))) (digs a))
+   ((not (consp math-normalize-a))
+    (if (integerp math-normalize-a)
+        (if (or (>= math-normalize-a 1000000) (<= math-normalize-a -1000000))
+            (math-bignum math-normalize-a)
+          math-normalize-a)
+      math-normalize-a))
+   ((eq (car math-normalize-a) 'bigpos)
+    (if (eq (nth (1- (length math-normalize-a)) math-normalize-a) 0)
+        (let* ((last (setq math-normalize-a 
+                           (copy-sequence math-normalize-a))) (digs math-normalize-a))
           (while (setq digs (cdr digs))
             (or (eq (car digs) 0) (setq last digs)))
           (setcdr last nil)))
-    (if (cdr (cdr (cdr a)))
-        a
+    (if (cdr (cdr (cdr math-normalize-a)))
+        math-normalize-a
       (cond
-       ((cdr (cdr a)) (+ (nth 1 a) (* (nth 2 a) 1000)))
-       ((cdr a) (nth 1 a))
+       ((cdr (cdr math-normalize-a)) (+ (nth 1 math-normalize-a) 
+                                        (* (nth 2 math-normalize-a) 1000)))
+       ((cdr math-normalize-a) (nth 1 math-normalize-a))
        (t 0))))
-   ((eq (car a) 'bigneg)
-    (if (eq (nth (1- (length a)) a) 0)
-        (let* ((last (setq a (copy-sequence a))) (digs a))
+   ((eq (car math-normalize-a) 'bigneg)
+    (if (eq (nth (1- (length math-normalize-a)) math-normalize-a) 0)
+        (let* ((last (setq math-normalize-a (copy-sequence math-normalize-a))) 
+               (digs math-normalize-a))
           (while (setq digs (cdr digs))
             (or (eq (car digs) 0) (setq last digs)))
           (setcdr last nil)))
-    (if (cdr (cdr (cdr a)))
-        a
+    (if (cdr (cdr (cdr math-normalize-a)))
+        math-normalize-a
       (cond
-       ((cdr (cdr a)) (- (+ (nth 1 a) (* (nth 2 a) 1000))))
-       ((cdr a) (- (nth 1 a)))
+       ((cdr (cdr math-normalize-a)) (- (+ (nth 1 math-normalize-a) 
+                                           (* (nth 2 math-normalize-a) 1000))))
+       ((cdr math-normalize-a) (- (nth 1 math-normalize-a)))
        (t 0))))
-   ((eq (car a) 'float)
-    (math-make-float (math-normalize (nth 1 a)) (nth 2 a)))
-   ((or (memq (car a) '(frac cplx polar hms date mod sdev intv vec var quote
-                             special-const calcFunc-if calcFunc-lambda
-                             calcFunc-quote calcFunc-condition
-                             calcFunc-evalto))
-        (integerp (car a))
-        (and (consp (car a)) (not (eq (car (car a)) 'lambda))))
+   ((eq (car math-normalize-a) 'float)
+    (math-make-float (math-normalize (nth 1 math-normalize-a)) 
+                     (nth 2 math-normalize-a)))
+   ((or (memq (car math-normalize-a) 
+              '(frac cplx polar hms date mod sdev intv vec var quote
+                     special-const calcFunc-if calcFunc-lambda
+                     calcFunc-quote calcFunc-condition
+                     calcFunc-evalto))
+        (integerp (car math-normalize-a))
+        (and (consp (car math-normalize-a)) 
+             (not (eq (car (car math-normalize-a)) 'lambda))))
     (calc-extensions)
-    (math-normalize-fancy a))
+    (math-normalize-fancy math-normalize-a))
    (t
     (or (and calc-simplify-mode
              (calc-extensions)
              (math-normalize-nonstandard))
-        (let ((args (mapcar 'math-normalize (cdr a))))
+        (let ((args (mapcar 'math-normalize (cdr math-normalize-a))))
           (or (condition-case err
-                  (let ((func (assq (car a) '( ( + . math-add )
-                                               ( - . math-sub )
-                                               ( * . math-mul )
-                                               ( / . math-div )
-                                               ( % . math-mod )
-                                               ( ^ . math-pow )
-                                               ( neg . math-neg )
-                                               ( | . math-concat ) ))))
+                  (let ((func 
+                         (assq (car math-normalize-a) '( ( + . math-add )
+                                                         ( - . math-sub )
+                                                         ( * . math-mul )
+                                                         ( / . math-div )
+                                                         ( % . math-mod )
+                                                         ( ^ . math-pow )
+                                                         ( neg . math-neg )
+                                                         ( | . math-concat ) ))))
                     (or (and var-EvalRules
                              (progn
                                (or (eq var-EvalRules math-eval-rules-cache-tag)
@@ -2317,51 +2305,54 @@ If mouse is pressed in Calc window, push cut buffer contents onto the stack."
                                      (calc-extensions)
                                      (math-recompile-eval-rules)))
                                (and (or math-eval-rules-cache-other
-                                        (assq (car a) math-eval-rules-cache))
+                                        (assq (car math-normalize-a) 
+                                              math-eval-rules-cache))
                                     (math-apply-rewrites
-                                     (cons (car a) args)
+                                     (cons (car math-normalize-a) args)
                                      (cdr math-eval-rules-cache)
                                      nil math-eval-rules-cache))))
                         (if func
                             (apply (cdr func) args)
-                          (and (or (consp (car a))
-                                   (fboundp (car a))
+                          (and (or (consp (car math-normalize-a))
+                                   (fboundp (car math-normalize-a))
                                    (and (not calc-extensions-loaded)
                                         (calc-extensions)
-                                        (fboundp (car a))))
-                               (apply (car a) args)))))
+                                        (fboundp (car math-normalize-a))))
+                               (apply (car math-normalize-a) args)))))
                 (wrong-number-of-arguments
                  (calc-record-why "*Wrong number of arguments"
-                                  (cons (car a) args))
+                                  (cons (car math-normalize-a) args))
                  nil)
                 (wrong-type-argument
-                 (or calc-next-why (calc-record-why "Wrong type of argument"
-                                                    (cons (car a) args)))
+                 (or calc-next-why 
+                     (calc-record-why "Wrong type of argument"
+                                      (cons (car math-normalize-a) args)))
                  nil)
                 (args-out-of-range
-                 (calc-record-why "*Argument out of range" (cons (car a) args))
+                 (calc-record-why "*Argument out of range" 
+                                  (cons (car math-normalize-a) args))
                  nil)
                 (inexact-result
                  (calc-record-why "No exact representation for result"
-                                  (cons (car a) args))
+                                  (cons (car math-normalize-a) args))
                  nil)
                 (math-overflow
                  (calc-record-why "*Floating-point overflow occurred"
-                                  (cons (car a) args))
+                                  (cons (car math-normalize-a) args))
                  nil)
                 (math-underflow
                  (calc-record-why "*Floating-point underflow occurred"
-                                  (cons (car a) args))
+                                  (cons (car math-normalize-a) args))
                  nil)
                 (void-variable
                  (if (eq (nth 1 err) 'var-EvalRules)
                      (progn
                        (setq var-EvalRules nil)
-                       (math-normalize (cons (car a) args)))
+                       (math-normalize (cons (car math-normalize-a) args)))
                    (calc-record-why "*Variable is void" (nth 1 err)))))
-              (if (consp (car a))
+              (if (consp (car math-normalize-a))
                   (math-dimension-error)
-                (cons (car a) args))))))))
+                (cons (car math-normalize-a) args))))))))