1 ;;; calc-sel.el --- data selection functions for Calc
3 ;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc.
5 ;; Author: David Gillespie <daveg@synaptics.com>
6 ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is free software: you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation, either version 3 of the License, or
13 ;; (at your option) any later version.
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
27 ;; This file is autoloaded from calc-ext.el.
32 ;;; Selection commands.
34 (defvar calc-keep-selection t)
36 (defvar calc-selection-cache-entry nil)
37 (defvar calc-selection-cache-num)
38 (defvar calc-selection-cache-comp)
39 (defvar calc-selection-cache-offset)
40 (defvar calc-selection-true-num)
42 (defun calc-select-here (num &optional once keep)
45 (calc-prepare-selection)
46 (let ((found (calc-find-selected-part))
47 (entry calc-selection-cache-entry))
48 (or (and keep (nth 2 entry))
51 (setq calc-keep-selection nil)
52 (message "(Selection will apply to next command only)")))
53 (calc-change-current-selection
55 (if (and num (> (setq num (prefix-numeric-value num)) 0))
57 (while (and (>= (setq num (1- num)) 0)
58 (not (eq found (car entry))))
59 (setq found (calc-find-assoc-parent-formula
62 (calc-grow-assoc-formula (car entry) found))
65 (defun calc-select-once (num)
67 (calc-select-here num t))
69 (defun calc-select-here-maybe (num)
71 (calc-select-here num nil t))
73 (defun calc-select-once-maybe (num)
75 (calc-select-here num t t))
77 (defun calc-select-additional ()
80 (let (calc-keep-selection)
81 (calc-prepare-selection))
82 (let ((found (calc-find-selected-part))
83 (entry calc-selection-cache-entry))
84 (calc-change-current-selection
86 (let ((sel (nth 2 entry)))
89 (while (not (or (eq sel (car entry))
90 (calc-find-sub-formula sel found)))
91 (setq sel (calc-find-assoc-parent-formula
94 (calc-grow-assoc-formula (car entry) found)))
97 (defun calc-select-more (num)
100 (calc-prepare-selection)
101 (let ((entry calc-selection-cache-entry))
103 (let ((sel (nth 2 entry)))
104 (while (and (not (eq sel (car entry)))
105 (>= (setq num (1- (prefix-numeric-value num))) 0))
106 (setq sel (calc-find-assoc-parent-formula (car entry) sel)))
107 (calc-change-current-selection sel))
108 (calc-select-here num)))))
110 (defun calc-select-less (num)
113 (calc-prepare-selection)
114 (let ((found (calc-find-selected-part))
115 (entry calc-selection-cache-entry))
116 (calc-change-current-selection
118 (let ((sel (nth 2 entry))
122 (>= (setq num (1- num)) 0))
124 index (calc-find-sub-formula sel found))
125 (and (setq sel (and index (nth index old)))
126 calc-assoc-selections
127 (setq op (assq (car-safe sel) calc-assoc-ops))
128 (memq (car old) (nth index op))
129 (setq num (1+ num))))
132 (defun calc-select-part (num)
134 (or num (setq num (- last-command-event ?0)))
136 (calc-prepare-selection)
137 (let ((sel (calc-find-nth-part (or (nth 2 calc-selection-cache-entry)
138 (car calc-selection-cache-entry))
141 (calc-change-current-selection sel)
142 (error "%d is not a valid sub-formula index" num)))))
144 ;; The variables calc-fnp-op and calc-fnp-num are local to
145 ;; calc-find-nth-part (and calc-select-previous) but used by
146 ;; calc-find-nth-part-rec, which is called by them.
148 (defvar calc-fnp-num)
150 (defun calc-find-nth-part (expr calc-fnp-num)
151 (if (and calc-assoc-selections
152 (assq (car-safe expr) calc-assoc-ops))
154 (calc-find-nth-part-rec expr))
155 (if (eq (car-safe expr) 'intv)
156 (and (>= calc-fnp-num 1) (<= calc-fnp-num 2) (nth (1+ calc-fnp-num) expr))
157 (and (not (Math-primp expr)) (>= calc-fnp-num 1) (< calc-fnp-num (length expr))
158 (nth calc-fnp-num expr)))))
160 (defun calc-find-nth-part-rec (expr) ; uses num, op
161 (or (if (and (setq calc-fnp-op (assq (car-safe (nth 1 expr)) calc-assoc-ops))
162 (memq (car expr) (nth 1 calc-fnp-op)))
163 (calc-find-nth-part-rec (nth 1 expr))
164 (and (= (setq calc-fnp-num (1- calc-fnp-num)) 0)
166 (if (and (setq calc-fnp-op (assq (car-safe (nth 2 expr)) calc-assoc-ops))
167 (memq (car expr) (nth 2 calc-fnp-op)))
168 (calc-find-nth-part-rec (nth 2 expr))
169 (and (= (setq calc-fnp-num (1- calc-fnp-num)) 0)
172 (defun calc-select-next (num)
175 (calc-select-previous (- num))
177 (calc-prepare-selection)
178 (let* ((entry calc-selection-cache-entry)
182 (while (>= (setq num (1- num)) 0)
183 (let* ((parent (calc-find-parent-formula (car entry) sel))
186 (and (eq p t) (setq p nil))
187 (while (and (setq p (cdr p))
188 (not (eq (car p) sel))))
190 (setq sel (or (and calc-assoc-selections
191 (setq op (assq (car-safe (nth 1 p))
193 (memq (car parent) (nth 2 op))
196 (if (and calc-assoc-selections
197 (setq op (assq (car-safe parent) calc-assoc-ops))
198 (consp (setq p (calc-find-parent-formula
199 (car entry) parent)))
200 (eq (nth 1 p) parent)
201 (memq (car p) (nth 1 op)))
203 (error "No \"next\" sub-formula")))))
204 (calc-change-current-selection sel))
205 (if (Math-primp (car entry))
206 (calc-change-current-selection (car entry))
207 (calc-select-part num)))))))
209 (defun calc-select-previous (num)
212 (calc-select-next (- num))
214 (calc-prepare-selection)
215 (let* ((entry calc-selection-cache-entry)
219 (while (>= (setq num (1- num)) 0)
220 (let* ((parent (calc-find-parent-formula (car entry) sel))
221 (p (cdr-safe parent))
224 (if (eq (car-safe parent) 'intv) (setq p (cdr p)))
225 (while (and (not (eq (car p) sel))
229 (setq sel (or (and calc-assoc-selections
230 (setq op (assq (car-safe prev)
232 (memq (car parent) (nth 1 op))
235 (if (and calc-assoc-selections
236 (setq op (assq (car-safe parent) calc-assoc-ops))
237 (consp (setq p (calc-find-parent-formula
238 (car entry) parent)))
239 (eq (nth 2 p) parent)
240 (memq (car p) (nth 2 op)))
242 (error "No \"previous\" sub-formula")))))
243 (calc-change-current-selection sel))
244 (if (Math-primp (car entry))
245 (calc-change-current-selection (car entry))
246 (let ((len (if (and calc-assoc-selections
247 (assq (car (car entry)) calc-assoc-ops))
248 (let (calc-fnp-op (calc-fnp-num 0))
249 (calc-find-nth-part-rec (car entry))
251 (length (car entry)))))
252 (calc-select-part (- len num)))))))))
254 (defun calc-find-parent-formula (expr part)
255 (cond ((eq expr part) t)
256 ((Math-primp expr) nil)
259 (while (and (setq p (cdr p))
260 (not (setq res (calc-find-parent-formula
263 (if (eq res t) expr res))))))
266 (defun calc-find-assoc-parent-formula (expr part)
267 (calc-grow-assoc-formula expr (calc-find-parent-formula expr part)))
269 (defun calc-grow-assoc-formula (expr part)
270 (if calc-assoc-selections
271 (let ((op (assq (car-safe part) calc-assoc-ops)))
274 (while (and (consp (setq new (calc-find-parent-formula
277 (nth (calc-find-sub-formula new part) op)))
282 (defun calc-find-sub-formula (expr part)
283 (cond ((eq expr part) t)
284 ((Math-primp expr) nil)
287 (while (and (setq expr (cdr expr))
288 (not (calc-find-sub-formula (car expr) part)))
292 (defun calc-unselect (num)
295 (calc-prepare-selection num)
296 (calc-change-current-selection nil)))
298 (defun calc-clear-selections ()
301 (let ((limit (calc-stack-size))
304 (if (calc-top n 'sel)
306 (calc-prepare-selection n)
307 (calc-change-current-selection nil)))
309 (calc-clear-command-flag 'position-point)))
311 (defvar calc-highlight-selections-with-faces)
313 (defun calc-show-selections (arg)
316 (calc-preserve-point)
317 (setq calc-show-selections (if arg
318 (> (prefix-numeric-value arg) 0)
319 (not calc-show-selections)))
320 (let ((p calc-stack))
322 (or (null (nth 2 (car p)))
323 (equal (car p) calc-selection-cache-entry)))
326 (let ((calc-selection-cache-default-entry
327 calc-selection-cache-entry))
329 (and calc-selection-cache-entry
330 (let ((sel (nth 2 calc-selection-cache-entry)))
331 (setcar (nthcdr 2 calc-selection-cache-entry) nil)
332 (calc-change-current-selection sel)))))
333 (message (if calc-show-selections
334 (if calc-highlight-selections-with-faces
335 "De-emphasizing all but selected part of formulas"
336 "Displaying only selected part of formulas")
337 (if calc-highlight-selections-with-faces
338 "Emphasizing 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 ;; The variable math-comp-sel-tag is local to calc-find-selected-part,
420 ;; but is used by math-comp-sel-flat-term and math-comp-add-string-sel
421 ;; in calccomp.el, which are called (indirectly) by calc-find-selected-part.
423 (defun calc-find-selected-part ()
424 (let* ((math-comp-sel-hpos (- (current-column) calc-selection-cache-offset))
428 (math-comp-sel-vpos (save-excursion
430 (let ((line (point)))
431 (calc-cursor-stack-index
432 calc-selection-cache-num)
434 (while (< (point) line)
436 (setq spaces (+ spaces
437 (current-indentation))
439 (- lcount (math-comp-ascent
440 calc-selection-cache-comp) -1))))
441 (math-comp-sel-cpos (- (point) toppt calc-selection-cache-offset
443 (math-comp-sel-tag nil))
444 (and (>= math-comp-sel-hpos 0)
445 (> calc-selection-true-num 0)
446 (math-composition-to-string calc-selection-cache-comp 1000000))
447 (nth 1 math-comp-sel-tag)))
449 (defun calc-change-current-selection (sub-expr)
450 (or (eq sub-expr (nth 2 calc-selection-cache-entry))
451 (let ((calc-prepared-composition calc-selection-cache-comp)
452 (buffer-read-only nil)
454 (calc-set-command-flag 'renum-stack)
455 (setcar (nthcdr 2 calc-selection-cache-entry) sub-expr)
456 (calc-cursor-stack-index calc-selection-cache-num)
458 (calc-cursor-stack-index (1- calc-selection-cache-num))
459 (delete-region top (point))
460 (let ((calc-selection-cache-default-entry calc-selection-cache-entry))
461 (insert (math-format-stack-value calc-selection-cache-entry)
464 (defun calc-top-selected (&optional n m)
465 (and calc-any-selections
470 (calc-check-stack (+ n m -1))
471 (let ((top (nthcdr (+ m calc-stack-top -1) calc-stack))
473 (while (>= (setq n (1- n)) 0)
474 (if (nth 2 (car top))
475 (setq sel (if sel t (nth 2 (car top)))))
476 (setq top (cdr top)))
479 ;; The variables calc-rsf-old and calc-rsf-new are local to
480 ;; calc-replace-sub-formula, but used by calc-replace-sub-formula-rec,
481 ;; which is called by calc-replace-sub-formula.
482 (defvar calc-rsf-old)
483 (defvar calc-rsf-new)
485 (defun calc-replace-sub-formula (expr calc-rsf-old calc-rsf-new)
486 (setq calc-rsf-new (calc-encase-atoms calc-rsf-new))
487 (calc-replace-sub-formula-rec expr))
489 (defun calc-replace-sub-formula-rec (expr)
490 (cond ((eq expr calc-rsf-old) calc-rsf-new)
491 ((Math-primp expr) expr)
494 (mapcar 'calc-replace-sub-formula-rec (cdr expr))))))
496 (defun calc-sel-error ()
497 (error "Invalid operation on sub-formulas"))
499 (defun calc-replace-selections (n vals m)
500 (if (calc-top-selected n m)
501 (let ((num (length vals)))
502 (calc-preserve-point)
505 (let* ((old (calc-top-list n m 'entry))
510 (if (nth 2 (car old))
511 (setq val (calc-encase-atoms (car vals))
512 new (cons (calc-replace-sub-formula (car (car old))
517 (setq new (cons (car vals) new)
519 (setq vals (cdr vals)
521 (calc-pop-stack n m t)
522 (calc-push-list (nreverse new)
523 m (and calc-keep-selection (nreverse sel)))))
525 (let* ((old (calc-top-list n m 'entry))
527 (while (and old (not (nth 2 (car old))))
528 (setq old (cdr old)))
530 (while (and (setq more (cdr more)) (not (nth 2 (car more)))))
533 (calc-pop-stack n m t)
535 (let ((val (calc-encase-atoms (car vals))))
536 (calc-push-list (list (calc-replace-sub-formula
540 m (and calc-keep-selection (list val))))
541 (calc-push-list vals))))
542 (t (calc-sel-error))))
543 (calc-pop-stack n m t)
544 (calc-push-list vals m)))
546 (defun calc-delete-selection (n)
547 (let ((entry (calc-top n 'entry)))
549 (if (eq (nth 2 entry) (car entry))
551 (calc-pop-stack 1 n t)
552 (calc-push-list '(0) n))
553 (let ((parent (calc-find-parent-formula (car entry) (nth 2 entry)))
555 (calc-preserve-point)
556 (calc-pop-stack 1 n t)
557 (cond ((or (memq (car parent) '(* / %))
558 (and (eq (car parent) '^)
559 (eq (nth 2 parent) (nth 2 entry))))
561 ((memq (car parent) '(vec calcFunc-min calcFunc-max)))
562 ((and (assq (car parent) calc-tweak-eqn-table)
563 (= (length parent) 3))
569 (calc-push-list (list
571 (calc-replace-sub-formula
574 (if (eq (nth 2 entry) (nth 1 parent))
579 (calc-push-list (list
581 (calc-replace-sub-formula (car entry)
586 (calc-push-list (list
588 (calc-replace-sub-formula (car entry)
594 (calc-pop-stack 1 n t))))
596 (defun calc-roll-down-with-selections (n m)
597 (let ((vals (append (calc-top-list m 1)
598 (calc-top-list (- n m) (1+ m))))
599 (sels (append (calc-top-list m 1 'sel)
600 (calc-top-list (- n m) (1+ m) 'sel))))
601 (calc-pop-push-list n vals 1 sels)))
603 (defun calc-roll-up-with-selections (n m)
604 (let ((vals (append (calc-top-list (- n m) 1)
605 (calc-top-list m (- n m -1))))
606 (sels (append (calc-top-list (- n m) 1 'sel)
607 (calc-top-list m (- n m -1) 'sel))))
608 (calc-pop-push-list n vals 1 sels)))
610 ;; The variable calc-sel-reselect is local to several functions
611 ;; which call calc-auto-selection.
612 (defvar calc-sel-reselect)
614 (defun calc-auto-selection (entry)
617 (setq calc-sel-reselect nil)
618 (calc-prepare-selection)
619 (calc-grow-assoc-formula (car entry) (calc-find-selected-part)))))
621 (defun calc-copy-selection ()
624 (calc-preserve-point)
625 (let* ((num (max 1 (calc-locate-cursor-element (point))))
626 (entry (calc-top num 'entry)))
627 (calc-push (or (calc-auto-selection entry) (car entry))))))
629 (defun calc-del-selection ()
632 (calc-preserve-point)
633 (let* ((num (max 1 (calc-locate-cursor-element (point))))
634 (entry (calc-top num 'entry))
635 (sel (calc-auto-selection entry)))
636 (setcar (nthcdr 2 entry) (and (not (eq sel (car entry))) sel))
637 (calc-delete-selection num))))
639 (defvar calc-selection-history nil
640 "History for calc selections.")
642 (defun calc-enter-selection ()
645 (calc-preserve-point)
646 (let* ((num (max 1 (calc-locate-cursor-element (point))))
647 (calc-sel-reselect calc-keep-selection)
648 (entry (calc-top num 'entry))
650 (sel (or (calc-auto-selection entry) expr))
652 (let ((calc-dollar-values (list sel))
653 (calc-dollar-used 0))
654 (setq alg (calc-do-alg-entry "" "Replace selection with: " nil
655 'calc-selection-history))
658 (setq alg (calc-encase-atoms (car alg)))
659 (calc-pop-push-record-list 1 "repl"
660 (list (calc-replace-sub-formula
663 (list (and calc-sel-reselect alg))))))
664 (calc-handle-whys))))
666 (defun calc-edit-selection ()
669 (calc-preserve-point)
670 (let* ((num (max 1 (calc-locate-cursor-element (point))))
671 (calc-sel-reselect calc-keep-selection)
672 (entry (calc-top num 'entry))
674 (sel (or (calc-auto-selection entry) expr))
676 (let ((str (math-showing-full-precision
677 (math-format-nice-expr sel (frame-width)))))
678 (calc-edit-mode (list 'calc-finish-selection-edit
679 num (list 'quote sel) calc-sel-reselect))
681 (calc-show-edit-buffer))
683 (defvar calc-original-buffer)
685 ;; The variable calc-edit-disp-trail is local to calc-edit-finish,
687 (defvar calc-edit-disp-trail)
688 (defvar calc-edit-top)
690 (defun calc-finish-selection-edit (num sel reselect)
691 (let ((buf (current-buffer))
692 (str (buffer-substring calc-edit-top (point-max)))
694 (switch-to-buffer calc-original-buffer)
695 (let ((val (math-read-expr str)))
696 (if (eq (car-safe val) 'error)
698 (switch-to-buffer buf)
699 (goto-char (+ start (nth 1 val)))
700 (error (nth 2 val))))
702 (calc-preserve-point)
703 (if calc-edit-disp-trail
704 (calc-trail-display 1 t))
705 (setq val (calc-encase-atoms (calc-normalize val)))
706 (let ((expr (calc-top num 'full)))
707 (if (calc-find-sub-formula expr sel)
708 (calc-pop-push-record-list 1 "edit"
709 (list (calc-replace-sub-formula
712 (list (and reselect val)))
714 (error "Original selection has been lost")))))))
716 (defun calc-sel-evaluate (arg)
719 (calc-preserve-point)
720 (let* ((num (max 1 (calc-locate-cursor-element (point))))
721 (calc-sel-reselect calc-keep-selection)
722 (entry (calc-top num 'entry))
723 (sel (or (calc-auto-selection entry) (car entry))))
724 (calc-with-default-simplification
725 (let ((math-simplify-only nil))
726 (calc-modify-simplify-mode arg)
727 (let ((val (calc-encase-atoms (calc-normalize sel))))
728 (calc-pop-push-record-list 1 "jsmp"
729 (list (calc-replace-sub-formula
730 (car entry) sel val))
732 (list (and calc-sel-reselect val))))))
733 (calc-handle-whys))))
735 (defun calc-sel-expand-formula (arg)
738 (calc-preserve-point)
739 (let* ((num (max 1 (calc-locate-cursor-element (point))))
740 (calc-sel-reselect calc-keep-selection)
741 (entry (calc-top num 'entry))
742 (sel (or (calc-auto-selection entry) (car entry))))
743 (calc-with-default-simplification
744 (let ((math-simplify-only nil))
745 (calc-modify-simplify-mode arg)
746 (let* ((math-expand-formulas (> arg 0))
747 (val (calc-normalize sel))
750 (setq top (math-expand-formula val))
751 (setq val (calc-normalize top)))
752 (setq val (calc-encase-atoms val))
753 (calc-pop-push-record-list 1 "jexf"
754 (list (calc-replace-sub-formula
755 (car entry) sel val))
757 (list (and calc-sel-reselect val))))))
758 (calc-handle-whys))))
760 (defun calc-sel-mult-both-sides (arg &optional divide)
763 (calc-preserve-point)
764 (let* ((no-simp (consp arg))
765 (num (max 1 (calc-locate-cursor-element (point))))
766 (calc-sel-reselect calc-keep-selection)
767 (entry (calc-top num 'entry))
769 (sel (or (calc-auto-selection entry) expr))
770 (func (car-safe sel))
772 (setq alg (calc-with-default-simplification
773 (car (calc-do-alg-entry ""
775 "Divide both sides by: "
776 "Multiply both sides by: ")
777 nil 'calc-selection-history))))
780 (if (and (or (eq func '/)
781 (assq func calc-tweak-eqn-table))
784 (or (memq func '(/ calcFunc-eq calcFunc-neq))
785 (if (math-known-nonposp alg)
787 (setq func (nth 1 (assq func
788 calc-tweak-eqn-table)))
789 (or (math-known-negp alg)
790 (message "Assuming this factor is nonzero")))
791 (or (math-known-posp alg)
792 (if (math-known-nonnegp alg)
793 (message "Assuming this factor is nonzero")
794 (message "Assuming this factor is positive")))))
795 (setq lhs (list (if divide '/ '*) (nth 1 sel) alg)
796 rhs (list (if divide '/ '*) (nth 2 sel) alg))
799 (setq lhs (math-simplify lhs)
800 rhs (math-simplify rhs))
802 (or (Math-equal (nth 1 sel) 1)
803 (Math-equal (nth 1 sel) -1))
804 ; (and (memq (car-safe (nth 2 sel)) '(+ -))
805 ; (memq (car-safe alg) '(+ -))))
807 (setq rhs (math-expand-term rhs))))))
808 (if (and arg (not no-simp))
809 (setq rhs (math-simplify
810 (calcFunc-expand rhs (unless (= arg 0) arg)))))
811 (setq alg (calc-encase-atoms
812 (calc-normalize (list func lhs rhs)))))
813 (setq rhs (list (if divide '* '/) sel alg))
815 (setq rhs (math-simplify rhs)))
816 (setq alg (calc-encase-atoms
817 (calc-normalize (if divide
819 (list '* alg rhs))))))
820 (calc-pop-push-record-list 1 (if divide "div" "mult")
821 (list (calc-replace-sub-formula
824 (list (and calc-sel-reselect alg)))))
825 (calc-handle-whys))))
827 (defun calc-sel-div-both-sides (no-simp)
829 (calc-sel-mult-both-sides no-simp t))
831 (defun calc-sel-add-both-sides (no-simp &optional subtract)
834 (calc-preserve-point)
835 (let* ((num (max 1 (calc-locate-cursor-element (point))))
836 (calc-sel-reselect calc-keep-selection)
837 (entry (calc-top num 'entry))
839 (sel (or (calc-auto-selection entry) expr))
840 (func (car-safe sel))
842 (setq alg (calc-with-default-simplification
843 (car (calc-do-alg-entry ""
845 "Subtract from both sides: "
846 "Add to both sides: ")
847 nil 'calc-selection-history))))
850 (if (and (assq func calc-tweak-eqn-table)
853 (setq lhs (list (if subtract '- '+) (nth 1 sel) alg)
854 rhs (list (if subtract '- '+) (nth 2 sel) alg))
856 (setq lhs (math-simplify lhs)
857 rhs (math-simplify rhs)))
858 (setq alg (calc-encase-atoms
859 (calc-normalize (list func lhs rhs)))))
860 (setq rhs (list (if subtract '+ '-) sel alg))
862 (setq rhs (math-simplify rhs)))
863 (setq alg (calc-encase-atoms
864 (calc-normalize (list (if subtract '- '+) alg rhs)))))
865 (calc-pop-push-record-list 1 (if subtract "sub" "add")
866 (list (calc-replace-sub-formula
869 (list (and calc-sel-reselect alg)))))
870 (calc-handle-whys))))
872 (defun calc-sel-sub-both-sides (no-simp)
874 (calc-sel-add-both-sides no-simp t))
878 ;;; calc-sel.el ends here