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 ;; Maintainers: D. Goel <deego@gnufans.org>
7 ;; Colin Walters <walters@debian.org>
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is distributed in the hope that it will be useful,
12 ;; but WITHOUT ANY WARRANTY. No author or distributor
13 ;; accepts responsibility to anyone for the consequences of using it
14 ;; or for whether it serves any particular purpose or works at all,
15 ;; unless he says so in writing. Refer to the GNU Emacs General Public
16 ;; License for full details.
18 ;; Everyone is granted permission to copy, modify and redistribute
19 ;; GNU Emacs, but only under the conditions described in the
20 ;; GNU Emacs General Public License. A copy of this license is
21 ;; supposed to have been given to you along with GNU Emacs so you
22 ;; can know your rights and responsibilities. It should be in a
23 ;; file named COPYING. Among other things, the copyright notice
24 ;; and this notice must be preserved on all copies.
30 ;; This file is autoloaded from calc-ext.el.
35 (defun calc-Need-calc-sel () nil)
38 ;;; Selection commands.
40 (defvar calc-keep-selection t)
42 (defvar calc-selection-cache-entry nil)
43 (defvar calc-selection-cache-num)
44 (defvar calc-selection-cache-comp)
45 (defvar calc-selection-cache-offset)
46 (defvar calc-selection-true-num)
48 (defun calc-select-here (num &optional once keep)
51 (calc-prepare-selection)
52 (let ((found (calc-find-selected-part))
53 (entry calc-selection-cache-entry))
54 (or (and keep (nth 2 entry))
57 (setq calc-keep-selection nil)
58 (message "(Selection will apply to next command only)")))
59 (calc-change-current-selection
61 (if (and num (> (setq num (prefix-numeric-value num)) 0))
63 (while (and (>= (setq num (1- num)) 0)
64 (not (eq found (car entry))))
65 (setq found (calc-find-assoc-parent-formula
68 (calc-grow-assoc-formula (car entry) found))
71 (defun calc-select-once (num)
73 (calc-select-here num t))
75 (defun calc-select-here-maybe (num)
77 (calc-select-here num nil t))
79 (defun calc-select-once-maybe (num)
81 (calc-select-here num t t))
83 (defun calc-select-additional ()
86 (let (calc-keep-selection)
87 (calc-prepare-selection))
88 (let ((found (calc-find-selected-part))
89 (entry calc-selection-cache-entry))
90 (calc-change-current-selection
92 (let ((sel (nth 2 entry)))
95 (while (not (or (eq sel (car entry))
96 (calc-find-sub-formula sel found)))
97 (setq sel (calc-find-assoc-parent-formula
100 (calc-grow-assoc-formula (car entry) found)))
103 (defun calc-select-more (num)
106 (calc-prepare-selection)
107 (let ((entry calc-selection-cache-entry))
109 (let ((sel (nth 2 entry)))
110 (while (and (not (eq sel (car entry)))
111 (>= (setq num (1- (prefix-numeric-value num))) 0))
112 (setq sel (calc-find-assoc-parent-formula (car entry) sel)))
113 (calc-change-current-selection sel))
114 (calc-select-here num)))))
116 (defun calc-select-less (num)
119 (calc-prepare-selection)
120 (let ((found (calc-find-selected-part))
121 (entry calc-selection-cache-entry))
122 (calc-change-current-selection
124 (let ((sel (nth 2 entry))
128 (>= (setq num (1- num)) 0))
130 index (calc-find-sub-formula sel found))
131 (and (setq sel (and index (nth index old)))
132 calc-assoc-selections
133 (setq op (assq (car-safe sel) calc-assoc-ops))
134 (memq (car old) (nth index op))
135 (setq num (1+ num))))
138 (defun calc-select-part (num)
140 (or num (setq num (- last-command-char ?0)))
142 (calc-prepare-selection)
143 (let ((sel (calc-find-nth-part (or (nth 2 calc-selection-cache-entry)
144 (car calc-selection-cache-entry))
147 (calc-change-current-selection sel)
148 (error "%d is not a valid sub-formula index" num)))))
150 ;; The variables calc-fnp-op and calc-fnp-num are local to
151 ;; calc-find-nth-part (and calc-select-previous) but used by
152 ;; calc-find-nth-part-rec, which is called by them.
154 (defvar calc-fnp-num)
156 (defun calc-find-nth-part (expr calc-fnp-num)
157 (if (and calc-assoc-selections
158 (assq (car-safe expr) calc-assoc-ops))
160 (calc-find-nth-part-rec expr))
161 (if (eq (car-safe expr) 'intv)
162 (and (>= calc-fnp-num 1) (<= calc-fnp-num 2) (nth (1+ calc-fnp-num) expr))
163 (and (not (Math-primp expr)) (>= calc-fnp-num 1) (< calc-fnp-num (length expr))
164 (nth calc-fnp-num expr)))))
166 (defun calc-find-nth-part-rec (expr) ; uses num, op
167 (or (if (and (setq calc-fnp-op (assq (car-safe (nth 1 expr)) calc-assoc-ops))
168 (memq (car expr) (nth 1 calc-fnp-op)))
169 (calc-find-nth-part-rec (nth 1 expr))
170 (and (= (setq calc-fnp-num (1- calc-fnp-num)) 0)
172 (if (and (setq calc-fnp-op (assq (car-safe (nth 2 expr)) calc-assoc-ops))
173 (memq (car expr) (nth 2 calc-fnp-op)))
174 (calc-find-nth-part-rec (nth 2 expr))
175 (and (= (setq calc-fnp-num (1- calc-fnp-num)) 0)
178 (defun calc-select-next (num)
181 (calc-select-previous (- num))
183 (calc-prepare-selection)
184 (let* ((entry calc-selection-cache-entry)
188 (while (>= (setq num (1- num)) 0)
189 (let* ((parent (calc-find-parent-formula (car entry) sel))
192 (and (eq p t) (setq p nil))
193 (while (and (setq p (cdr p))
194 (not (eq (car p) sel))))
196 (setq sel (or (and calc-assoc-selections
197 (setq op (assq (car-safe (nth 1 p))
199 (memq (car parent) (nth 2 op))
202 (if (and calc-assoc-selections
203 (setq op (assq (car-safe parent) calc-assoc-ops))
204 (consp (setq p (calc-find-parent-formula
205 (car entry) parent)))
206 (eq (nth 1 p) parent)
207 (memq (car p) (nth 1 op)))
209 (error "No \"next\" sub-formula")))))
210 (calc-change-current-selection sel))
211 (if (Math-primp (car entry))
212 (calc-change-current-selection (car entry))
213 (calc-select-part num)))))))
215 (defun calc-select-previous (num)
218 (calc-select-next (- num))
220 (calc-prepare-selection)
221 (let* ((entry calc-selection-cache-entry)
225 (while (>= (setq num (1- num)) 0)
226 (let* ((parent (calc-find-parent-formula (car entry) sel))
227 (p (cdr-safe parent))
230 (if (eq (car-safe parent) 'intv) (setq p (cdr p)))
231 (while (and (not (eq (car p) sel))
235 (setq sel (or (and calc-assoc-selections
236 (setq op (assq (car-safe prev)
238 (memq (car parent) (nth 1 op))
241 (if (and calc-assoc-selections
242 (setq op (assq (car-safe parent) calc-assoc-ops))
243 (consp (setq p (calc-find-parent-formula
244 (car entry) parent)))
245 (eq (nth 2 p) parent)
246 (memq (car p) (nth 2 op)))
248 (error "No \"previous\" sub-formula")))))
249 (calc-change-current-selection sel))
250 (if (Math-primp (car entry))
251 (calc-change-current-selection (car entry))
252 (let ((len (if (and calc-assoc-selections
253 (assq (car (car entry)) calc-assoc-ops))
254 (let (calc-fnp-op (calc-fnp-num 0))
255 (calc-find-nth-part-rec (car entry))
257 (length (car entry)))))
258 (calc-select-part (- len num)))))))))
260 (defun calc-find-parent-formula (expr part)
261 (cond ((eq expr part) t)
262 ((Math-primp expr) nil)
265 (while (and (setq p (cdr p))
266 (not (setq res (calc-find-parent-formula
269 (if (eq res t) expr res))))))
272 (defun calc-find-assoc-parent-formula (expr part)
273 (calc-grow-assoc-formula expr (calc-find-parent-formula expr part)))
275 (defun calc-grow-assoc-formula (expr part)
276 (if calc-assoc-selections
277 (let ((op (assq (car-safe part) calc-assoc-ops)))
280 (while (and (consp (setq new (calc-find-parent-formula
283 (nth (calc-find-sub-formula new part) op)))
288 (defun calc-find-sub-formula (expr part)
289 (cond ((eq expr part) t)
290 ((Math-primp expr) nil)
293 (while (and (setq expr (cdr expr))
294 (not (calc-find-sub-formula (car expr) part)))
298 (defun calc-unselect (num)
301 (calc-prepare-selection num)
302 (calc-change-current-selection nil)))
304 (defun calc-clear-selections ()
307 (let ((limit (calc-stack-size))
310 (if (calc-top n 'sel)
312 (calc-prepare-selection n)
313 (calc-change-current-selection nil)))
315 (calc-clear-command-flag 'position-point)))
317 (defun calc-show-selections (arg)
320 (calc-preserve-point)
321 (setq calc-show-selections (if arg
322 (> (prefix-numeric-value arg) 0)
323 (not calc-show-selections)))
324 (let ((p calc-stack))
326 (or (null (nth 2 (car p)))
327 (equal (car p) calc-selection-cache-entry)))
330 (let ((calc-selection-cache-default-entry
331 calc-selection-cache-entry))
333 (and calc-selection-cache-entry
334 (let ((sel (nth 2 calc-selection-cache-entry)))
335 (setcar (nthcdr 2 calc-selection-cache-entry) nil)
336 (calc-change-current-selection sel)))))
337 (message (if calc-show-selections
338 "Displaying only selected part of formulas"
339 "Displaying all but selected part of formulas"))))
341 ;; The variables calc-final-point-line and calc-final-point-column
342 ;; are declared in calc.el, and are used throughout.
343 (defvar calc-final-point-line)
344 (defvar calc-final-point-column)
346 (defun calc-preserve-point ()
347 (or (looking-at "\\.\n+\\'")
349 (setq calc-final-point-line (+ (count-lines (point-min) (point))
351 calc-final-point-column (current-column))
352 (calc-set-command-flag 'position-point))))
354 (defun calc-enable-selections (arg)
357 (calc-preserve-point)
358 (setq calc-use-selections (if arg
359 (> (prefix-numeric-value arg) 0)
360 (not calc-use-selections)))
361 (calc-set-command-flag 'renum-stack)
362 (message (if calc-use-selections
363 "Commands operate only on selected sub-formulas"
364 "Selections of sub-formulas have no effect"))))
366 (defun calc-break-selections (arg)
369 (calc-preserve-point)
370 (setq calc-assoc-selections (if arg
371 (<= (prefix-numeric-value arg) 0)
372 (not calc-assoc-selections)))
373 (message (if calc-assoc-selections
374 "Selection treats a+b+c as a sum of three terms"
375 "Selection treats a+b+c as (a+b)+c"))))
377 (defun calc-prepare-selection (&optional num)
378 (or num (setq num (calc-locate-cursor-element (point))))
379 (setq calc-selection-true-num num
380 calc-keep-selection t)
381 (or (> num 0) (setq num 1))
382 ;; (if (or (< num 1) (> num (calc-stack-size)))
383 ;; (error "Cursor must be positioned on a stack element"))
384 (let* ((entry (calc-top num 'entry))
386 (or (equal entry calc-selection-cache-entry)
388 (setcar entry (calc-encase-atoms (car entry)))
389 (setq calc-selection-cache-entry entry
390 calc-selection-cache-num num
391 calc-selection-cache-comp
392 (let ((math-comp-tagged t))
393 (math-compose-expr (car entry) 0))
394 calc-selection-cache-offset
395 (+ (car (math-stack-value-offset calc-selection-cache-comp))
396 (length calc-left-label)
397 (if calc-line-numbering 4 0))))))
398 (calc-preserve-point))
400 ;;; The following ensures that no two subformulas will be "eq" to each other!
401 (defun calc-encase-atoms (x)
402 (if (or (not (consp x))
403 (equal x '(float 0 0)))
405 (calc-encase-atoms-rec x)
408 (defun calc-encase-atoms-rec (x)
411 (if (eq (car x) 'intv)
413 (while (setq x (cdr x))
414 (if (or (not (consp (car x)))
415 (equal (car x) '(float 0 0)))
416 (setcar x (list 'cplx (car x) 0))
417 (calc-encase-atoms-rec (car x)))))))
419 (defun calc-find-selected-part ()
420 (let* ((math-comp-sel-hpos (- (current-column) calc-selection-cache-offset))
424 (math-comp-sel-vpos (save-excursion
426 (let ((line (point)))
427 (calc-cursor-stack-index
428 calc-selection-cache-num)
430 (while (< (point) line)
432 (setq spaces (+ spaces
433 (current-indentation))
435 (- lcount (math-comp-ascent
436 calc-selection-cache-comp) -1))))
437 (math-comp-sel-cpos (- (point) toppt calc-selection-cache-offset
439 (math-comp-sel-tag nil))
440 (and (>= math-comp-sel-hpos 0)
441 (> calc-selection-true-num 0)
442 (math-composition-to-string calc-selection-cache-comp 1000000))
443 (nth 1 math-comp-sel-tag)))
445 (defun calc-change-current-selection (sub-expr)
446 (or (eq sub-expr (nth 2 calc-selection-cache-entry))
447 (let ((calc-prepared-composition calc-selection-cache-comp)
448 (buffer-read-only nil)
450 (calc-set-command-flag 'renum-stack)
451 (setcar (nthcdr 2 calc-selection-cache-entry) sub-expr)
452 (calc-cursor-stack-index calc-selection-cache-num)
454 (calc-cursor-stack-index (1- calc-selection-cache-num))
455 (delete-region top (point))
456 (let ((calc-selection-cache-default-entry calc-selection-cache-entry))
457 (insert (math-format-stack-value calc-selection-cache-entry)
460 (defun calc-top-selected (&optional n m)
461 (and calc-any-selections
466 (calc-check-stack (+ n m -1))
467 (let ((top (nthcdr (+ m calc-stack-top -1) calc-stack))
469 (while (>= (setq n (1- n)) 0)
470 (if (nth 2 (car top))
471 (setq sel (if sel t (nth 2 (car top)))))
472 (setq top (cdr top)))
475 ;; The variables calc-rsf-old and calc-rsf-new are local to
476 ;; calc-replace-sub-formula, but used by calc-replace-sub-formula-rec,
477 ;; which is called by calc-replace-sub-formula.
478 (defvar calc-rsf-old)
479 (defvar calc-rsf-new)
481 (defun calc-replace-sub-formula (expr calc-rsf-old calc-rsf-new)
482 (setq calc-rsf-new (calc-encase-atoms calc-rsf-new))
483 (calc-replace-sub-formula-rec expr))
485 (defun calc-replace-sub-formula-rec (expr)
486 (cond ((eq expr calc-rsf-old) calc-rsf-new)
487 ((Math-primp expr) expr)
490 (mapcar 'calc-replace-sub-formula-rec (cdr expr))))))
492 (defun calc-sel-error ()
493 (error "Illegal operation on sub-formulas"))
495 (defun calc-replace-selections (n vals m)
496 (if (calc-top-selected n m)
497 (let ((num (length vals)))
498 (calc-preserve-point)
501 (let* ((old (calc-top-list n m 'entry))
506 (if (nth 2 (car old))
507 (setq val (calc-encase-atoms (car vals))
508 new (cons (calc-replace-sub-formula (car (car old))
513 (setq new (cons (car vals) new)
515 (setq vals (cdr vals)
517 (calc-pop-stack n m t)
518 (calc-push-list (nreverse new)
519 m (and calc-keep-selection (nreverse sel)))))
521 (let* ((old (calc-top-list n m 'entry))
523 (while (and old (not (nth 2 (car old))))
524 (setq old (cdr old)))
526 (while (and (setq more (cdr more)) (not (nth 2 (car more)))))
529 (calc-pop-stack n m t)
531 (let ((val (calc-encase-atoms (car vals))))
532 (calc-push-list (list (calc-replace-sub-formula
536 m (and calc-keep-selection (list val))))
537 (calc-push-list vals))))
538 (t (calc-sel-error))))
539 (calc-pop-stack n m t)
540 (calc-push-list vals m)))
542 (defun calc-delete-selection (n)
543 (let ((entry (calc-top n 'entry)))
545 (if (eq (nth 2 entry) (car entry))
547 (calc-pop-stack 1 n t)
548 (calc-push-list '(0) n))
549 (let ((parent (calc-find-parent-formula (car entry) (nth 2 entry)))
551 (calc-preserve-point)
552 (calc-pop-stack 1 n t)
553 (cond ((or (memq (car parent) '(* / %))
554 (and (eq (car parent) '^)
555 (eq (nth 2 parent) (nth 2 entry))))
557 ((memq (car parent) '(vec calcFunc-min calcFunc-max)))
558 ((and (assq (car parent) calc-tweak-eqn-table)
559 (= (length parent) 3))
565 (calc-push-list (list
567 (calc-replace-sub-formula
570 (if (eq (nth 2 entry) (nth 1 parent))
575 (calc-push-list (list
577 (calc-replace-sub-formula (car entry)
582 (calc-push-list (list
584 (calc-replace-sub-formula (car entry)
590 (calc-pop-stack 1 n t))))
592 (defun calc-roll-down-with-selections (n m)
593 (let ((vals (append (calc-top-list m 1)
594 (calc-top-list (- n m) (1+ m))))
595 (sels (append (calc-top-list m 1 'sel)
596 (calc-top-list (- n m) (1+ m) 'sel))))
597 (calc-pop-push-list n vals 1 sels)))
599 (defun calc-roll-up-with-selections (n m)
600 (let ((vals (append (calc-top-list (- n m) 1)
601 (calc-top-list m (- n m -1))))
602 (sels (append (calc-top-list (- n m) 1 'sel)
603 (calc-top-list m (- n m -1) 'sel))))
604 (calc-pop-push-list n vals 1 sels)))
606 ;; The variable calc-sel-reselect is local to several functions
607 ;; which call calc-auto-selection.
608 (defvar calc-sel-reselect)
610 (defun calc-auto-selection (entry)
613 (setq calc-sel-reselect nil)
614 (calc-prepare-selection)
615 (calc-grow-assoc-formula (car entry) (calc-find-selected-part)))))
617 (defun calc-copy-selection ()
620 (calc-preserve-point)
621 (let* ((num (max 1 (calc-locate-cursor-element (point))))
622 (entry (calc-top num 'entry)))
623 (calc-push (or (calc-auto-selection entry) (car entry))))))
625 (defun calc-del-selection ()
628 (calc-preserve-point)
629 (let* ((num (max 1 (calc-locate-cursor-element (point))))
630 (entry (calc-top num 'entry))
631 (sel (calc-auto-selection entry)))
632 (setcar (nthcdr 2 entry) (and (not (eq sel (car entry))) sel))
633 (calc-delete-selection num))))
635 (defun calc-enter-selection ()
638 (calc-preserve-point)
639 (let* ((num (max 1 (calc-locate-cursor-element (point))))
640 (calc-sel-reselect calc-keep-selection)
641 (entry (calc-top num 'entry))
643 (sel (or (calc-auto-selection entry) expr))
645 (let ((calc-dollar-values (list sel))
646 (calc-dollar-used 0))
647 (setq alg (calc-do-alg-entry "" "Replace selection with: "))
650 (setq alg (calc-encase-atoms (car alg)))
651 (calc-pop-push-record-list 1 "repl"
652 (list (calc-replace-sub-formula
655 (list (and calc-sel-reselect alg))))))
656 (calc-handle-whys))))
658 (defun calc-edit-selection ()
661 (calc-preserve-point)
662 (let* ((num (max 1 (calc-locate-cursor-element (point))))
663 (calc-sel-reselect calc-keep-selection)
664 (entry (calc-top num 'entry))
666 (sel (or (calc-auto-selection entry) expr))
668 (let ((str (math-showing-full-precision
669 (math-format-nice-expr sel (frame-width)))))
670 (calc-edit-mode (list 'calc-finish-selection-edit
671 num (list 'quote sel) calc-sel-reselect))
673 (calc-show-edit-buffer))
675 (defvar calc-original-buffer)
677 ;; The variable calc-edit-disp-trail is local to calc-edit-finish,
679 (defvar calc-edit-disp-trail)
681 (defun calc-finish-selection-edit (num sel reselect)
682 (let ((buf (current-buffer))
683 (str (buffer-substring (point) (point-max)))
685 (switch-to-buffer calc-original-buffer)
686 (let ((val (math-read-expr str)))
687 (if (eq (car-safe val) 'error)
689 (switch-to-buffer buf)
690 (goto-char (+ start (nth 1 val)))
691 (error (nth 2 val))))
693 (calc-preserve-point)
694 (if calc-edit-disp-trail
695 (calc-trail-display 1 t))
696 (setq val (calc-encase-atoms (calc-normalize val)))
697 (let ((expr (calc-top num 'full)))
698 (if (calc-find-sub-formula expr sel)
699 (calc-pop-push-record-list 1 "edit"
700 (list (calc-replace-sub-formula
703 (list (and reselect val)))
705 (error "Original selection has been lost")))))))
707 (defun calc-sel-evaluate (arg)
710 (calc-preserve-point)
711 (let* ((num (max 1 (calc-locate-cursor-element (point))))
712 (calc-sel-reselect calc-keep-selection)
713 (entry (calc-top num 'entry))
714 (sel (or (calc-auto-selection entry) (car entry))))
715 (calc-with-default-simplification
716 (let ((math-simplify-only nil))
717 (calc-modify-simplify-mode arg)
718 (let ((val (calc-encase-atoms (calc-normalize sel))))
719 (calc-pop-push-record-list 1 "jsmp"
720 (list (calc-replace-sub-formula
721 (car entry) sel val))
723 (list (and calc-sel-reselect val))))))
724 (calc-handle-whys))))
726 (defun calc-sel-expand-formula (arg)
729 (calc-preserve-point)
730 (let* ((num (max 1 (calc-locate-cursor-element (point))))
731 (calc-sel-reselect calc-keep-selection)
732 (entry (calc-top num 'entry))
733 (sel (or (calc-auto-selection entry) (car entry))))
734 (calc-with-default-simplification
735 (let ((math-simplify-only nil))
736 (calc-modify-simplify-mode arg)
737 (let* ((math-expand-formulas (> arg 0))
738 (val (calc-normalize sel))
741 (setq top (math-expand-formula val))
742 (setq val (calc-normalize top)))
743 (setq val (calc-encase-atoms val))
744 (calc-pop-push-record-list 1 "jexf"
745 (list (calc-replace-sub-formula
746 (car entry) sel val))
748 (list (and calc-sel-reselect val))))))
749 (calc-handle-whys))))
751 (defun calc-sel-mult-both-sides (no-simp &optional divide)
754 (calc-preserve-point)
755 (let* ((num (max 1 (calc-locate-cursor-element (point))))
756 (calc-sel-reselect calc-keep-selection)
757 (entry (calc-top num 'entry))
759 (sel (or (calc-auto-selection entry) expr))
760 (func (car-safe sel))
762 (setq alg (calc-with-default-simplification
763 (car (calc-do-alg-entry ""
765 "Divide both sides by: "
766 "Multiply both sides by: ")))))
769 (if (and (or (eq func '/)
770 (assq func calc-tweak-eqn-table))
773 (or (memq func '(/ calcFunc-eq calcFunc-neq))
774 (if (math-known-nonposp alg)
776 (setq func (nth 1 (assq func
777 calc-tweak-eqn-table)))
778 (or (math-known-negp alg)
779 (message "Assuming this factor is nonzero")))
780 (or (math-known-posp alg)
781 (if (math-known-nonnegp alg)
782 (message "Assuming this factor is nonzero")
783 (message "Assuming this factor is positive")))))
784 (setq lhs (list (if divide '/ '*) (nth 1 sel) alg)
785 rhs (list (if divide '/ '*) (nth 2 sel) alg))
788 (setq lhs (math-simplify lhs)
789 rhs (math-simplify rhs))
791 (or (Math-equal (nth 1 sel) 1)
792 (Math-equal (nth 1 sel) -1)
793 (and (memq (car-safe (nth 2 sel)) '(+ -))
794 (memq (car-safe alg) '(+ -))))
795 (setq rhs (math-expand-term rhs)))))
796 (setq alg (calc-encase-atoms
797 (calc-normalize (list func lhs rhs)))))
798 (setq rhs (list (if divide '* '/) sel alg))
800 (setq rhs (math-simplify rhs)))
801 (setq alg (calc-encase-atoms
802 (calc-normalize (if divide
804 (list '* alg rhs))))))
805 (calc-pop-push-record-list 1 (if divide "div" "mult")
806 (list (calc-replace-sub-formula
809 (list (and calc-sel-reselect alg)))))
810 (calc-handle-whys))))
812 (defun calc-sel-div-both-sides (no-simp)
814 (calc-sel-mult-both-sides no-simp t))
816 (defun calc-sel-add-both-sides (no-simp &optional subtract)
819 (calc-preserve-point)
820 (let* ((num (max 1 (calc-locate-cursor-element (point))))
821 (calc-sel-reselect calc-keep-selection)
822 (entry (calc-top num 'entry))
824 (sel (or (calc-auto-selection entry) expr))
825 (func (car-safe sel))
827 (setq alg (calc-with-default-simplification
828 (car (calc-do-alg-entry ""
830 "Subtract from both sides: "
831 "Add to both sides: ")))))
834 (if (and (assq func calc-tweak-eqn-table)
837 (setq lhs (list (if subtract '- '+) (nth 1 sel) alg)
838 rhs (list (if subtract '- '+) (nth 2 sel) alg))
840 (setq lhs (math-simplify lhs)
841 rhs (math-simplify rhs)))
842 (setq alg (calc-encase-atoms
843 (calc-normalize (list func lhs rhs)))))
844 (setq rhs (list (if subtract '+ '-) sel alg))
846 (setq rhs (math-simplify rhs)))
847 (setq alg (calc-encase-atoms
848 (calc-normalize (list (if subtract '- '+) alg rhs)))))
849 (calc-pop-push-record-list 1 (if subtract "sub" "add")
850 (list (calc-replace-sub-formula
853 (list (and calc-sel-reselect alg)))))
854 (calc-handle-whys))))
856 (defun calc-sel-sub-both-sides (no-simp)
858 (calc-sel-add-both-sides no-simp t))
860 ;;; arch-tag: e5169792-777d-428f-bff5-acca66813fa2
861 ;;; calc-sel.el ends here