Mercurial > emacs
view lisp/calc/calc-sel.el @ 48106:d69a38446204
*** empty log message ***
author | Kim F. Storm <storm@cua.dk> |
---|---|
date | Fri, 01 Nov 2002 08:53:18 +0000 |
parents | fcd507927105 |
children | f4d68f97221e |
line wrap: on
line source
;;; calc-sel.el --- data selection functions for Calc ;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. ;; Author: David Gillespie <daveg@synaptics.com> ;; Maintainer: Colin Walters <walters@debian.org> ;; 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. ;;; Commentary: ;;; Code: ;; This file is autoloaded from calc-ext.el. (require 'calc-ext) (require 'calc-macs) (defun calc-Need-calc-sel () nil) ;;; Selection commands. (defvar calc-keep-selection t) (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")))) (defvar calc-selection-cache-entry nil) (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)) ;;; 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))) (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 (frame-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)) ;;; calc-sel.el ends here