emacs: lisp/calc/calc-ext.el comparison

comparison 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

comparison

equal deleted inserted replaced

-:e24e2e78deda
+:cb7f41387eb3
 (define-key calc-mode-map "\C-k" 'calc-kill)
 (define-key calc-mode-map "\M-k" 'calc-copy-as-kill)
 (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)
 (define-key calc-mode-map "a" nil)
 (define-key calc-alg-map "\e" calc-alg-esc-map)
 (define-key calc-alg-map "\e\t" 'calc-roll-up)
 (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)
 (autoload func (car x)))) (cdr x))))
 '(
 (let ((res (cdr (lookup-key calc-mode-map "z"))))
 (if (eq (car (car res)) 27)
 	(cdr res)
 res)))
+(defvar calc-z-prefix-buf nil)
+(defvar calc-z-prefix-msgs nil)
 (defun calc-z-prefix-help ()
 (interactive)
-(let* ((msgs nil)
+(let* ((calc-z-prefix-msgs nil)
-	 (buf "")
+	 (calc-z-prefix-buf "")
 	 (kmap (sort (copy-sequence (calc-user-key-map))
 		     (function (lambda (x y) (< (car x) (car y))))))
 	 (flags (apply 'logior
 		       (mapcar (function
 				(lambda (k)
 				  (calc-user-function-classify (car k))))
 			       kmap))))
 (if (= (logand flags 8) 0)
 	(calc-user-function-list kmap 7)
 (calc-user-function-list kmap 1)
-(setq msgs (cons buf msgs)
+(setq calc-z-prefix-msgs (cons calc-z-prefix-buf calc-z-prefix-msgs)
-	    buf "")
+	    calc-z-prefix-buf "")
 (calc-user-function-list kmap 6))
 (if (/= flags 0)
-	(setq msgs (cons buf msgs)))
+	(setq calc-z-prefix-msgs (cons calc-z-prefix-buf calc-z-prefix-msgs)))
-(calc-do-prefix-help (nreverse msgs) "user" ?z)))
+(calc-do-prefix-help (nreverse calc-z-prefix-msgs) "user" ?z)))
 (defun calc-user-function-classify (key)
 (cond ((/= key (downcase key))    ; upper-case
 	 (if (assq (downcase key) (calc-user-key-map)) 9 1))
 	((/= key (upcase key)) 2)   ; lower-case
 				     (downcase (substring name (1+ pos))))
 			   (format "%c = %s"
 				   (upcase key)
 				   (downcase name))))
 		     (char-to-string (upcase key)))))
-	     (if (= (length buf) 0)
+	     (if (= (length calc-z-prefix-buf) 0)
-		 (setq buf (concat (if (= flags 1) "SHIFT + " "")
+		 (setq calc-z-prefix-buf (concat (if (= flags 1) "SHIFT + " "")
 				   desc))
-	       (if (> (+ (length buf) (length desc)) 58)
+	       (if (> (+ (length calc-z-prefix-buf) (length desc)) 58)
-		   (setq msgs (cons buf msgs)
+		   (setq calc-z-prefix-msgs
-			 buf (concat (if (= flags 1) "SHIFT + " "")
+(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))))
 (defun calc-shift-Z-prefix-help ()
 (let ((cache-prec (intern (concat (symbol-name name) "-cache-prec")))
 	(cache-val (intern (concat (symbol-name name) "-cache")))
 	(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 'defvar cache-prec (if init (math-numdigs (nth 1 init)) -100))
-	  (list 'setq cache-val (list 'quote init))
+	  (list 'defvar cache-val (list 'quote init))
-	  (list 'setq last-prec -100)
+	  (list 'defvar last-prec -100)
-	  (list 'setq last-val nil)
+	  (list 'defvar last-val nil)
 	  (list 'setq 'math-cache-list
 		(list 'cons
 		      (list 'quote cache-prec)
 		      (list 'cons
 			    (list 'quote last-prec)
 	((or (integerp (car a)) (consp (car a)))
 	 (if (null (cdr a))
 	     (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
+		  (let ((aptr (setq math-normalize-a
-				       (car a)
+(cons
-				       (mapcar 'math-normalize (cdr a))))))
+(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]
 (defun math-norm-bignum (a)
 (let ((digs a) (last nil))
 (while (and (setq expr (cdr expr)) (not (math-any-floats (car expr)))))
 expr))
 (defvar var-FactorRules 'calc-FactorRules)
-(defun math-map-tree (mmt-func mmt-expr &optional mmt-many)
+(defvar math-mt-many nil)
-(or mmt-many (setq mmt-many 1000000))
+(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)
+	  (while (and (/= math-mt-many 0)
-		      (setq mmt-nextval (funcall mmt-func mmt-expr))
+		      (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
 					    (cdr mmt-expr))))
 	    (if (equal mmt-nextval mmt-expr)
 ;;; Expression parsing.
-(defun math-read-expr (exp-str)
+(defvar math-expr-data)
-(let ((exp-pos 0)
-	(exp-old-pos 0)
+(defun math-read-expr (math-exp-str)
-	(exp-keep-spaces nil)
+(let ((math-exp-pos 0)
-	exp-token exp-data)
+	(math-exp-old-pos 0)
-(while (setq exp-token (string-match "\\.\\.\\([^.]\\|.[^.]\\)" exp-str))
+	(math-exp-keep-spaces nil)
-(setq exp-str (concat (substring exp-str 0 exp-token) "\\dots"
+	math-exp-token math-expr-data)
-			    (substring exp-str (+ exp-token 2)))))
+(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)
+	  (list 'error math-exp-old-pos val)
-	(if (equal exp-token 'end)
+	(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)
 	 (math-expr-opers math-standard-opers)
 	 (val (math-read-expr exp-str)))
 	 (error "%s: %s" (nth 2 val) exp-str))
 val))
 (defun math-read-string ()
-(let ((str (read-from-string (concat exp-data "\""))))
+(let ((str (read-from-string (concat math-expr-data "\""))))
-(or (and (= (cdr str) (1+ (length exp-data)))
+(or (and (= (cdr str) (1+ (length math-expr-data)))
 	     (stringp (car str)))
 	(throw 'syntax "Error in string constant"))
 (math-read-token)
 (append '(vec) (car str) nil)))

Mercurial > emacs

comparison lisp/calc/calc-ext.el @ 90044:cb7f41387eb3