[Emacs-diffs] Changes to emacs/lisp/calc/calc-ext.el [emacs-unicode-2]

[Miles Bader]

Index: emacs/lisp/calc/calc-ext.el
diff -c emacs/lisp/calc/calc-ext.el:1.13.4.2 
emacs/lisp/calc/calc-ext.el:1.13.4.3
*** emacs/lisp/calc/calc-ext.el:1.13.4.2        Fri Oct 22 10:13:34 2004
--- emacs/lisp/calc/calc-ext.el Fri Nov 12 02:53:01 2004
***************
*** 108,113 ****
--- 108,114 ----
    (define-key calc-mode-map "\C-w" 'calc-kill-region)
    (define-key calc-mode-map "\M-w" 'calc-copy-region-as-kill)
    (define-key calc-mode-map "\C-y" 'calc-yank)
+   (define-key calc-mode-map [mouse-2] 'calc-yank)
    (define-key calc-mode-map "\C-_" 'calc-undo)
    (define-key calc-mode-map "\C-xu" 'calc-undo)
    (define-key calc-mode-map "\M-\C-m" 'calc-last-args)
***************
*** 662,677 ****
    (define-key calc-alg-map "\e\C-m" 'calc-last-args-stub)
    (define-key calc-alg-map "\e\177" 'calc-pop-above)
  
-   ;; The following is a relic for backward compatability only.
-   ;; The calc-define property list is now the recommended method.
-   (if (and (boundp 'calc-ext-defs)
-          calc-ext-defs)
-       (progn
-       (calc-need-macros)
-       (message "Evaluating calc-ext-defs...")
-       (eval (cons 'progn calc-ext-defs))
-       (setq calc-ext-defs nil)))
- 
  ;;;; (Autoloads here)
    (mapcar (function (lambda (x)
      (mapcar (function (lambda (func)
--- 663,668 ----
***************
*** 1769,1778 ****
        (cdr res)
        res)))
  
  (defun calc-z-prefix-help ()
    (interactive)
!   (let* ((msgs nil)
!        (buf "")
         (kmap (sort (copy-sequence (calc-user-key-map))
                     (function (lambda (x y) (< (car x) (car y))))))
         (flags (apply 'logior
--- 1760,1772 ----
        (cdr res)
        res)))
  
+ (defvar calc-z-prefix-buf nil)
+ (defvar calc-z-prefix-msgs nil)
+ 
  (defun calc-z-prefix-help ()
    (interactive)
!   (let* ((calc-z-prefix-msgs nil)
!        (calc-z-prefix-buf "")
         (kmap (sort (copy-sequence (calc-user-key-map))
                     (function (lambda (x y) (< (car x) (car y))))))
         (flags (apply 'logior
***************
*** 1783,1794 ****
      (if (= (logand flags 8) 0)
        (calc-user-function-list kmap 7)
        (calc-user-function-list kmap 1)
!       (setq msgs (cons buf msgs)
!           buf "")
        (calc-user-function-list kmap 6))
      (if (/= flags 0)
!       (setq msgs (cons buf msgs)))
!     (calc-do-prefix-help (nreverse msgs) "user" ?z)))
  
  (defun calc-user-function-classify (key)
    (cond ((/= key (downcase key))    ; upper-case
--- 1777,1788 ----
      (if (= (logand flags 8) 0)
        (calc-user-function-list kmap 7)
        (calc-user-function-list kmap 1)
!       (setq calc-z-prefix-msgs (cons calc-z-prefix-buf calc-z-prefix-msgs)
!           calc-z-prefix-buf "")
        (calc-user-function-list kmap 6))
      (if (/= flags 0)
!       (setq calc-z-prefix-msgs (cons calc-z-prefix-buf calc-z-prefix-msgs)))
!     (calc-do-prefix-help (nreverse calc-z-prefix-msgs) "user" ?z)))
  
  (defun calc-user-function-classify (key)
    (cond ((/= key (downcase key))    ; upper-case
***************
*** 1822,1835 ****
                                   (upcase key)
                                   (downcase name))))
                     (char-to-string (upcase key)))))
!            (if (= (length buf) 0)
!                (setq buf (concat (if (= flags 1) "SHIFT + " "")
                                   desc))
!              (if (> (+ (length buf) (length desc)) 58)
!                  (setq msgs (cons buf msgs)
!                        buf (concat (if (= flags 1) "SHIFT + " "")
                                     desc))
!                (setq buf (concat buf ", " desc))))))
         (calc-user-function-list (cdr map) flags))))
  
  
--- 1816,1830 ----
                                   (upcase key)
                                   (downcase name))))
                     (char-to-string (upcase key)))))
!            (if (= (length calc-z-prefix-buf) 0)
!                (setq calc-z-prefix-buf (concat (if (= flags 1) "SHIFT + " "")
                                   desc))
!              (if (> (+ (length calc-z-prefix-buf) (length desc)) 58)
!                  (setq calc-z-prefix-msgs 
!                          (cons calc-z-prefix-buf calc-z-prefix-msgs)
!                        calc-z-prefix-buf (concat (if (= flags 1) "SHIFT + " 
"")
                                     desc))
!                (setq calc-z-prefix-buf (concat calc-z-prefix-buf ", " 
desc))))))
         (calc-user-function-list (cdr map) flags))))
  
  
***************
*** 1854,1863 ****
        (last-prec (intern (concat (symbol-name name) "-last-prec")))
        (last-val (intern (concat (symbol-name name) "-last"))))
      (list 'progn
!         (list 'setq cache-prec (if init (math-numdigs (nth 1 init)) -100))
!         (list 'setq cache-val (list 'quote init))
!         (list 'setq last-prec -100)
!         (list 'setq last-val nil)
          (list 'setq 'math-cache-list
                (list 'cons
                      (list 'quote cache-prec)
--- 1849,1858 ----
        (last-prec (intern (concat (symbol-name name) "-last-prec")))
        (last-val (intern (concat (symbol-name name) "-last"))))
      (list 'progn
!         (list 'defvar cache-prec (if init (math-numdigs (nth 1 init)) -100))
!         (list 'defvar cache-val (list 'quote init))
!         (list 'defvar last-prec -100)
!         (list 'defvar last-val nil)
          (list 'setq 'math-cache-list
                (list 'cons
                      (list 'quote cache-prec)
***************
*** 2223,2247 ****
             (math-normalize (car a))
           (error "Can't use multi-valued function in an expression")))))
  
! (defun math-normalize-nonstandard ()   ; uses "a"
    (if (consp calc-simplify-mode)
        (progn
        (setq calc-simplify-mode 'none
!             math-simplify-only (car-safe (cdr-safe a)))
        nil)
!     (and (symbolp (car a))
         (or (eq calc-simplify-mode 'none)
             (and (eq calc-simplify-mode 'num)
!                 (let ((aptr (setq a (cons
!                                      (car a)
!                                      (mapcar 'math-normalize (cdr a))))))
                    (while (and aptr (math-constp (car aptr)))
                      (setq aptr (cdr aptr)))
                    aptr)))
!        (cons (car a) (mapcar 'math-normalize (cdr a))))))
! 
! 
! 
  
  
  ;;; Normalize a bignum digit list by trimming high-end zeros.  [L l]
--- 2218,2242 ----
             (math-normalize (car a))
           (error "Can't use multi-valued function in an expression")))))
  
! (defun math-normalize-nonstandard ()
    (if (consp calc-simplify-mode)
        (progn
        (setq calc-simplify-mode 'none
!             math-simplify-only (car-safe (cdr-safe math-normalize-a)))
        nil)
!     (and (symbolp (car math-normalize-a))
         (or (eq calc-simplify-mode 'none)
             (and (eq calc-simplify-mode 'num)
!                 (let ((aptr (setq math-normalize-a 
!                                     (cons
!                                      (car math-normalize-a)
!                                      (mapcar 'math-normalize 
!                                              (cdr math-normalize-a))))))
                    (while (and aptr (math-constp (car aptr)))
                      (setq aptr (cdr aptr)))
                    aptr)))
!        (cons (car math-normalize-a) 
!                (mapcar 'math-normalize (cdr math-normalize-a))))))
  
  
  ;;; Normalize a bignum digit list by trimming high-end zeros.  [L l]
***************
*** 2619,2640 ****
  
  (defvar var-FactorRules 'calc-FactorRules)
  
! (defun math-map-tree (mmt-func mmt-expr &optional mmt-many)
!   (or mmt-many (setq mmt-many 1000000))
    (math-map-tree-rec mmt-expr))
  
  (defun math-map-tree-rec (mmt-expr)
!   (or (= mmt-many 0)
        (let ((mmt-done nil)
            mmt-nextval)
        (while (not mmt-done)
!         (while (and (/= mmt-many 0)
!                     (setq mmt-nextval (funcall mmt-func mmt-expr))
                      (not (equal mmt-expr mmt-nextval)))
            (setq mmt-expr mmt-nextval
!                 mmt-many (if (> mmt-many 0) (1- mmt-many) (1+ mmt-many))))
          (if (or (Math-primp mmt-expr)
!                 (<= mmt-many 0))
              (setq mmt-done t)
            (setq mmt-nextval (cons (car mmt-expr)
                                    (mapcar 'math-map-tree-rec
--- 2614,2640 ----
  
  (defvar var-FactorRules 'calc-FactorRules)
  
! (defvar math-mt-many nil)
! (defvar math-mt-func nil)
! 
! (defun math-map-tree (math-mt-func mmt-expr &optional math-mt-many)
!   (or math-mt-many (setq math-mt-many 1000000))
    (math-map-tree-rec mmt-expr))
  
  (defun math-map-tree-rec (mmt-expr)
!   (or (= math-mt-many 0)
        (let ((mmt-done nil)
            mmt-nextval)
        (while (not mmt-done)
!         (while (and (/= math-mt-many 0)
!                     (setq mmt-nextval (funcall math-mt-func mmt-expr))
                      (not (equal mmt-expr mmt-nextval)))
            (setq mmt-expr mmt-nextval
!                 math-mt-many (if (> math-mt-many 0) 
!                                    (1- math-mt-many) 
!                                  (1+ math-mt-many))))
          (if (or (Math-primp mmt-expr)
!                 (<= math-mt-many 0))
              (setq mmt-done t)
            (setq mmt-nextval (cons (car mmt-expr)
                                    (mapcar 'math-map-tree-rec
***************
*** 2885,2906 ****
  
  ;;; Expression parsing.
  
! (defun math-read-expr (exp-str)
!   (let ((exp-pos 0)
!       (exp-old-pos 0)
!       (exp-keep-spaces nil)
!       exp-token exp-data)
!     (while (setq exp-token (string-match "\\.\\.\\([^.]\\|.[^.]\\)" exp-str))
!       (setq exp-str (concat (substring exp-str 0 exp-token) "\\dots"
!                           (substring exp-str (+ exp-token 2)))))
      (math-build-parse-table)
      (math-read-token)
      (let ((val (catch 'syntax (math-read-expr-level 0))))
        (if (stringp val)
!         (list 'error exp-old-pos val)
!       (if (equal exp-token 'end)
            val
!         (list 'error exp-old-pos "Syntax error"))))))
  
  (defun math-read-plain-expr (exp-str &optional error-check)
    (let* ((calc-language nil)
--- 2885,2908 ----
  
  ;;; Expression parsing.
  
! (defvar math-expr-data)
! 
! (defun math-read-expr (math-exp-str)
!   (let ((math-exp-pos 0)
!       (math-exp-old-pos 0)
!       (math-exp-keep-spaces nil)
!       math-exp-token math-expr-data)
!     (while (setq math-exp-token (string-match "\\.\\.\\([^.]\\|.[^.]\\)" 
math-exp-str))
!       (setq math-exp-str (concat (substring math-exp-str 0 math-exp-token) 
"\\dots"
!                           (substring math-exp-str (+ math-exp-token 2)))))
      (math-build-parse-table)
      (math-read-token)
      (let ((val (catch 'syntax (math-read-expr-level 0))))
        (if (stringp val)
!         (list 'error math-exp-old-pos val)
!       (if (equal math-exp-token 'end)
            val
!         (list 'error math-exp-old-pos "Syntax error"))))))
  
  (defun math-read-plain-expr (exp-str &optional error-check)
    (let* ((calc-language nil)
***************
*** 2913,2920 ****
  
  
  (defun math-read-string ()
!   (let ((str (read-from-string (concat exp-data "\""))))
!     (or (and (= (cdr str) (1+ (length exp-data)))
             (stringp (car str)))
        (throw 'syntax "Error in string constant"))
      (math-read-token)
--- 2915,2922 ----
  
  
  (defun math-read-string ()
!   (let ((str (read-from-string (concat math-expr-data "\""))))
!     (or (and (= (cdr str) (1+ (length math-expr-data)))
             (stringp (car str)))
        (throw 'syntax "Error in string constant"))
      (math-read-token)