1 ;;; calc-sel.el --- data selection functions for Calc
3 ;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
5 ;; Author: David Gillespie <daveg@synaptics.com>
6 ;; Maintainer: Jay Belanger <belanger@truman.edu>
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is distributed in the hope that it will be useful,
11 ;; but WITHOUT ANY WARRANTY. No author or distributor
12 ;; accepts responsibility to anyone for the consequences of using it
13 ;; or for whether it serves any particular purpose or works at all,
14 ;; unless he says so in writing. Refer to the GNU Emacs General Public
15 ;; License for full details.
17 ;; Everyone is granted permission to copy, modify and redistribute
18 ;; GNU Emacs, but only under the conditions described in the
19 ;; GNU Emacs General Public License. A copy of this license is
20 ;; supposed to have been given to you along with GNU Emacs so you
21 ;; can know your rights and responsibilities. It should be in a
22 ;; file named COPYING. Among other things, the copyright notice
23 ;; and this notice must be preserved on all copies.
29 ;; This file is autoloaded from calc-ext.el.
34 (defun calc-Need-calc-sel () nil)
37 ;;; Selection commands.
39 (defvar calc-keep-selection t)
41 (defvar calc-selection-cache-entry nil)
42 (defvar calc-selection-cache-num)
43 (defvar calc-selection-cache-comp)
44 (defvar calc-selection-cache-offset)
45 (defvar calc-selection-true-num)
47 (defun calc-select-here (num &optional once keep)
50 (calc-prepare-selection)
51 (let ((found (calc-find-selected-part))
52 (entry calc-selection-cache-entry))
53 (or (and keep (nth 2 entry))
56 (setq calc-keep-selection nil)
57 (message "(Selection will apply to next command only)")))
58 (calc-change-current-selection
60 (if (and num (> (setq num (prefix-numeric-value num)) 0))
62 (while (and (>= (setq num (1- num)) 0)
63 (not (eq found (car entry))))
64 (setq found (calc-find-assoc-parent-formula
67 (calc-grow-assoc-formula (car entry) found))
70 (defun calc-select-once (num)
72 (calc-select-here num t))
74 (defun calc-select-here-maybe (num)
76 (calc-select-here num nil t))
78 (defun calc-select-once-maybe (num)
80 (calc-select-here num t t))
82 (defun calc-select-additional ()
85 (let (calc-keep-selection)
86 (calc-prepare-selection))
87 (let ((found (calc-find-selected-part))
88 (entry calc-selection-cache-entry))
89 (calc-change-current-selection
91 (let ((sel (nth 2 entry)))
94 (while (not (or (eq sel (car entry))
95 (calc-find-sub-formula sel found)))
96 (setq sel (calc-find-assoc-parent-formula
99 (calc-grow-assoc-formula (car entry) found)))
102 (defun calc-select-more (num)
105 (calc-prepare-selection)
106 (let ((entry calc-selection-cache-entry))
108 (let ((sel (nth 2 entry)))
109 (while (and (not (eq sel (car entry)))
110 (>= (setq num (1- (prefix-numeric-value num))) 0))
111 (setq sel (calc-find-assoc-parent-formula (car entry) sel)))
112 (calc-change-current-selection sel))
113 (calc-select-here num)))))
115 (defun calc-select-less (num)
118 (calc-prepare-selection)
119 (let ((found (calc-find-selected-part))
120 (entry calc-selection-cache-entry))
121 (calc-change-current-selection
123 (let ((sel (nth 2 entry))
127 (>= (setq num (1- num)) 0))
129 index (calc-find-sub-formula sel found))
130 (and (setq sel (and index (nth index old)))
131 calc-assoc-selections
132 (setq op (assq (car-safe sel) calc-assoc-ops))
133 (memq (car old) (nth index op))
134 (setq num (1+ num))))
137 (defun calc-select-part (num)
139 (or num (setq num (- last-command-char ?0)))
141 (calc-prepare-selection)
142 (let ((sel (calc-find-nth-part (or (nth 2 calc-selection-cache-entry)
143 (car calc-selection-cache-entry))
146 (calc-change-current-selection sel)
147 (error "%d is not a valid sub-formula index" num)))))
149 ;; The variables calc-fnp-op and calc-fnp-num are local to
150 ;; calc-find-nth-part (and calc-select-previous) but used by
151 ;; calc-find-nth-part-rec, which is called by them.
153 (defvar calc-fnp-num)
155 (defun calc-find-nth-part (expr calc-fnp-num)
156 (if (and calc-assoc-selections
157 (assq (car-safe expr) calc-assoc-ops))
159 (calc-find-nth-part-rec expr))
160 (if (eq (car-safe expr) 'intv)
161 (and (>= calc-fnp-num 1) (<= calc-fnp-num 2) (nth (1+ calc-fnp-num) expr))
162 (and (not (Math-primp expr)) (>= calc-fnp-num 1) (< calc-fnp-num (length expr))
163 (nth calc-fnp-num expr)))))
165 (defun calc-find-nth-part-rec (expr) ; uses num, op
166 (or (if (and (setq calc-fnp-op (assq (car-safe (nth 1 expr)) calc-assoc-ops))
167 (memq (car expr) (nth 1 calc-fnp-op)))
168 (calc-find-nth-part-rec (nth 1 expr))
169 (and (= (setq calc-fnp-num (1- calc-fnp-num)) 0)
171 (if (and (setq calc-fnp-op (assq (car-safe (nth 2 expr)) calc-assoc-ops))
172 (memq (car expr) (nth 2 calc-fnp-op)))
173 (calc-find-nth-part-rec (nth 2 expr))
174 (and (= (setq calc-fnp-num (1- calc-fnp-num)) 0)
177 (defun calc-select-next (num)
180 (calc-select-previous (- num))
182 (calc-prepare-selection)
183 (let* ((entry calc-selection-cache-entry)
187 (while (>= (setq num (1- num)) 0)
188 (let* ((parent (calc-find-parent-formula (car entry) sel))
191 (and (eq p t) (setq p nil))
192 (while (and (setq p (cdr p))
193 (not (eq (car p) sel))))
195 (setq sel (or (and calc-assoc-selections
196 (setq op (assq (car-safe (nth 1 p))
198 (memq (car parent) (nth 2 op))
201 (if (and calc-assoc-selections
202 (setq op (assq (car-safe parent) calc-assoc-ops))
203 (consp (setq p (calc-find-parent-formula
204 (car entry) parent)))
205 (eq (nth 1 p) parent)
206 (memq (car p) (nth 1 op)))
208 (error "No \"next\" sub-formula")))))
209 (calc-change-current-selection sel))
210 (if (Math-primp (car entry))
211 (calc-change-current-selection (car entry))
212 (calc-select-part num)))))))
214 (defun calc-select-previous (num)
217 (calc-select-next (- num))
219 (calc-prepare-selection)
220 (let* ((entry calc-selection-cache-entry)
224 (while (>= (setq num (1- num)) 0)
225 (let* ((parent (calc-find-parent-formula (car entry) sel))
226 (p (cdr-safe parent))
229 (if (eq (car-safe parent) 'intv) (setq p (cdr p)))
230 (while (and (not (eq (car p) sel))
234 (setq sel (or (and calc-assoc-selections
235 (setq op (assq (car-safe prev)
237 (memq (car parent) (nth 1 op))
240 (if (and calc-assoc-selections
241 (setq op (assq (car-safe parent) calc-assoc-ops))
242 (consp (setq p (calc-find-parent-formula
243 (car entry) parent)))
244 (eq (nth 2 p) parent)
245 (memq (car p) (nth 2 op)))
247 (error "No \"previous\" sub-formula")))))
248 (calc-change-current-selection sel))
249 (if (Math-primp (car entry))
250 (calc-change-current-selection (car entry))
251 (let ((len (if (and calc-assoc-selections
252 (assq (car (car entry)) calc-assoc-ops))
253 (let (calc-fnp-op (calc-fnp-num 0))
254 (calc-find-nth-part-rec (car entry))
256 (length (car entry)))))
257 (calc-select-part (- len num)))))))))
259 (defun calc-find-parent-formula (expr part)
260 (cond ((eq expr part) t)
261 ((Math-primp expr) nil)
264 (while (and (setq p (cdr p))
265 (not (setq res (calc-find-parent-formula
268 (if (eq res t) expr res))))))
271 (defun calc-find-assoc-parent-formula (expr part)
272 (calc-grow-assoc-formula expr (calc-find-parent-formula expr part)))
274 (defun calc-grow-assoc-formula (expr part)
275 (if calc-assoc-selections
276 (let ((op (assq (car-safe part) calc-assoc-ops)))
279 (while (and (consp (setq new (calc-find-parent-formula
282 (nth (calc-find-sub-formula new part) op)))
287 (defun calc-find-sub-formula (expr part)
288 (cond ((eq expr part) t)
289 ((Math-primp expr) nil)
292 (while (and (setq expr (cdr expr))
293 (not (calc-find-sub-formula (car expr) part)))
297 (defun calc-unselect (num)
300 (calc-prepare-selection num)
301 (calc-change-current-selection nil)))
303 (defun calc-clear-selections ()
306 (let ((limit (calc-stack-size))
309 (if (calc-top n 'sel)
311 (calc-prepare-selection n)
312 (calc-change-current-selection nil)))
314 (calc-clear-command-flag 'position-point)))
316 (defun calc-show-selections (arg)
319 (calc-preserve-point)
320 (setq calc-show-selections (if arg
321 (> (prefix-numeric-value arg) 0)
322 (not calc-show-selections)))
323 (let ((p calc-stack))
325 (or (null (nth 2 (car p)))
326 (equal (car p) calc-selection-cache-entry)))
329 (let ((calc-selection-cache-default-entry
330 calc-selection-cache-entry))
332 (and calc-selection-cache-entry
333 (let ((sel (nth 2 calc-selection-cache-entry)))
334 (setcar (nthcdr 2 calc-selection-cache-entry) nil)
335 (calc-change-current-selection sel)))))
336 (message (if calc-show-selections
337 "Displaying only selected part of formulas"
338 "Displaying all but selected part of formulas"))))
340 ;; The variables calc-final-point-line and calc-final-point-column
341 ;; are declared in calc.el, and are used throughout.
342 (defvar calc-final-point-line)
343 (defvar calc-final-point-column)
345 (defun calc-preserve-point ()
346 (or (looking-at "\\.\n+\\'")
348 (setq calc-final-point-line (+ (count-lines (point-min) (point))
350 calc-final-point-column (current-column))
351 (calc-set-command-flag 'position-point))))
353 (defun calc-enable-selections (arg)
356 (calc-preserve-point)
357 (setq calc-use-selections (if arg
358 (> (prefix-numeric-value arg) 0)
359 (not calc-use-selections)))
360 (calc-set-command-flag 'renum-stack)
361 (message (if calc-use-selections
362 "Commands operate only on selected sub-formulas"
363 "Selections of sub-formulas have no effect"))))
365 (defun calc-break-selections (arg)
368 (calc-preserve-point)
369 (setq calc-assoc-selections (if arg
370 (<= (prefix-numeric-value arg) 0)
371 (not calc-assoc-selections)))
372 (message (if calc-assoc-selections
373 "Selection treats a+b+c as a sum of three terms"
374 "Selection treats a+b+c as (a+b)+c"))))
376 (defun calc-prepare-selection (&optional num)
377 (or num (setq num (calc-locate-cursor-element (point))))
378 (setq calc-selection-true-num num
379 calc-keep-selection t)
380 (or (> num 0) (setq num 1))
381 ;; (if (or (< num 1) (> num (calc-stack-size)))
382 ;; (error "Cursor must be positioned on a stack element"))
383 (let* ((entry (calc-top num 'entry))
385 (or (equal entry calc-selection-cache-entry)
387 (setcar entry (calc-encase-atoms (car entry)))
388 (setq calc-selection-cache-entry entry
389 calc-selection-cache-num num
390 calc-selection-cache-comp
391 (let ((math-comp-tagged t))
392 (math-compose-expr (car entry) 0))
393 calc-selection-cache-offset
394 (+ (car (math-stack-value-offset calc-selection-cache-comp))
395 (length calc-left-label)
396 (if calc-line-numbering 4 0))))))
397 (calc-preserve-point))
399 ;;; The following ensures that no two subformulas will be "eq" to each other!
400 (defun calc-encase-atoms (x)
401 (if (or (not (consp x))
402 (equal x '(float 0 0)))
404 (calc-encase-atoms-rec x)
407 (defun calc-encase-atoms-rec (x)
410 (if (eq (car x) 'intv)
412 (while (setq x (cdr x))
413 (if (or (not (consp (car x)))
414 (equal (car x) '(float 0 0)))
415 (setcar x (list 'cplx (car x) 0))
416 (calc-encase-atoms-rec (car x)))))))
418 ;; The variable math-comp-sel-tag is local to calc-find-selected-part,
419 ;; but is used by math-comp-sel-flat-term and math-comp-add-string-sel
420 ;; in calccomp.el, which are called (indirectly) by calc-find-selected-part.
422 (defun calc-find-selected-part ()
423 (let* ((math-comp-sel-hpos (- (current-column) calc-selection-cache-offset))
427 (math-comp-sel-vpos (save-excursion
429 (let ((line (point)))
430 (calc-cursor-stack-index
431 calc-selection-cache-num)
433 (while (< (point) line)
435 (setq spaces (+ spaces
436 (current-indentation))
438 (- lcount (math-comp-ascent
439 calc-selection-cache-comp) -1))))
440 (math-comp-sel-cpos (- (point) toppt calc-selection-cache-offset
442 (math-comp-sel-tag nil))
443 (and (>= math-comp-sel-hpos 0)
444 (> calc-selection-true-num 0)
445 (math-composition-to-string calc-selection-cache-comp 1000000))
446 (nth 1 math-comp-sel-tag)))
448 (defun calc-change-current-selection (sub-expr)
449 (or (eq sub-expr (nth 2 calc-selection-cache-entry))
450 (let ((calc-prepared-composition calc-selection-cache-comp)
451 (buffer-read-only nil)
453 (calc-set-command-flag 'renum-stack)
454 (setcar (nthcdr 2 calc-selection-cache-entry) sub-expr)
455 (calc-cursor-stack-index calc-selection-cache-num)
457 (calc-cursor-stack-index (1- calc-selection-cache-num))
458 (delete-region top (point))
459 (let ((calc-selection-cache-default-entry calc-selection-cache-entry))
460 (insert (math-format-stack-value calc-selection-cache-entry)
463 (defun calc-top-selected (&optional n m)
464 (and calc-any-selections
469 (calc-check-stack (+ n m -1))
470 (let ((top (nthcdr (+ m calc-stack-top -1) calc-stack))
472 (while (>= (setq n (1- n)) 0)
473 (if (nth 2 (car top))
474 (setq sel (if sel t (nth 2 (car top)))))
475 (setq top (cdr top)))
478 ;; The variables calc-rsf-old and calc-rsf-new are local to
479 ;; calc-replace-sub-formula, but used by calc-replace-sub-formula-rec,
480 ;; which is called by calc-replace-sub-formula.
481 (defvar calc-rsf-old)
482 (defvar calc-rsf-new)
484 (defun calc-replace-sub-formula (expr calc-rsf-old calc-rsf-new)
485 (setq calc-rsf-new (calc-encase-atoms calc-rsf-new))
486 (calc-replace-sub-formula-rec expr))
488 (defun calc-replace-sub-formula-rec (expr)
489 (cond ((eq expr calc-rsf-old) calc-rsf-new)
490 ((Math-primp expr) expr)
493 (mapcar 'calc-replace-sub-formula-rec (cdr expr))))))
495 (defun calc-sel-error ()
496 (error "Illegal operation on sub-formulas"))
498 (defun calc-replace-selections (n vals m)
499 (if (calc-top-selected n m)
500 (let ((num (length vals)))
501 (calc-preserve-point)
504 (let* ((old (calc-top-list n m 'entry))
509 (if (nth 2 (car old))
510 (setq val (calc-encase-atoms (car vals))
511 new (cons (calc-replace-sub-formula (car (car old))
516 (setq new (cons (car vals) new)
518 (setq vals (cdr vals)
520 (calc-pop-stack n m t)
521 (calc-push-list (nreverse new)
522 m (and calc-keep-selection (nreverse sel)))))
524 (let* ((old (calc-top-list n m 'entry))
526 (while (and old (not (nth 2 (car old))))
527 (setq old (cdr old)))
529 (while (and (setq more (cdr more)) (not (nth 2 (car more)))))
532 (calc-pop-stack n m t)
534 (let ((val (calc-encase-atoms (car vals))))
535 (calc-push-list (list (calc-replace-sub-formula
539 m (and calc-keep-selection (list val))))
540 (calc-push-list vals))))
541 (t (calc-sel-error))))
542 (calc-pop-stack n m t)
543 (calc-push-list vals m)))
545 (defun calc-delete-selection (n)
546 (let ((entry (calc-top n 'entry)))
548 (if (eq (nth 2 entry) (car entry))
550 (calc-pop-stack 1 n t)
551 (calc-push-list '(0) n))
552 (let ((parent (calc-find-parent-formula (car entry) (nth 2 entry)))
554 (calc-preserve-point)
555 (calc-pop-stack 1 n t)
556 (cond ((or (memq (car parent) '(* / %))
557 (and (eq (car parent) '^)
558 (eq (nth 2 parent) (nth 2 entry))))
560 ((memq (car parent) '(vec calcFunc-min calcFunc-max)))
561 ((and (assq (car parent) calc-tweak-eqn-table)
562 (= (length parent) 3))
568 (calc-push-list (list
570 (calc-replace-sub-formula
573 (if (eq (nth 2 entry) (nth 1 parent))
578 (calc-push-list (list
580 (calc-replace-sub-formula (car entry)
585 (calc-push-list (list
587 (calc-replace-sub-formula (car entry)
593 (calc-pop-stack 1 n t))))
595 (defun calc-roll-down-with-selections (n m)
596 (let ((vals (append (calc-top-list m 1)
597 (calc-top-list (- n m) (1+ m))))
598 (sels (append (calc-top-list m 1 'sel)
599 (calc-top-list (- n m) (1+ m) 'sel))))
600 (calc-pop-push-list n vals 1 sels)))
602 (defun calc-roll-up-with-selections (n m)
603 (let ((vals (append (calc-top-list (- n m) 1)
604 (calc-top-list m (- n m -1))))
605 (sels (append (calc-top-list (- n m) 1 'sel)
606 (calc-top-list m (- n m -1) 'sel))))
607 (calc-pop-push-list n vals 1 sels)))
609 ;; The variable calc-sel-reselect is local to several functions
610 ;; which call calc-auto-selection.
611 (defvar calc-sel-reselect)
613 (defun calc-auto-selection (entry)
616 (setq calc-sel-reselect nil)
617 (calc-prepare-selection)
618 (calc-grow-assoc-formula (car entry) (calc-find-selected-part)))))
620 (defun calc-copy-selection ()
623 (calc-preserve-point)
624 (let* ((num (max 1 (calc-locate-cursor-element (point))))
625 (entry (calc-top num 'entry)))
626 (calc-push (or (calc-auto-selection entry) (car entry))))))
628 (defun calc-del-selection ()
631 (calc-preserve-point)
632 (let* ((num (max 1 (calc-locate-cursor-element (point))))
633 (entry (calc-top num 'entry))
634 (sel (calc-auto-selection entry)))
635 (setcar (nthcdr 2 entry) (and (not (eq sel (car entry))) sel))
636 (calc-delete-selection num))))
638 (defun calc-enter-selection ()
641 (calc-preserve-point)
642 (let* ((num (max 1 (calc-locate-cursor-element (point))))
643 (calc-sel-reselect calc-keep-selection)
644 (entry (calc-top num 'entry))
646 (sel (or (calc-auto-selection entry) expr))
648 (let ((calc-dollar-values (list sel))
649 (calc-dollar-used 0))
650 (setq alg (calc-do-alg-entry "" "Replace selection with: "))
653 (setq alg (calc-encase-atoms (car alg)))
654 (calc-pop-push-record-list 1 "repl"
655 (list (calc-replace-sub-formula
658 (list (and calc-sel-reselect alg))))))
659 (calc-handle-whys))))
661 (defun calc-edit-selection ()
664 (calc-preserve-point)
665 (let* ((num (max 1 (calc-locate-cursor-element (point))))
666 (calc-sel-reselect calc-keep-selection)
667 (entry (calc-top num 'entry))
669 (sel (or (calc-auto-selection entry) expr))
671 (let ((str (math-showing-full-precision
672 (math-format-nice-expr sel (frame-width)))))
673 (calc-edit-mode (list 'calc-finish-selection-edit
674 num (list 'quote sel) calc-sel-reselect))
676 (calc-show-edit-buffer))
678 (defvar calc-original-buffer)
680 ;; The variable calc-edit-disp-trail is local to calc-edit-finish,
682 (defvar calc-edit-disp-trail)
684 (defun calc-finish-selection-edit (num sel reselect)
685 (let ((buf (current-buffer))
686 (str (buffer-substring (point) (point-max)))
688 (switch-to-buffer calc-original-buffer)
689 (let ((val (math-read-expr str)))
690 (if (eq (car-safe val) 'error)
692 (switch-to-buffer buf)
693 (goto-char (+ start (nth 1 val)))
694 (error (nth 2 val))))
696 (calc-preserve-point)
697 (if calc-edit-disp-trail
698 (calc-trail-display 1 t))
699 (setq val (calc-encase-atoms (calc-normalize val)))
700 (let ((expr (calc-top num 'full)))
701 (if (calc-find-sub-formula expr sel)
702 (calc-pop-push-record-list 1 "edit"
703 (list (calc-replace-sub-formula
706 (list (and reselect val)))
708 (error "Original selection has been lost")))))))
710 (defun calc-sel-evaluate (arg)
713 (calc-preserve-point)
714 (let* ((num (max 1 (calc-locate-cursor-element (point))))
715 (calc-sel-reselect calc-keep-selection)
716 (entry (calc-top num 'entry))
717 (sel (or (calc-auto-selection entry) (car entry))))
718 (calc-with-default-simplification
719 (let ((math-simplify-only nil))
720 (calc-modify-simplify-mode arg)
721 (let ((val (calc-encase-atoms (calc-normalize sel))))
722 (calc-pop-push-record-list 1 "jsmp"
723 (list (calc-replace-sub-formula
724 (car entry) sel val))
726 (list (and calc-sel-reselect val))))))
727 (calc-handle-whys))))
729 (defun calc-sel-expand-formula (arg)
732 (calc-preserve-point)
733 (let* ((num (max 1 (calc-locate-cursor-element (point))))
734 (calc-sel-reselect calc-keep-selection)
735 (entry (calc-top num 'entry))
736 (sel (or (calc-auto-selection entry) (car entry))))
737 (calc-with-default-simplification
738 (let ((math-simplify-only nil))
739 (calc-modify-simplify-mode arg)
740 (let* ((math-expand-formulas (> arg 0))
741 (val (calc-normalize sel))
744 (setq top (math-expand-formula val))
745 (setq val (calc-normalize top)))
746 (setq val (calc-encase-atoms val))
747 (calc-pop-push-record-list 1 "jexf"
748 (list (calc-replace-sub-formula
749 (car entry) sel val))
751 (list (and calc-sel-reselect val))))))
752 (calc-handle-whys))))
754 (defun calc-sel-mult-both-sides (no-simp &optional divide)
757 (calc-preserve-point)
758 (let* ((num (max 1 (calc-locate-cursor-element (point))))
759 (calc-sel-reselect calc-keep-selection)
760 (entry (calc-top num 'entry))
762 (sel (or (calc-auto-selection entry) expr))
763 (func (car-safe sel))
765 (setq alg (calc-with-default-simplification
766 (car (calc-do-alg-entry ""
768 "Divide both sides by: "
769 "Multiply both sides by: ")))))
772 (if (and (or (eq func '/)
773 (assq func calc-tweak-eqn-table))
776 (or (memq func '(/ calcFunc-eq calcFunc-neq))
777 (if (math-known-nonposp alg)
779 (setq func (nth 1 (assq func
780 calc-tweak-eqn-table)))
781 (or (math-known-negp alg)
782 (message "Assuming this factor is nonzero")))
783 (or (math-known-posp alg)
784 (if (math-known-nonnegp alg)
785 (message "Assuming this factor is nonzero")
786 (message "Assuming this factor is positive")))))
787 (setq lhs (list (if divide '/ '*) (nth 1 sel) alg)
788 rhs (list (if divide '/ '*) (nth 2 sel) alg))
791 (setq lhs (math-simplify lhs)
792 rhs (math-simplify rhs))
794 (or (Math-equal (nth 1 sel) 1)
795 (Math-equal (nth 1 sel) -1)
796 (and (memq (car-safe (nth 2 sel)) '(+ -))
797 (memq (car-safe alg) '(+ -))))
798 (setq rhs (math-expand-term rhs)))))
799 (setq alg (calc-encase-atoms
800 (calc-normalize (list func lhs rhs)))))
801 (setq rhs (list (if divide '* '/) sel alg))
803 (setq rhs (math-simplify rhs)))
804 (setq alg (calc-encase-atoms
805 (calc-normalize (if divide
807 (list '* alg rhs))))))
808 (calc-pop-push-record-list 1 (if divide "div" "mult")
809 (list (calc-replace-sub-formula
812 (list (and calc-sel-reselect alg)))))
813 (calc-handle-whys))))
815 (defun calc-sel-div-both-sides (no-simp)
817 (calc-sel-mult-both-sides no-simp t))
819 (defun calc-sel-add-both-sides (no-simp &optional subtract)
822 (calc-preserve-point)
823 (let* ((num (max 1 (calc-locate-cursor-element (point))))
824 (calc-sel-reselect calc-keep-selection)
825 (entry (calc-top num 'entry))
827 (sel (or (calc-auto-selection entry) expr))
828 (func (car-safe sel))
830 (setq alg (calc-with-default-simplification
831 (car (calc-do-alg-entry ""
833 "Subtract from both sides: "
834 "Add to both sides: ")))))
837 (if (and (assq func calc-tweak-eqn-table)
840 (setq lhs (list (if subtract '- '+) (nth 1 sel) alg)
841 rhs (list (if subtract '- '+) (nth 2 sel) alg))
843 (setq lhs (math-simplify lhs)
844 rhs (math-simplify rhs)))
845 (setq alg (calc-encase-atoms
846 (calc-normalize (list func lhs rhs)))))
847 (setq rhs (list (if subtract '+ '-) sel alg))
849 (setq rhs (math-simplify rhs)))
850 (setq alg (calc-encase-atoms
851 (calc-normalize (list (if subtract '- '+) alg rhs)))))
852 (calc-pop-push-record-list 1 (if subtract "sub" "add")
853 (list (calc-replace-sub-formula
856 (list (and calc-sel-reselect alg)))))
857 (calc-handle-whys))))
859 (defun calc-sel-sub-both-sides (no-simp)
861 (calc-sel-add-both-sides no-simp t))
863 ;;; arch-tag: e5169792-777d-428f-bff5-acca66813fa2
864 ;;; calc-sel.el ends here