1 ;;; calc-sel.el --- data selection functions for Calc
3 ;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004,
4 ;; 2005, 2006, 2007 Free Software Foundation, Inc.
6 ;; Author: David Gillespie <daveg@synaptics.com>
7 ;; Maintainer: Jay Belanger <belanger@truman.edu>
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software; you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your option)
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
24 ;; Boston, MA 02110-1301, USA.
30 ;; This file is autoloaded from calc-ext.el.
35 ;;; Selection commands.
37 (defvar calc-keep-selection t)
39 (defvar calc-selection-cache-entry nil)
40 (defvar calc-selection-cache-num)
41 (defvar calc-selection-cache-comp)
42 (defvar calc-selection-cache-offset)
43 (defvar calc-selection-true-num)
45 (defun calc-select-here (num &optional once keep)
48 (calc-prepare-selection)
49 (let ((found (calc-find-selected-part))
50 (entry calc-selection-cache-entry))
51 (or (and keep (nth 2 entry))
54 (setq calc-keep-selection nil)
55 (message "(Selection will apply to next command only)")))
56 (calc-change-current-selection
58 (if (and num (> (setq num (prefix-numeric-value num)) 0))
60 (while (and (>= (setq num (1- num)) 0)
61 (not (eq found (car entry))))
62 (setq found (calc-find-assoc-parent-formula
65 (calc-grow-assoc-formula (car entry) found))
68 (defun calc-select-once (num)
70 (calc-select-here num t))
72 (defun calc-select-here-maybe (num)
74 (calc-select-here num nil t))
76 (defun calc-select-once-maybe (num)
78 (calc-select-here num t t))
80 (defun calc-select-additional ()
83 (let (calc-keep-selection)
84 (calc-prepare-selection))
85 (let ((found (calc-find-selected-part))
86 (entry calc-selection-cache-entry))
87 (calc-change-current-selection
89 (let ((sel (nth 2 entry)))
92 (while (not (or (eq sel (car entry))
93 (calc-find-sub-formula sel found)))
94 (setq sel (calc-find-assoc-parent-formula
97 (calc-grow-assoc-formula (car entry) found)))
100 (defun calc-select-more (num)
103 (calc-prepare-selection)
104 (let ((entry calc-selection-cache-entry))
106 (let ((sel (nth 2 entry)))
107 (while (and (not (eq sel (car entry)))
108 (>= (setq num (1- (prefix-numeric-value num))) 0))
109 (setq sel (calc-find-assoc-parent-formula (car entry) sel)))
110 (calc-change-current-selection sel))
111 (calc-select-here num)))))
113 (defun calc-select-less (num)
116 (calc-prepare-selection)
117 (let ((found (calc-find-selected-part))
118 (entry calc-selection-cache-entry))
119 (calc-change-current-selection
121 (let ((sel (nth 2 entry))
125 (>= (setq num (1- num)) 0))
127 index (calc-find-sub-formula sel found))
128 (and (setq sel (and index (nth index old)))
129 calc-assoc-selections
130 (setq op (assq (car-safe sel) calc-assoc-ops))
131 (memq (car old) (nth index op))
132 (setq num (1+ num))))
135 (defun calc-select-part (num)
137 (or num (setq num (- last-command-char ?0)))
139 (calc-prepare-selection)
140 (let ((sel (calc-find-nth-part (or (nth 2 calc-selection-cache-entry)
141 (car calc-selection-cache-entry))
144 (calc-change-current-selection sel)
145 (error "%d is not a valid sub-formula index" num)))))
147 ;; The variables calc-fnp-op and calc-fnp-num are local to
148 ;; calc-find-nth-part (and calc-select-previous) but used by
149 ;; calc-find-nth-part-rec, which is called by them.
151 (defvar calc-fnp-num)
153 (defun calc-find-nth-part (expr calc-fnp-num)
154 (if (and calc-assoc-selections
155 (assq (car-safe expr) calc-assoc-ops))
157 (calc-find-nth-part-rec expr))
158 (if (eq (car-safe expr) 'intv)
159 (and (>= calc-fnp-num 1) (<= calc-fnp-num 2) (nth (1+ calc-fnp-num) expr))
160 (and (not (Math-primp expr)) (>= calc-fnp-num 1) (< calc-fnp-num (length expr))
161 (nth calc-fnp-num expr)))))
163 (defun calc-find-nth-part-rec (expr) ; uses num, op
164 (or (if (and (setq calc-fnp-op (assq (car-safe (nth 1 expr)) calc-assoc-ops))
165 (memq (car expr) (nth 1 calc-fnp-op)))
166 (calc-find-nth-part-rec (nth 1 expr))
167 (and (= (setq calc-fnp-num (1- calc-fnp-num)) 0)
169 (if (and (setq calc-fnp-op (assq (car-safe (nth 2 expr)) calc-assoc-ops))
170 (memq (car expr) (nth 2 calc-fnp-op)))
171 (calc-find-nth-part-rec (nth 2 expr))
172 (and (= (setq calc-fnp-num (1- calc-fnp-num)) 0)
175 (defun calc-select-next (num)
178 (calc-select-previous (- num))
180 (calc-prepare-selection)
181 (let* ((entry calc-selection-cache-entry)
185 (while (>= (setq num (1- num)) 0)
186 (let* ((parent (calc-find-parent-formula (car entry) sel))
189 (and (eq p t) (setq p nil))
190 (while (and (setq p (cdr p))
191 (not (eq (car p) sel))))
193 (setq sel (or (and calc-assoc-selections
194 (setq op (assq (car-safe (nth 1 p))
196 (memq (car parent) (nth 2 op))
199 (if (and calc-assoc-selections
200 (setq op (assq (car-safe parent) calc-assoc-ops))
201 (consp (setq p (calc-find-parent-formula
202 (car entry) parent)))
203 (eq (nth 1 p) parent)
204 (memq (car p) (nth 1 op)))
206 (error "No \"next\" sub-formula")))))
207 (calc-change-current-selection sel))
208 (if (Math-primp (car entry))
209 (calc-change-current-selection (car entry))
210 (calc-select-part num)))))))
212 (defun calc-select-previous (num)
215 (calc-select-next (- num))
217 (calc-prepare-selection)
218 (let* ((entry calc-selection-cache-entry)
222 (while (>= (setq num (1- num)) 0)
223 (let* ((parent (calc-find-parent-formula (car entry) sel))
224 (p (cdr-safe parent))
227 (if (eq (car-safe parent) 'intv) (setq p (cdr p)))
228 (while (and (not (eq (car p) sel))
232 (setq sel (or (and calc-assoc-selections
233 (setq op (assq (car-safe prev)
235 (memq (car parent) (nth 1 op))
238 (if (and calc-assoc-selections
239 (setq op (assq (car-safe parent) calc-assoc-ops))
240 (consp (setq p (calc-find-parent-formula
241 (car entry) parent)))
242 (eq (nth 2 p) parent)
243 (memq (car p) (nth 2 op)))
245 (error "No \"previous\" sub-formula")))))
246 (calc-change-current-selection sel))
247 (if (Math-primp (car entry))
248 (calc-change-current-selection (car entry))
249 (let ((len (if (and calc-assoc-selections
250 (assq (car (car entry)) calc-assoc-ops))
251 (let (calc-fnp-op (calc-fnp-num 0))
252 (calc-find-nth-part-rec (car entry))
254 (length (car entry)))))
255 (calc-select-part (- len num)))))))))
257 (defun calc-find-parent-formula (expr part)
258 (cond ((eq expr part) t)
259 ((Math-primp expr) nil)
262 (while (and (setq p (cdr p))
263 (not (setq res (calc-find-parent-formula
266 (if (eq res t) expr res))))))
269 (defun calc-find-assoc-parent-formula (expr part)
270 (calc-grow-assoc-formula expr (calc-find-parent-formula expr part)))
272 (defun calc-grow-assoc-formula (expr part)
273 (if calc-assoc-selections
274 (let ((op (assq (car-safe part) calc-assoc-ops)))
277 (while (and (consp (setq new (calc-find-parent-formula
280 (nth (calc-find-sub-formula new part) op)))
285 (defun calc-find-sub-formula (expr part)
286 (cond ((eq expr part) t)
287 ((Math-primp expr) nil)
290 (while (and (setq expr (cdr expr))
291 (not (calc-find-sub-formula (car expr) part)))
295 (defun calc-unselect (num)
298 (calc-prepare-selection num)
299 (calc-change-current-selection nil)))
301 (defun calc-clear-selections ()
304 (let ((limit (calc-stack-size))
307 (if (calc-top n 'sel)
309 (calc-prepare-selection n)
310 (calc-change-current-selection nil)))
312 (calc-clear-command-flag 'position-point)))
314 (defun calc-show-selections (arg)
317 (calc-preserve-point)
318 (setq calc-show-selections (if arg
319 (> (prefix-numeric-value arg) 0)
320 (not calc-show-selections)))
321 (let ((p calc-stack))
323 (or (null (nth 2 (car p)))
324 (equal (car p) calc-selection-cache-entry)))
327 (let ((calc-selection-cache-default-entry
328 calc-selection-cache-entry))
330 (and calc-selection-cache-entry
331 (let ((sel (nth 2 calc-selection-cache-entry)))
332 (setcar (nthcdr 2 calc-selection-cache-entry) nil)
333 (calc-change-current-selection sel)))))
334 (message (if calc-show-selections
335 "Displaying only selected part of formulas"
336 "Displaying all but selected part of formulas"))))
338 ;; The variables calc-final-point-line and calc-final-point-column
339 ;; are declared in calc.el, and are used throughout.
340 (defvar calc-final-point-line)
341 (defvar calc-final-point-column)
343 (defun calc-preserve-point ()
344 (or (looking-at "\\.\n+\\'")
346 (setq calc-final-point-line (+ (count-lines (point-min) (point))
348 calc-final-point-column (current-column))
349 (calc-set-command-flag 'position-point))))
351 (defun calc-enable-selections (arg)
354 (calc-preserve-point)
355 (setq calc-use-selections (if arg
356 (> (prefix-numeric-value arg) 0)
357 (not calc-use-selections)))
358 (calc-set-command-flag 'renum-stack)
359 (message (if calc-use-selections
360 "Commands operate only on selected sub-formulas"
361 "Selections of sub-formulas have no effect"))))
363 (defun calc-break-selections (arg)
366 (calc-preserve-point)
367 (setq calc-assoc-selections (if arg
368 (<= (prefix-numeric-value arg) 0)
369 (not calc-assoc-selections)))
370 (message (if calc-assoc-selections
371 "Selection treats a+b+c as a sum of three terms"
372 "Selection treats a+b+c as (a+b)+c"))))
374 (defun calc-prepare-selection (&optional num)
375 (or num (setq num (calc-locate-cursor-element (point))))
376 (setq calc-selection-true-num num
377 calc-keep-selection t)
378 (or (> num 0) (setq num 1))
379 ;; (if (or (< num 1) (> num (calc-stack-size)))
380 ;; (error "Cursor must be positioned on a stack element"))
381 (let* ((entry (calc-top num 'entry))
383 (or (equal entry calc-selection-cache-entry)
385 (setcar entry (calc-encase-atoms (car entry)))
386 (setq calc-selection-cache-entry entry
387 calc-selection-cache-num num
388 calc-selection-cache-comp
389 (let ((math-comp-tagged t))
390 (math-compose-expr (car entry) 0))
391 calc-selection-cache-offset
392 (+ (car (math-stack-value-offset calc-selection-cache-comp))
393 (length calc-left-label)
394 (if calc-line-numbering 4 0))))))
395 (calc-preserve-point))
397 ;;; The following ensures that no two subformulas will be "eq" to each other!
398 (defun calc-encase-atoms (x)
399 (if (or (not (consp x))
400 (equal x '(float 0 0)))
402 (calc-encase-atoms-rec x)
405 (defun calc-encase-atoms-rec (x)
408 (if (eq (car x) 'intv)
410 (while (setq x (cdr x))
411 (if (or (not (consp (car x)))
412 (equal (car x) '(float 0 0)))
413 (setcar x (list 'cplx (car x) 0))
414 (calc-encase-atoms-rec (car x)))))))
416 ;; The variable math-comp-sel-tag is local to calc-find-selected-part,
417 ;; but is used by math-comp-sel-flat-term and math-comp-add-string-sel
418 ;; in calccomp.el, which are called (indirectly) by calc-find-selected-part.
420 (defun calc-find-selected-part ()
421 (let* ((math-comp-sel-hpos (- (current-column) calc-selection-cache-offset))
425 (math-comp-sel-vpos (save-excursion
427 (let ((line (point)))
428 (calc-cursor-stack-index
429 calc-selection-cache-num)
431 (while (< (point) line)
433 (setq spaces (+ spaces
434 (current-indentation))
436 (- lcount (math-comp-ascent
437 calc-selection-cache-comp) -1))))
438 (math-comp-sel-cpos (- (point) toppt calc-selection-cache-offset
440 (math-comp-sel-tag nil))
441 (and (>= math-comp-sel-hpos 0)
442 (> calc-selection-true-num 0)
443 (math-composition-to-string calc-selection-cache-comp 1000000))
444 (nth 1 math-comp-sel-tag)))
446 (defun calc-change-current-selection (sub-expr)
447 (or (eq sub-expr (nth 2 calc-selection-cache-entry))
448 (let ((calc-prepared-composition calc-selection-cache-comp)
449 (buffer-read-only nil)
451 (calc-set-command-flag 'renum-stack)
452 (setcar (nthcdr 2 calc-selection-cache-entry) sub-expr)
453 (calc-cursor-stack-index calc-selection-cache-num)
455 (calc-cursor-stack-index (1- calc-selection-cache-num))
456 (delete-region top (point))
457 (let ((calc-selection-cache-default-entry calc-selection-cache-entry))
458 (insert (math-format-stack-value calc-selection-cache-entry)
461 (defun calc-top-selected (&optional n m)
462 (and calc-any-selections
467 (calc-check-stack (+ n m -1))
468 (let ((top (nthcdr (+ m calc-stack-top -1) calc-stack))
470 (while (>= (setq n (1- n)) 0)
471 (if (nth 2 (car top))
472 (setq sel (if sel t (nth 2 (car top)))))
473 (setq top (cdr top)))
476 ;; The variables calc-rsf-old and calc-rsf-new are local to
477 ;; calc-replace-sub-formula, but used by calc-replace-sub-formula-rec,
478 ;; which is called by calc-replace-sub-formula.
479 (defvar calc-rsf-old)
480 (defvar calc-rsf-new)
482 (defun calc-replace-sub-formula (expr calc-rsf-old calc-rsf-new)
483 (setq calc-rsf-new (calc-encase-atoms calc-rsf-new))
484 (calc-replace-sub-formula-rec expr))
486 (defun calc-replace-sub-formula-rec (expr)
487 (cond ((eq expr calc-rsf-old) calc-rsf-new)
488 ((Math-primp expr) expr)
491 (mapcar 'calc-replace-sub-formula-rec (cdr expr))))))
493 (defun calc-sel-error ()
494 (error "Invalid operation on sub-formulas"))
496 (defun calc-replace-selections (n vals m)
497 (if (calc-top-selected n m)
498 (let ((num (length vals)))
499 (calc-preserve-point)
502 (let* ((old (calc-top-list n m 'entry))
507 (if (nth 2 (car old))
508 (setq val (calc-encase-atoms (car vals))
509 new (cons (calc-replace-sub-formula (car (car old))
514 (setq new (cons (car vals) new)
516 (setq vals (cdr vals)
518 (calc-pop-stack n m t)
519 (calc-push-list (nreverse new)
520 m (and calc-keep-selection (nreverse sel)))))
522 (let* ((old (calc-top-list n m 'entry))
524 (while (and old (not (nth 2 (car old))))
525 (setq old (cdr old)))
527 (while (and (setq more (cdr more)) (not (nth 2 (car more)))))
530 (calc-pop-stack n m t)
532 (let ((val (calc-encase-atoms (car vals))))
533 (calc-push-list (list (calc-replace-sub-formula
537 m (and calc-keep-selection (list val))))
538 (calc-push-list vals))))
539 (t (calc-sel-error))))
540 (calc-pop-stack n m t)
541 (calc-push-list vals m)))
543 (defun calc-delete-selection (n)
544 (let ((entry (calc-top n 'entry)))
546 (if (eq (nth 2 entry) (car entry))
548 (calc-pop-stack 1 n t)
549 (calc-push-list '(0) n))
550 (let ((parent (calc-find-parent-formula (car entry) (nth 2 entry)))
552 (calc-preserve-point)
553 (calc-pop-stack 1 n t)
554 (cond ((or (memq (car parent) '(* / %))
555 (and (eq (car parent) '^)
556 (eq (nth 2 parent) (nth 2 entry))))
558 ((memq (car parent) '(vec calcFunc-min calcFunc-max)))
559 ((and (assq (car parent) calc-tweak-eqn-table)
560 (= (length parent) 3))
566 (calc-push-list (list
568 (calc-replace-sub-formula
571 (if (eq (nth 2 entry) (nth 1 parent))
576 (calc-push-list (list
578 (calc-replace-sub-formula (car entry)
583 (calc-push-list (list
585 (calc-replace-sub-formula (car entry)
591 (calc-pop-stack 1 n t))))
593 (defun calc-roll-down-with-selections (n m)
594 (let ((vals (append (calc-top-list m 1)
595 (calc-top-list (- n m) (1+ m))))
596 (sels (append (calc-top-list m 1 'sel)
597 (calc-top-list (- n m) (1+ m) 'sel))))
598 (calc-pop-push-list n vals 1 sels)))
600 (defun calc-roll-up-with-selections (n m)
601 (let ((vals (append (calc-top-list (- n m) 1)
602 (calc-top-list m (- n m -1))))
603 (sels (append (calc-top-list (- n m) 1 'sel)
604 (calc-top-list m (- n m -1) 'sel))))
605 (calc-pop-push-list n vals 1 sels)))
607 ;; The variable calc-sel-reselect is local to several functions
608 ;; which call calc-auto-selection.
609 (defvar calc-sel-reselect)
611 (defun calc-auto-selection (entry)
614 (setq calc-sel-reselect nil)
615 (calc-prepare-selection)
616 (calc-grow-assoc-formula (car entry) (calc-find-selected-part)))))
618 (defun calc-copy-selection ()
621 (calc-preserve-point)
622 (let* ((num (max 1 (calc-locate-cursor-element (point))))
623 (entry (calc-top num 'entry)))
624 (calc-push (or (calc-auto-selection entry) (car entry))))))
626 (defun calc-del-selection ()
629 (calc-preserve-point)
630 (let* ((num (max 1 (calc-locate-cursor-element (point))))
631 (entry (calc-top num 'entry))
632 (sel (calc-auto-selection entry)))
633 (setcar (nthcdr 2 entry) (and (not (eq sel (car entry))) sel))
634 (calc-delete-selection num))))
636 (defvar calc-selection-history nil
637 "History for calc selections.")
639 (defun calc-enter-selection ()
642 (calc-preserve-point)
643 (let* ((num (max 1 (calc-locate-cursor-element (point))))
644 (calc-sel-reselect calc-keep-selection)
645 (entry (calc-top num 'entry))
647 (sel (or (calc-auto-selection entry) expr))
649 (let ((calc-dollar-values (list sel))
650 (calc-dollar-used 0))
651 (setq alg (calc-do-alg-entry "" "Replace selection with: " nil
652 'calc-selection-history))
655 (setq alg (calc-encase-atoms (car alg)))
656 (calc-pop-push-record-list 1 "repl"
657 (list (calc-replace-sub-formula
660 (list (and calc-sel-reselect alg))))))
661 (calc-handle-whys))))
663 (defun calc-edit-selection ()
666 (calc-preserve-point)
667 (let* ((num (max 1 (calc-locate-cursor-element (point))))
668 (calc-sel-reselect calc-keep-selection)
669 (entry (calc-top num 'entry))
671 (sel (or (calc-auto-selection entry) expr))
673 (let ((str (math-showing-full-precision
674 (math-format-nice-expr sel (frame-width)))))
675 (calc-edit-mode (list 'calc-finish-selection-edit
676 num (list 'quote sel) calc-sel-reselect))
678 (calc-show-edit-buffer))
680 (defvar calc-original-buffer)
682 ;; The variable calc-edit-disp-trail is local to calc-edit-finish,
684 (defvar calc-edit-disp-trail)
685 (defvar calc-edit-top)
687 (defun calc-finish-selection-edit (num sel reselect)
688 (let ((buf (current-buffer))
689 (str (buffer-substring calc-edit-top (point-max)))
691 (switch-to-buffer calc-original-buffer)
692 (let ((val (math-read-expr str)))
693 (if (eq (car-safe val) 'error)
695 (switch-to-buffer buf)
696 (goto-char (+ start (nth 1 val)))
697 (error (nth 2 val))))
699 (calc-preserve-point)
700 (if calc-edit-disp-trail
701 (calc-trail-display 1 t))
702 (setq val (calc-encase-atoms (calc-normalize val)))
703 (let ((expr (calc-top num 'full)))
704 (if (calc-find-sub-formula expr sel)
705 (calc-pop-push-record-list 1 "edit"
706 (list (calc-replace-sub-formula
709 (list (and reselect val)))
711 (error "Original selection has been lost")))))))
713 (defun calc-sel-evaluate (arg)
716 (calc-preserve-point)
717 (let* ((num (max 1 (calc-locate-cursor-element (point))))
718 (calc-sel-reselect calc-keep-selection)
719 (entry (calc-top num 'entry))
720 (sel (or (calc-auto-selection entry) (car entry))))
721 (calc-with-default-simplification
722 (let ((math-simplify-only nil))
723 (calc-modify-simplify-mode arg)
724 (let ((val (calc-encase-atoms (calc-normalize sel))))
725 (calc-pop-push-record-list 1 "jsmp"
726 (list (calc-replace-sub-formula
727 (car entry) sel val))
729 (list (and calc-sel-reselect val))))))
730 (calc-handle-whys))))
732 (defun calc-sel-expand-formula (arg)
735 (calc-preserve-point)
736 (let* ((num (max 1 (calc-locate-cursor-element (point))))
737 (calc-sel-reselect calc-keep-selection)
738 (entry (calc-top num 'entry))
739 (sel (or (calc-auto-selection entry) (car entry))))
740 (calc-with-default-simplification
741 (let ((math-simplify-only nil))
742 (calc-modify-simplify-mode arg)
743 (let* ((math-expand-formulas (> arg 0))
744 (val (calc-normalize sel))
747 (setq top (math-expand-formula val))
748 (setq val (calc-normalize top)))
749 (setq val (calc-encase-atoms val))
750 (calc-pop-push-record-list 1 "jexf"
751 (list (calc-replace-sub-formula
752 (car entry) sel val))
754 (list (and calc-sel-reselect val))))))
755 (calc-handle-whys))))
757 (defun calc-sel-mult-both-sides (no-simp &optional divide)
760 (calc-preserve-point)
761 (let* ((num (max 1 (calc-locate-cursor-element (point))))
762 (calc-sel-reselect calc-keep-selection)
763 (entry (calc-top num 'entry))
765 (sel (or (calc-auto-selection entry) expr))
766 (func (car-safe sel))
768 (setq alg (calc-with-default-simplification
769 (car (calc-do-alg-entry ""
771 "Divide both sides by: "
772 "Multiply both sides by: ")
773 nil 'calc-selection-history))))
776 (if (and (or (eq func '/)
777 (assq func calc-tweak-eqn-table))
780 (or (memq func '(/ calcFunc-eq calcFunc-neq))
781 (if (math-known-nonposp alg)
783 (setq func (nth 1 (assq func
784 calc-tweak-eqn-table)))
785 (or (math-known-negp alg)
786 (message "Assuming this factor is nonzero")))
787 (or (math-known-posp alg)
788 (if (math-known-nonnegp alg)
789 (message "Assuming this factor is nonzero")
790 (message "Assuming this factor is positive")))))
791 (setq lhs (list (if divide '/ '*) (nth 1 sel) alg)
792 rhs (list (if divide '/ '*) (nth 2 sel) alg))
795 (setq lhs (math-simplify lhs)
796 rhs (math-simplify rhs))
798 (or (Math-equal (nth 1 sel) 1)
799 (Math-equal (nth 1 sel) -1)
800 (and (memq (car-safe (nth 2 sel)) '(+ -))
801 (memq (car-safe alg) '(+ -))))
802 (setq rhs (math-expand-term rhs)))))
803 (setq alg (calc-encase-atoms
804 (calc-normalize (list func lhs rhs)))))
805 (setq rhs (list (if divide '* '/) sel alg))
807 (setq rhs (math-simplify rhs)))
808 (setq alg (calc-encase-atoms
809 (calc-normalize (if divide
811 (list '* alg rhs))))))
812 (calc-pop-push-record-list 1 (if divide "div" "mult")
813 (list (calc-replace-sub-formula
816 (list (and calc-sel-reselect alg)))))
817 (calc-handle-whys))))
819 (defun calc-sel-div-both-sides (no-simp)
821 (calc-sel-mult-both-sides no-simp t))
823 (defun calc-sel-add-both-sides (no-simp &optional subtract)
826 (calc-preserve-point)
827 (let* ((num (max 1 (calc-locate-cursor-element (point))))
828 (calc-sel-reselect calc-keep-selection)
829 (entry (calc-top num 'entry))
831 (sel (or (calc-auto-selection entry) expr))
832 (func (car-safe sel))
834 (setq alg (calc-with-default-simplification
835 (car (calc-do-alg-entry ""
837 "Subtract from both sides: "
838 "Add to both sides: ")
839 nil 'calc-selection-history))))
842 (if (and (assq func calc-tweak-eqn-table)
845 (setq lhs (list (if subtract '- '+) (nth 1 sel) alg)
846 rhs (list (if subtract '- '+) (nth 2 sel) alg))
848 (setq lhs (math-simplify lhs)
849 rhs (math-simplify rhs)))
850 (setq alg (calc-encase-atoms
851 (calc-normalize (list func lhs rhs)))))
852 (setq rhs (list (if subtract '+ '-) sel alg))
854 (setq rhs (math-simplify rhs)))
855 (setq alg (calc-encase-atoms
856 (calc-normalize (list (if subtract '- '+) alg rhs)))))
857 (calc-pop-push-record-list 1 (if subtract "sub" "add")
858 (list (calc-replace-sub-formula
861 (list (and calc-sel-reselect alg)))))
862 (calc-handle-whys))))
864 (defun calc-sel-sub-both-sides (no-simp)
866 (calc-sel-add-both-sides no-simp t))
870 ;;; arch-tag: e5169792-777d-428f-bff5-acca66813fa2
871 ;;; calc-sel.el ends here