[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] Changes to emacs/lisp/calc/calc.el [lexbind]
From: |
Miles Bader |
Subject: |
[Emacs-diffs] Changes to emacs/lisp/calc/calc.el [lexbind] |
Date: |
Thu, 11 Nov 2004 23:48:24 -0500 |
Index: emacs/lisp/calc/calc.el
diff -c emacs/lisp/calc/calc.el:1.13.2.7 emacs/lisp/calc/calc.el:1.13.2.8
*** emacs/lisp/calc/calc.el:1.13.2.7 Fri Oct 29 02:05:13 2004
--- emacs/lisp/calc/calc.el Fri Nov 12 04:21:20 2004
***************
*** 654,659 ****
--- 654,673 ----
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,1064 ****
(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")
--- 1070,1075 ----
***************
*** 1069,1082 ****
(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
--- 1080,1085 ----
***************
*** 1163,1182 ****
(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)))))))
(save-excursion
(set-buffer (calc-trail-buffer))
(and calc-display-trail
--- 1166,1183 ----
(switch-to-buffer (current-buffer) t)
(if (get-buffer-window (current-buffer))
(select-window (get-buffer-window (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,1748 ****
(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 ()
--- 1723,1728 ----
***************
*** 1808,1817 ****
(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)))
(calc-wrapper
(setq overlay-arrow-string calc-trail-overlay
overlay-arrow-position calc-trail-pointer)
--- 1788,1795 ----
(not (if flag (memq flag '(nil 0)) win)))
(if (null win)
(progn
! (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,2315 ****
(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)
(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))
(while (setq digs (cdr digs))
(or (eq (car digs) 0) (setq last digs)))
(setcdr last nil)))
! (if (cdr (cdr (cdr a)))
! a
(cond
! ((cdr (cdr a)) (+ (nth 1 a) (* (nth 2 a) 1000)))
! ((cdr a) (nth 1 a))
(t 0))))
! ((eq (car a) 'bigneg)
! (if (eq (nth (1- (length a)) a) 0)
! (let* ((last (setq a (copy-sequence a))) (digs a))
(while (setq digs (cdr digs))
(or (eq (car digs) 0) (setq last digs)))
(setcdr last nil)))
! (if (cdr (cdr (cdr a)))
! a
(cond
! ((cdr (cdr a)) (- (+ (nth 1 a) (* (nth 2 a) 1000))))
! ((cdr a) (- (nth 1 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))))
(calc-extensions)
! (math-normalize-fancy a))
(t
(or (and calc-simplify-mode
(calc-extensions)
(math-normalize-nonstandard))
! (let ((args (mapcar 'math-normalize (cdr 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 ) ))))
(or (and var-EvalRules
(progn
(or (eq var-EvalRules math-eval-rules-cache-tag)
--- 2232,2303 ----
(defvar math-eval-rules-cache)
(defvar math-eval-rules-cache-other)
;;; Reduce an object to canonical (normalized) form. [O o; Z Z] [Public]
!
! (defvar math-normalize-a)
! (defun math-normalize (math-normalize-a)
(cond
! ((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 math-normalize-a)))
! math-normalize-a
(cond
! ((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 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 math-normalize-a)))
! math-normalize-a
(cond
! ((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 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 math-normalize-a))
(t
(or (and calc-simplify-mode
(calc-extensions)
(math-normalize-nonstandard))
! (let ((args (mapcar 'math-normalize (cdr math-normalize-a))))
(or (condition-case err
! (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,2367 ****
(calc-extensions)
(math-recompile-eval-rules)))
(and (or math-eval-rules-cache-other
! (assq (car a) math-eval-rules-cache))
(math-apply-rewrites
! (cons (car 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 (not calc-extensions-loaded)
(calc-extensions)
! (fboundp (car a))))
! (apply (car a) args)))))
(wrong-number-of-arguments
(calc-record-why "*Wrong number of arguments"
! (cons (car a) args))
nil)
(wrong-type-argument
! (or calc-next-why (calc-record-why "Wrong type of argument"
! (cons (car a) args)))
nil)
(args-out-of-range
! (calc-record-why "*Argument out of range" (cons (car a) args))
nil)
(inexact-result
(calc-record-why "No exact representation for result"
! (cons (car a) args))
nil)
(math-overflow
(calc-record-why "*Floating-point overflow occurred"
! (cons (car a) args))
nil)
(math-underflow
(calc-record-why "*Floating-point underflow occurred"
! (cons (car a) args))
nil)
(void-variable
(if (eq (nth 1 err) 'var-EvalRules)
(progn
(setq var-EvalRules nil)
! (math-normalize (cons (car a) args)))
(calc-record-why "*Variable is void" (nth 1 err)))))
! (if (consp (car a))
(math-dimension-error)
! (cons (car a) args))))))))
--- 2305,2358 ----
(calc-extensions)
(math-recompile-eval-rules)))
(and (or math-eval-rules-cache-other
! (assq (car math-normalize-a)
! math-eval-rules-cache))
(math-apply-rewrites
! (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 math-normalize-a))
! (fboundp (car math-normalize-a))
(and (not calc-extensions-loaded)
(calc-extensions)
! (fboundp (car math-normalize-a))))
! (apply (car math-normalize-a) args)))))
(wrong-number-of-arguments
(calc-record-why "*Wrong number of arguments"
! (cons (car math-normalize-a) args))
nil)
(wrong-type-argument
! (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 math-normalize-a) args))
nil)
(inexact-result
(calc-record-why "No exact representation for result"
! (cons (car math-normalize-a) args))
nil)
(math-overflow
(calc-record-why "*Floating-point overflow occurred"
! (cons (car math-normalize-a) args))
nil)
(math-underflow
(calc-record-why "*Floating-point underflow occurred"
! (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 math-normalize-a) args)))
(calc-record-why "*Variable is void" (nth 1 err)))))
! (if (consp (car math-normalize-a))
(math-dimension-error)
! (cons (car math-normalize-a) args))))))))
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] Changes to emacs/lisp/calc/calc.el [lexbind],
Miles Bader <=