Initial import of Calc 2.02f.

1 files changed, 867 insertions, 0 deletions

diff --git a/lisp/calc/calc-sel.el b/lisp/calc/calc-sel.el
new file mode 100644
index 0000000000..ab7a3879f1
--- /dev/null
+++ b/lisp/calc/calc-sel.el
@@ -0,0 +1,867 @@
+;; Calculator for GNU Emacs, part II [calc-sel.el]
+;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc.
+;; Written by Dave Gillespie, [email protected].
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY.  No author or distributor
+;; accepts responsibility to anyone for the consequences of using it
+;; or for whether it serves any particular purpose or works at all,
+;; unless he says so in writing.  Refer to the GNU Emacs General Public
+;; License for full details.
+
+;; Everyone is granted permission to copy, modify and redistribute
+;; GNU Emacs, but only under the conditions described in the
+;; GNU Emacs General Public License.   A copy of this license is
+;; supposed to have been given to you along with GNU Emacs so you
+;; can know your rights and responsibilities.  It should be in a
+;; file named COPYING.  Among other things, the copyright notice
+;; and this notice must be preserved on all copies.
+
+
+
+;; This file is autoloaded from calc-ext.el.
+(require 'calc-ext)
+
+(require 'calc-macs)
+
+(defun calc-Need-calc-sel () nil)
+
+
+;;; Selection commands.
+
+(defun calc-select-here (num &optional once keep)
+  (interactive "P")
+  (calc-wrapper
+   (calc-prepare-selection)
+   (let ((found (calc-find-selected-part))
+	 (entry calc-selection-cache-entry))
+     (or (and keep (nth 2 entry))
+	 (progn
+	   (if once (progn
+		      (setq calc-keep-selection nil)
+		      (message "(Selection will apply to next command only)")))
+	   (calc-change-current-selection 
+	    (if found
+		(if (and num (> (setq num (prefix-numeric-value num)) 0))
+		    (progn
+		      (while (and (>= (setq num (1- num)) 0)
+				  (not (eq found (car entry))))
+			(setq found (calc-find-assoc-parent-formula
+				     (car entry) found)))
+		      found)
+		  (calc-grow-assoc-formula (car entry) found))
+	      (car entry)))))))
+)
+
+(defun calc-select-once (num)
+  (interactive "P")
+  (calc-select-here num t)
+)
+
+(defun calc-select-here-maybe (num)
+  (interactive "P")
+  (calc-select-here num nil t)
+)
+
+(defun calc-select-once-maybe (num)
+  (interactive "P")
+  (calc-select-here num t t)
+)
+
+(defun calc-select-additional ()
+  (interactive)
+  (calc-wrapper
+   (let (calc-keep-selection)
+     (calc-prepare-selection))
+   (let ((found (calc-find-selected-part))
+	 (entry calc-selection-cache-entry))
+     (calc-change-current-selection
+      (if found
+	  (let ((sel (nth 2 entry)))
+	    (if sel
+		(progn
+		  (while (not (or (eq sel (car entry))
+				  (calc-find-sub-formula sel found)))
+		    (setq sel (calc-find-assoc-parent-formula
+			       (car entry) sel)))
+		  sel)
+	      (calc-grow-assoc-formula (car entry) found)))
+	(car entry)))))
+)
+
+(defun calc-select-more (num)
+  (interactive "P")
+  (calc-wrapper
+   (calc-prepare-selection)
+   (let ((entry calc-selection-cache-entry))
+     (if (nth 2 entry)
+	 (let ((sel (nth 2 entry)))
+	   (while (and (not (eq sel (car entry)))
+		       (>= (setq num (1- (prefix-numeric-value num))) 0))
+	     (setq sel (calc-find-assoc-parent-formula (car entry) sel)))
+	   (calc-change-current-selection sel))
+       (calc-select-here num))))
+)
+
+(defun calc-select-less (num)
+  (interactive "p")
+  (calc-wrapper
+   (calc-prepare-selection)
+   (let ((found (calc-find-selected-part))
+	 (entry calc-selection-cache-entry))
+     (calc-change-current-selection 
+      (and found
+	   (let ((sel (nth 2 entry))
+		 old index op)
+	     (while (and sel
+			 (not (eq sel found))
+			 (>= (setq num (1- num)) 0))
+	       (setq old sel
+		     index (calc-find-sub-formula sel found))
+	       (and (setq sel (and index (nth index old)))
+		    calc-assoc-selections
+		    (setq op (assq (car-safe sel) calc-assoc-ops))
+		    (memq (car old) (nth index op))
+		    (setq num (1+ num))))
+	     sel)))))
+)
+
+(defun calc-select-part (num)
+  (interactive "P")
+  (or num (setq num (- last-command-char ?0)))
+  (calc-wrapper
+   (calc-prepare-selection)
+   (let ((sel (calc-find-nth-part (or (nth 2 calc-selection-cache-entry)
+				      (car calc-selection-cache-entry))
+				  num)))
+     (if sel
+	 (calc-change-current-selection sel)
+       (error "%d is not a valid sub-formula index" num))))
+)
+
+(defun calc-find-nth-part (expr num)
+  (if (and calc-assoc-selections
+	   (assq (car-safe expr) calc-assoc-ops))
+      (let (op)
+	(calc-find-nth-part-rec expr))
+    (if (eq (car-safe expr) 'intv)
+	(and (>= num 1) (<= num 2) (nth (1+ num) expr))
+      (and (not (Math-primp expr)) (>= num 1) (< num (length expr))
+	   (nth num expr))))
+)
+
+(defun calc-find-nth-part-rec (expr)   ; uses num, op
+  (or (if (and (setq op (assq (car-safe (nth 1 expr)) calc-assoc-ops))
+	       (memq (car expr) (nth 1 op)))
+	  (calc-find-nth-part-rec (nth 1 expr))
+	(and (= (setq num (1- num)) 0)
+	     (nth 1 expr)))
+      (if (and (setq op (assq (car-safe (nth 2 expr)) calc-assoc-ops))
+	       (memq (car expr) (nth 2 op)))
+	  (calc-find-nth-part-rec (nth 2 expr))
+	(and (= (setq num (1- num)) 0)
+	     (nth 2 expr))))
+)
+
+(defun calc-select-next (num)
+  (interactive "p")
+  (if (< num 0)
+      (calc-select-previous (- num))
+    (calc-wrapper
+     (calc-prepare-selection)
+     (let* ((entry calc-selection-cache-entry)
+	    (sel (nth 2 entry)))
+       (if sel
+	   (progn
+	     (while (>= (setq num (1- num)) 0)
+	       (let* ((parent (calc-find-parent-formula (car entry) sel))
+		     (p parent)
+		     op)
+		 (and (eq p t) (setq p nil))
+		 (while (and (setq p (cdr p))
+			     (not (eq (car p) sel))))
+		 (if (cdr p)
+		     (setq sel (or (and calc-assoc-selections
+					(setq op (assq (car-safe (nth 1 p))
+						       calc-assoc-ops))
+					(memq (car parent) (nth 2 op))
+					(nth 1 (nth 1 p)))
+				   (nth 1 p)))
+		   (if (and calc-assoc-selections
+			    (setq op (assq (car-safe parent) calc-assoc-ops))
+			    (consp (setq p (calc-find-parent-formula
+					    (car entry) parent)))
+			    (eq (nth 1 p) parent)
+			    (memq (car p) (nth 1 op)))
+		       (setq sel (nth 2 p))
+		     (error "No \"next\" sub-formula")))))
+	     (calc-change-current-selection sel))
+	 (if (Math-primp (car entry))
+	     (calc-change-current-selection (car entry))
+	   (calc-select-part num))))))
+)
+
+(defun calc-select-previous (num)
+  (interactive "p")
+  (if (< num 0)
+      (calc-select-next (- num))
+    (calc-wrapper
+     (calc-prepare-selection)
+     (let* ((entry calc-selection-cache-entry)
+	    (sel (nth 2 entry)))
+       (if sel
+	   (progn
+	     (while (>= (setq num (1- num)) 0)
+	       (let* ((parent (calc-find-parent-formula (car entry) sel))
+		      (p (cdr-safe parent))
+		      (prev nil)
+		      op)
+		 (if (eq (car-safe parent) 'intv) (setq p (cdr p)))
+		 (while (and (not (eq (car p) sel))
+			     (setq prev (car p)
+				   p (cdr p))))
+		 (if prev
+		     (setq sel (or (and calc-assoc-selections
+					(setq op (assq (car-safe prev)
+						       calc-assoc-ops))
+					(memq (car parent) (nth 1 op))
+					(nth 2 prev))
+				   prev))
+		   (if (and calc-assoc-selections
+			    (setq op (assq (car-safe parent) calc-assoc-ops))
+			    (consp (setq p (calc-find-parent-formula
+					    (car entry) parent)))
+			    (eq (nth 2 p) parent)
+			    (memq (car p) (nth 2 op)))
+		       (setq sel (nth 1 p))
+		     (error "No \"previous\" sub-formula")))))
+	     (calc-change-current-selection sel))
+	 (if (Math-primp (car entry))
+	     (calc-change-current-selection (car entry))
+	   (let ((len (if (and calc-assoc-selections
+			       (assq (car (car entry)) calc-assoc-ops))
+			  (let (op (num 0))
+			    (calc-find-nth-part-rec (car entry))
+			    (- 1 num))
+			(length (car entry)))))
+	     (calc-select-part (- len num))))))))
+)
+
+(defun calc-find-parent-formula (expr part)
+  (cond ((eq expr part) t)
+	((Math-primp expr) nil)
+	(t
+	 (let ((p expr) res)
+	   (while (and (setq p (cdr p))
+		       (not (setq res (calc-find-parent-formula
+				       (car p) part)))))
+	   (and p
+		(if (eq res t) expr res)))))
+)
+
+
+(defun calc-find-assoc-parent-formula (expr part)
+  (calc-grow-assoc-formula expr (calc-find-parent-formula expr part))
+)
+
+(defun calc-grow-assoc-formula (expr part)
+  (if calc-assoc-selections
+      (let ((op (assq (car-safe part) calc-assoc-ops)))
+	(if op
+	    (let (new)
+	      (while (and (consp (setq new (calc-find-parent-formula
+					    expr part)))
+			  (memq (car new)
+				(nth (calc-find-sub-formula new part) op)))
+		(setq part new))))
+	part)
+    part)
+)
+
+(defun calc-find-sub-formula (expr part)
+  (cond ((eq expr part) t)
+	((Math-primp expr) nil)
+	(t
+	 (let ((num 1))
+	   (while (and (setq expr (cdr expr))
+		       (not (calc-find-sub-formula (car expr) part)))
+	     (setq num (1+ num)))
+	   (and expr num))))
+)
+
+(defun calc-unselect (num)
+  (interactive "P")
+  (calc-wrapper
+   (calc-prepare-selection num)
+   (calc-change-current-selection nil))
+)
+
+(defun calc-clear-selections ()
+  (interactive)
+  (calc-wrapper
+   (let ((limit (calc-stack-size))
+	 (n 1))
+     (while (<= n limit)
+       (if (calc-top n 'sel)
+	   (progn
+	     (calc-prepare-selection n)
+	     (calc-change-current-selection nil)))
+       (setq n (1+ n))))
+   (calc-clear-command-flag 'position-point))
+)
+
+(defun calc-show-selections (arg)
+  (interactive "P")
+  (calc-wrapper
+   (calc-preserve-point)
+   (setq calc-show-selections (if arg
+				  (> (prefix-numeric-value arg) 0)
+				(not calc-show-selections)))
+   (let ((p calc-stack))
+     (while (and p
+		 (or (null (nth 2 (car p)))
+		     (equal (car p) calc-selection-cache-entry)))
+       (setq p (cdr p)))
+     (or (and p
+	      (let ((calc-selection-cache-default-entry
+		     calc-selection-cache-entry))
+		(calc-do-refresh)))
+	 (and calc-selection-cache-entry
+	      (let ((sel (nth 2 calc-selection-cache-entry)))
+		(setcar (nthcdr 2 calc-selection-cache-entry) nil)
+		(calc-change-current-selection sel)))))
+   (message (if calc-show-selections
+		"Displaying only selected part of formulas"
+	      "Displaying all but selected part of formulas")))
+)
+
+(defun calc-preserve-point ()
+  (or (looking-at "\\.\n+\\'")
+      (progn
+	(setq calc-final-point-line (+ (count-lines (point-min) (point))
+				       (if (bolp) 1 0))
+	      calc-final-point-column (current-column))
+	(calc-set-command-flag 'position-point)))
+)
+
+(defun calc-enable-selections (arg)
+  (interactive "P")
+  (calc-wrapper
+   (calc-preserve-point)
+   (setq calc-use-selections (if arg
+				 (> (prefix-numeric-value arg) 0)
+			       (not calc-use-selections)))
+   (calc-set-command-flag 'renum-stack)
+   (message (if calc-use-selections
+		"Commands operate only on selected sub-formulas"
+	      "Selections of sub-formulas have no effect")))
+)
+
+(defun calc-break-selections (arg)
+  (interactive "P")
+  (calc-wrapper
+   (calc-preserve-point)
+   (setq calc-assoc-selections (if arg
+				   (<= (prefix-numeric-value arg) 0)
+				 (not calc-assoc-selections)))
+   (message (if calc-assoc-selections
+		"Selection treats a+b+c as a sum of three terms"
+	      "Selection treats a+b+c as (a+b)+c")))
+)
+
+(defun calc-prepare-selection (&optional num)
+  (or num (setq num (calc-locate-cursor-element (point))))
+  (setq calc-selection-true-num num
+	calc-keep-selection t)
+  (or (> num 0) (setq num 1))
+  ;; (if (or (< num 1) (> num (calc-stack-size)))
+  ;;     (error "Cursor must be positioned on a stack element"))
+  (let* ((entry (calc-top num 'entry))
+	 ww w)
+    (or (equal entry calc-selection-cache-entry)
+	(progn
+	  (setcar entry (calc-encase-atoms (car entry)))
+	  (setq calc-selection-cache-entry entry
+		calc-selection-cache-num num
+		calc-selection-cache-comp
+		(let ((math-comp-tagged t))
+		  (math-compose-expr (car entry) 0))
+		calc-selection-cache-offset
+		(+ (car (math-stack-value-offset calc-selection-cache-comp))
+		   (length calc-left-label)
+		   (if calc-line-numbering 4 0))))))
+  (calc-preserve-point)
+)
+(setq calc-selection-cache-entry nil)
+
+;;; The following ensures that no two subformulas will be "eq" to each other!
+(defun calc-encase-atoms (x)
+  (if (or (not (consp x))
+	  (equal x '(float 0 0)))
+      (list 'cplx x 0)
+    (calc-encase-atoms-rec x)
+    x)
+)
+
+(defun calc-encase-atoms-rec (x)
+  (or (Math-primp x)
+      (progn
+	(if (eq (car x) 'intv)
+	    (setq x (cdr x)))
+	(while (setq x (cdr x))
+	  (if (or (not (consp (car x)))
+		  (equal (car x) '(float 0 0)))
+	      (setcar x (list 'cplx (car x) 0))
+	    (calc-encase-atoms-rec (car x))))))
+)
+
+(defun calc-find-selected-part ()
+  (let* ((math-comp-sel-hpos (- (current-column) calc-selection-cache-offset))
+	 toppt
+	 (lcount 0)
+	 (spaces 0)
+	 (math-comp-sel-vpos (save-excursion
+			       (beginning-of-line)
+			       (let ((line (point)))
+				 (calc-cursor-stack-index
+				  calc-selection-cache-num)
+				 (setq toppt (point))
+				 (while (< (point) line)
+				   (forward-line 1)
+				   (setq spaces (+ spaces
+						   (current-indentation))
+					 lcount (1+ lcount)))
+				 (- lcount (math-comp-ascent
+					    calc-selection-cache-comp) -1))))
+	 (math-comp-sel-cpos (- (point) toppt calc-selection-cache-offset
+				spaces lcount))
+	 (math-comp-sel-tag nil))
+    (and (>= math-comp-sel-hpos 0)
+	 (> calc-selection-true-num 0)
+	 (math-composition-to-string calc-selection-cache-comp 1000000))
+    (nth 1 math-comp-sel-tag))
+)
+
+(defun calc-change-current-selection (sub-expr)
+  (or (eq sub-expr (nth 2 calc-selection-cache-entry))
+      (let ((calc-prepared-composition calc-selection-cache-comp)
+	    (buffer-read-only nil)
+	    top)
+	(calc-set-command-flag 'renum-stack)
+	(setcar (nthcdr 2 calc-selection-cache-entry) sub-expr)
+	(calc-cursor-stack-index calc-selection-cache-num)
+	(setq top (point))
+	(calc-cursor-stack-index (1- calc-selection-cache-num))
+	(delete-region top (point))
+	(let ((calc-selection-cache-default-entry calc-selection-cache-entry))
+	  (insert (math-format-stack-value calc-selection-cache-entry)
+		  "\n"))))
+)
+
+(defun calc-top-selected (&optional n m)
+  (and calc-any-selections
+       calc-use-selections
+       (progn
+	 (or n (setq n 1))
+	 (or m (setq m 1))
+	 (calc-check-stack (+ n m -1))
+	 (let ((top (nthcdr (+ m calc-stack-top -1) calc-stack))
+	       (sel nil))
+	   (while (>= (setq n (1- n)) 0)
+	     (if (nth 2 (car top))
+		 (setq sel (if sel t (nth 2 (car top)))))
+	     (setq top (cdr top)))
+	   sel)))
+)
+
+(defun calc-replace-sub-formula (expr old new)
+  (setq new (calc-encase-atoms new))
+  (calc-replace-sub-formula-rec expr)
+)
+
+(defun calc-replace-sub-formula-rec (expr)
+  (cond ((eq expr old) new)
+	((Math-primp expr) expr)
+	(t
+	 (cons (car expr)
+	       (mapcar 'calc-replace-sub-formula-rec (cdr expr)))))
+)
+
+(defun calc-sel-error ()
+  (error "Illegal operation on sub-formulas")
+)
+
+(defun calc-replace-selections (n vals m)
+  (if (calc-top-selected n m)
+      (let ((num (length vals)))
+	(calc-preserve-point)
+	(cond
+	 ((= n num)
+	  (let* ((old (calc-top-list n m 'entry))
+		 (new nil)
+		 (sel nil)
+		 val)
+	    (while old
+	      (if (nth 2 (car old))
+		  (setq val (calc-encase-atoms (car vals))
+			new (cons (calc-replace-sub-formula (car (car old))
+							    (nth 2 (car old))
+							    val)
+				  new)
+			sel (cons val sel))
+		(setq new (cons (car vals) new)
+		      sel (cons nil sel)))
+	      (setq vals (cdr vals)
+		    old (cdr old)))
+	    (calc-pop-stack n m t)
+	    (calc-push-list (nreverse new)
+			    m (and calc-keep-selection (nreverse sel)))))
+	 ((= num 1)
+	  (let* ((old (calc-top-list n m 'entry))
+		 more)
+	    (while (and old (not (nth 2 (car old))))
+	      (setq old (cdr old)))
+	    (setq more old)
+	    (while (and (setq more (cdr more)) (not (nth 2 (car more)))))
+	    (and more
+		 (calc-sel-error))
+	    (calc-pop-stack n m t)
+	    (if old
+		(let ((val (calc-encase-atoms (car vals))))
+		  (calc-push-list (list (calc-replace-sub-formula
+					 (car (car old))
+					 (nth 2 (car old))
+					 val))
+				  m (and calc-keep-selection (list val))))
+	      (calc-push-list vals))))
+	 (t (calc-sel-error))))
+    (calc-pop-stack n m t)
+    (calc-push-list vals m))
+)
+(setq calc-keep-selection t)
+
+(defun calc-delete-selection (n)
+  (let ((entry (calc-top n 'entry)))
+    (if (nth 2 entry)
+	(if (eq (nth 2 entry) (car entry))
+	    (progn
+	      (calc-pop-stack 1 n t)
+	      (calc-push-list '(0) n))
+	  (let ((parent (calc-find-parent-formula (car entry) (nth 2 entry)))
+		(repl nil))
+	    (calc-preserve-point)
+	    (calc-pop-stack 1 n t)
+	    (cond ((or (memq (car parent) '(* / %))
+		       (and (eq (car parent) '^)
+			    (eq (nth 2 parent) (nth 2 entry))))
+		   (setq repl 1))
+		  ((memq (car parent) '(vec calcFunc-min calcFunc-max)))
+		  ((and (assq (car parent) calc-tweak-eqn-table)
+			(= (length parent) 3))
+		   (setq repl 'del))
+		  (t
+		   (setq repl 0)))
+	    (cond
+	     ((eq repl 'del)
+	      (calc-push-list (list
+			       (calc-normalize
+				(calc-replace-sub-formula
+				 (car entry)
+				 parent
+				 (if (eq (nth 2 entry) (nth 1 parent))
+				     (nth 2 parent)
+				   (nth 1 parent)))))
+			      n))
+	     (repl
+	      (calc-push-list (list
+			       (calc-normalize
+				(calc-replace-sub-formula (car entry)
+							  (nth 2 entry)
+							  repl)))
+			      n))
+	     (t
+	      (calc-push-list (list
+			       (calc-normalize
+				(calc-replace-sub-formula (car entry)
+							  parent
+							  (delq (nth 2 entry)
+								(copy-sequence
+								 parent)))))
+			      n)))))
+      (calc-pop-stack 1 n t)))
+)
+
+(defun calc-roll-down-with-selections (n m)
+  (let ((vals (append (calc-top-list m 1)
+		      (calc-top-list (- n m) (1+ m))))
+	(sels (append (calc-top-list m 1 'sel)
+		      (calc-top-list (- n m) (1+ m) 'sel))))
+    (calc-pop-push-list n vals 1 sels))
+)
+
+(defun calc-roll-up-with-selections (n m)
+  (let ((vals (append (calc-top-list (- n m) 1)
+		      (calc-top-list m (- n m -1))))
+	(sels (append (calc-top-list (- n m) 1 'sel)
+		      (calc-top-list m (- n m -1) 'sel))))
+    (calc-pop-push-list n vals 1 sels))
+)
+
+(defun calc-auto-selection (entry)
+  (or (nth 2 entry)
+      (progn
+	(and (boundp 'reselect) (setq reselect nil))
+	(calc-prepare-selection)
+	(calc-grow-assoc-formula (car entry) (calc-find-selected-part))))
+)
+
+(defun calc-copy-selection ()
+  (interactive)
+  (calc-wrapper
+   (calc-preserve-point)
+   (let* ((num (max 1 (calc-locate-cursor-element (point))))
+	  (entry (calc-top num 'entry)))
+     (calc-push (or (calc-auto-selection entry) (car entry)))))
+)
+
+(defun calc-del-selection ()
+  (interactive)
+  (calc-wrapper
+   (calc-preserve-point)
+   (let* ((num (max 1 (calc-locate-cursor-element (point))))
+	  (entry (calc-top num 'entry))
+	  (sel (calc-auto-selection entry)))
+     (setcar (nthcdr 2 entry) (and (not (eq sel (car entry))) sel))
+     (calc-delete-selection num)))
+)
+
+(defun calc-enter-selection ()
+  (interactive)
+  (calc-wrapper
+   (calc-preserve-point)
+   (let* ((num (max 1 (calc-locate-cursor-element (point))))
+	  (reselect calc-keep-selection)
+	  (entry (calc-top num 'entry))
+	  (expr (car entry))
+	  (sel (or (calc-auto-selection entry) expr))
+	  alg)
+     (let ((calc-dollar-values (list sel))
+	   (calc-dollar-used 0))
+       (setq alg (calc-do-alg-entry "" "Replace selection with: "))
+       (and alg
+	    (progn
+	      (setq alg (calc-encase-atoms (car alg)))
+	      (calc-pop-push-record-list 1 "repl"
+					 (list (calc-replace-sub-formula
+						expr sel alg))
+					 num
+					 (list (and reselect alg))))))
+     (calc-handle-whys)))
+)
+
+(defun calc-edit-selection ()
+  (interactive)
+  (calc-wrapper
+   (calc-preserve-point)
+   (let* ((num (max 1 (calc-locate-cursor-element (point))))
+	  (reselect calc-keep-selection)
+	  (entry (calc-top num 'entry))
+	  (expr (car entry))
+	  (sel (or (calc-auto-selection entry) expr))
+	  alg)
+     (let ((str (math-showing-full-precision
+		 (math-format-nice-expr sel (screen-width)))))
+       (calc-edit-mode (list 'calc-finish-selection-edit
+			     num (list 'quote sel) reselect))
+       (insert str "\n"))))
+  (calc-show-edit-buffer)
+)
+
+(defun calc-finish-selection-edit (num sel reselect)
+  (let ((buf (current-buffer))
+	(str (buffer-substring (point) (point-max)))
+	(start (point)))
+    (switch-to-buffer calc-original-buffer)
+    (let ((val (math-read-expr str)))
+      (if (eq (car-safe val) 'error)
+	  (progn
+	    (switch-to-buffer buf)
+	    (goto-char (+ start (nth 1 val)))
+	    (error (nth 2 val))))
+      (calc-wrapper
+       (calc-preserve-point)
+       (if disp-trail
+	   (calc-trail-display 1 t))
+       (setq val (calc-encase-atoms (calc-normalize val)))
+       (let ((expr (calc-top num 'full)))
+	 (if (calc-find-sub-formula expr sel)
+	     (calc-pop-push-record-list 1 "edit"
+					(list (calc-replace-sub-formula
+					       expr sel val))
+					num
+					(list (and reselect val)))
+	   (calc-push val)
+	   (error "Original selection has been lost"))))))
+)
+
+(defun calc-sel-evaluate (arg)
+  (interactive "p")
+  (calc-slow-wrapper
+   (calc-preserve-point)
+   (let* ((num (max 1 (calc-locate-cursor-element (point))))
+	  (reselect calc-keep-selection)
+	  (entry (calc-top num 'entry))
+	  (sel (or (calc-auto-selection entry) (car entry))))
+     (calc-with-default-simplification
+      (let ((math-simplify-only nil))
+	(calc-modify-simplify-mode arg)
+	(let ((val (calc-encase-atoms (calc-normalize sel))))
+	  (calc-pop-push-record-list 1 "jsmp"
+				     (list (calc-replace-sub-formula
+					    (car entry) sel val))
+				     num
+				     (list (and reselect val))))))
+     (calc-handle-whys)))
+)
+
+(defun calc-sel-expand-formula (arg)
+  (interactive "p")
+  (calc-slow-wrapper
+   (calc-preserve-point)
+   (let* ((num (max 1 (calc-locate-cursor-element (point))))
+	  (reselect calc-keep-selection)
+	  (entry (calc-top num 'entry))
+	  (sel (or (calc-auto-selection entry) (car entry))))
+     (calc-with-default-simplification
+      (let ((math-simplify-only nil))
+	(calc-modify-simplify-mode arg)
+	(let* ((math-expand-formulas (> arg 0))
+	       (val (calc-normalize sel))
+	       top)
+	  (and (<= arg 0)
+	       (setq top (math-expand-formula val))
+	       (setq val (calc-normalize top)))
+	  (setq val (calc-encase-atoms val))
+	  (calc-pop-push-record-list 1 "jexf"
+				     (list (calc-replace-sub-formula
+					    (car entry) sel val))
+				     num
+				     (list (and reselect val))))))
+     (calc-handle-whys)))
+)
+
+(defun calc-sel-mult-both-sides (no-simp &optional divide)
+  (interactive "P")
+  (calc-wrapper
+   (calc-preserve-point)
+   (let* ((num (max 1 (calc-locate-cursor-element (point))))
+	  (reselect calc-keep-selection)
+	  (entry (calc-top num 'entry))
+	  (expr (car entry))
+	  (sel (or (calc-auto-selection entry) expr))
+	  (func (car-safe sel))
+	  alg lhs rhs)
+     (setq alg (calc-with-default-simplification
+		(car (calc-do-alg-entry ""
+					(if divide
+					    "Divide both sides by: "
+					  "Multiply both sides by: ")))))
+     (and alg
+	  (progn
+	    (if (and (or (eq func '/)
+			 (assq func calc-tweak-eqn-table))
+		     (= (length sel) 3))
+		(progn
+		  (or (memq func '(/ calcFunc-eq calcFunc-neq))
+		      (if (math-known-nonposp alg)
+			  (progn
+			    (setq func (nth 1 (assq func
+						    calc-tweak-eqn-table)))
+			    (or (math-known-negp alg)
+				(message "Assuming this factor is nonzero")))
+			(or (math-known-posp alg)
+			    (if (math-known-nonnegp alg)
+				(message "Assuming this factor is nonzero")
+			      (message "Assuming this factor is positive")))))
+		  (setq lhs (list (if divide '/ '*) (nth 1 sel) alg)
+			rhs (list (if divide '/ '*) (nth 2 sel) alg))
+		  (or no-simp
+		      (progn
+			(setq lhs (math-simplify lhs)
+			      rhs (math-simplify rhs))
+			(and (eq func '/)
+			     (or (Math-equal (nth 1 sel) 1)
+				 (Math-equal (nth 1 sel) -1)
+				 (and (memq (car-safe (nth 2 sel)) '(+ -))
+				      (memq (car-safe alg) '(+ -))))
+			     (setq rhs (math-expand-term rhs)))))
+		  (setq alg (calc-encase-atoms
+			     (calc-normalize (list func lhs rhs)))))
+	      (setq rhs (list (if divide '* '/) sel alg))
+	      (or no-simp
+		  (setq rhs (math-simplify rhs)))
+	      (setq alg (calc-encase-atoms
+			 (calc-normalize (if divide
+					     (list '/ rhs alg)
+					   (list '* alg rhs))))))
+	    (calc-pop-push-record-list 1 (if divide "div" "mult")
+				       (list (calc-replace-sub-formula
+					      expr sel alg))
+				       num
+				       (list (and reselect alg)))))
+     (calc-handle-whys)))
+)
+
+(defun calc-sel-div-both-sides (no-simp)
+  (interactive "P")
+  (calc-sel-mult-both-sides no-simp t)
+)
+
+(defun calc-sel-add-both-sides (no-simp &optional subtract)
+  (interactive "P")
+  (calc-wrapper
+   (calc-preserve-point)
+   (let* ((num (max 1 (calc-locate-cursor-element (point))))
+	  (reselect calc-keep-selection)
+	  (entry (calc-top num 'entry))
+	  (expr (car entry))
+	  (sel (or (calc-auto-selection entry) expr))
+	  (func (car-safe sel))
+	  alg lhs rhs)
+     (setq alg (calc-with-default-simplification
+		(car (calc-do-alg-entry ""
+					(if subtract
+					    "Subtract from both sides: "
+					  "Add to both sides: ")))))
+     (and alg
+	  (progn
+	    (if (and (assq func calc-tweak-eqn-table)
+		     (= (length sel) 3))
+		(progn
+		  (setq lhs (list (if subtract '- '+) (nth 1 sel) alg)
+			rhs (list (if subtract '- '+) (nth 2 sel) alg))
+		  (or no-simp
+		      (setq lhs (math-simplify lhs)
+			    rhs (math-simplify rhs)))
+		  (setq alg (calc-encase-atoms
+			     (calc-normalize (list func lhs rhs)))))
+	      (setq rhs (list (if subtract '+ '-) sel alg))
+	      (or no-simp
+		  (setq rhs (math-simplify rhs)))
+	      (setq alg (calc-encase-atoms
+			 (calc-normalize (list (if subtract '- '+) alg rhs)))))
+	    (calc-pop-push-record-list 1 (if subtract "sub" "add")
+				       (list (calc-replace-sub-formula
+					      expr sel alg))
+				       num
+				       (list (and reselect alg)))))
+     (calc-handle-whys)))
+)
+
+(defun calc-sel-sub-both-sides (no-simp)
+  (interactive "P")
+  (calc-sel-add-both-sides no-simp t)
+)
+