Mercurial > emacs
diff lisp/calc/calc-ext.el @ 90044:cb7f41387eb3
Revision: miles@gnu.org--gnu-2004/emacs--unicode--0--patch-70
Merge from emacs--cvs-trunk--0
Patches applied:
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-669
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-678
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-679
Merge from gnus--rel--5.10
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-680
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-688
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-689
Merge from gnus--rel--5.10
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-690
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-691
Update from CVS
* miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-69
Merge from emacs--cvs-trunk--0
* miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-70
- miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-71
Update from CVS
| author | Miles Bader <miles@gnu.org> |
|---|---|
| date | Fri, 12 Nov 2004 02:53:04 +0000 |
| parents | f3ec05478165 ad1cd229b771 |
| children | b637c617432f |
line wrap: on
line diff
--- a/lisp/calc/calc-ext.el Thu Nov 04 08:55:40 2004 +0000 +++ b/lisp/calc/calc-ext.el Fri Nov 12 02:53:04 2004 +0000 @@ -108,6 +108,7 @@ (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,16 +663,6 @@ (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) @@ -1769,10 +1760,13 @@ (cdr res) res))) +(defvar calc-z-prefix-buf nil) +(defvar calc-z-prefix-msgs nil) + (defun calc-z-prefix-help () (interactive) - (let* ((msgs nil) - (buf "") + (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,12 +1777,12 @@ (if (= (logand flags 8) 0) (calc-user-function-list kmap 7) (calc-user-function-list kmap 1) - (setq msgs (cons buf msgs) - buf "") + (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 msgs (cons buf msgs))) - (calc-do-prefix-help (nreverse msgs) "user" ?z))) + (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,14 +1816,15 @@ (upcase key) (downcase name)))) (char-to-string (upcase key))))) - (if (= (length buf) 0) - (setq buf (concat (if (= flags 1) "SHIFT + " "") + (if (= (length calc-z-prefix-buf) 0) + (setq calc-z-prefix-buf (concat (if (= flags 1) "SHIFT + " "") desc)) - (if (> (+ (length buf) (length desc)) 58) - (setq msgs (cons buf msgs) - buf (concat (if (= flags 1) "SHIFT + " "") + (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 buf (concat buf ", " desc)))))) + (setq calc-z-prefix-buf (concat calc-z-prefix-buf ", " desc)))))) (calc-user-function-list (cdr map) flags)))) @@ -1854,10 +1849,10 @@ (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 '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,25 +2218,25 @@ (math-normalize (car a)) (error "Can't use multi-valued function in an expression"))))) -(defun math-normalize-nonstandard () ; uses "a" +(defun math-normalize-nonstandard () (if (consp calc-simplify-mode) (progn (setq calc-simplify-mode 'none - math-simplify-only (car-safe (cdr-safe a))) + math-simplify-only (car-safe (cdr-safe math-normalize-a))) nil) - (and (symbolp (car a)) + (and (symbolp (car math-normalize-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)))))) + (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 a) (mapcar 'math-normalize (cdr a)))))) - - - + (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,22 +2614,27 @@ (defvar var-FactorRules 'calc-FactorRules) -(defun math-map-tree (mmt-func mmt-expr &optional mmt-many) - (or mmt-many (setq mmt-many 1000000)) +(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 (= mmt-many 0) + (or (= math-mt-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)) + (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 - mmt-many (if (> mmt-many 0) (1- mmt-many) (1+ mmt-many)))) + math-mt-many (if (> math-mt-many 0) + (1- math-mt-many) + (1+ math-mt-many)))) (if (or (Math-primp mmt-expr) - (<= mmt-many 0)) + (<= math-mt-many 0)) (setq mmt-done t) (setq mmt-nextval (cons (car mmt-expr) (mapcar 'math-map-tree-rec @@ -2885,22 +2885,24 @@ ;;; 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))))) +(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 exp-old-pos val) - (if (equal exp-token 'end) + (list 'error math-exp-old-pos val) + (if (equal math-exp-token 'end) val - (list 'error exp-old-pos "Syntax error")))))) + (list 'error math-exp-old-pos "Syntax error")))))) (defun math-read-plain-expr (exp-str &optional error-check) (let* ((calc-language nil) @@ -2913,8 +2915,8 @@ (defun math-read-string () - (let ((str (read-from-string (concat exp-data "\"")))) - (or (and (= (cdr str) (1+ (length exp-data))) + (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)