1 ;;; calc-sel.el --- data selection functions for Calc
3 ;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004,
4 ;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
6 ;; Author: David Gillespie <daveg@synaptics.com>
7 ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
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 3 of the License, or
14 ;; (at your option) any later version.
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. If not, see <http://www.gnu.org/licenses/>.
28 ;; This file is autoloaded from calc-ext.el.
33 ;;; Selection commands.
35 (defvar calc-keep-selection t
)
37 (defvar calc-selection-cache-entry nil
)
38 (defvar calc-selection-cache-num
)
39 (defvar calc-selection-cache-comp
)
40 (defvar calc-selection-cache-offset
)
41 (defvar calc-selection-true-num
)
43 (defun calc-select-here (num &optional once keep
)
46 (calc-prepare-selection)
47 (let ((found (calc-find-selected-part))
48 (entry calc-selection-cache-entry
))
49 (or (and keep
(nth 2 entry
))
52 (setq calc-keep-selection nil
)
53 (message "(Selection will apply to next command only)")))
54 (calc-change-current-selection
56 (if (and num
(> (setq num
(prefix-numeric-value num
)) 0))
58 (while (and (>= (setq num
(1- num
)) 0)
59 (not (eq found
(car entry
))))
60 (setq found
(calc-find-assoc-parent-formula
63 (calc-grow-assoc-formula (car entry
) found
))
66 (defun calc-select-once (num)
68 (calc-select-here num t
))
70 (defun calc-select-here-maybe (num)
72 (calc-select-here num nil t
))
74 (defun calc-select-once-maybe (num)
76 (calc-select-here num t t
))
78 (defun calc-select-additional ()
81 (let (calc-keep-selection)
82 (calc-prepare-selection))
83 (let ((found (calc-find-selected-part))
84 (entry calc-selection-cache-entry
))
85 (calc-change-current-selection
87 (let ((sel (nth 2 entry
)))
90 (while (not (or (eq sel
(car entry
))
91 (calc-find-sub-formula sel found
)))
92 (setq sel
(calc-find-assoc-parent-formula
95 (calc-grow-assoc-formula (car entry
) found
)))
98 (defun calc-select-more (num)
101 (calc-prepare-selection)
102 (let ((entry calc-selection-cache-entry
))
104 (let ((sel (nth 2 entry
)))
105 (while (and (not (eq sel
(car entry
)))
106 (>= (setq num
(1- (prefix-numeric-value num
))) 0))
107 (setq sel
(calc-find-assoc-parent-formula (car entry
) sel
)))
108 (calc-change-current-selection sel
))
109 (calc-select-here num
)))))
111 (defun calc-select-less (num)
114 (calc-prepare-selection)
115 (let ((found (calc-find-selected-part))
116 (entry calc-selection-cache-entry
))
117 (calc-change-current-selection
119 (let ((sel (nth 2 entry
))
123 (>= (setq num
(1- num
)) 0))
125 index
(calc-find-sub-formula sel found
))
126 (and (setq sel
(and index
(nth index old
)))
127 calc-assoc-selections
128 (setq op
(assq (car-safe sel
) calc-assoc-ops
))
129 (memq (car old
) (nth index op
))
130 (setq num
(1+ num
))))
133 (defun calc-select-part (num)
135 (or num
(setq num
(- last-command-event ?
0)))
137 (calc-prepare-selection)
138 (let ((sel (calc-find-nth-part (or (nth 2 calc-selection-cache-entry
)
139 (car calc-selection-cache-entry
))
142 (calc-change-current-selection sel
)
143 (error "%d is not a valid sub-formula index" num
)))))
145 ;; The variables calc-fnp-op and calc-fnp-num are local to
146 ;; calc-find-nth-part (and calc-select-previous) but used by
147 ;; calc-find-nth-part-rec, which is called by them.
149 (defvar calc-fnp-num
)
151 (defun calc-find-nth-part (expr calc-fnp-num
)
152 (if (and calc-assoc-selections
153 (assq (car-safe expr
) calc-assoc-ops
))
155 (calc-find-nth-part-rec expr
))
156 (if (eq (car-safe expr
) 'intv
)
157 (and (>= calc-fnp-num
1) (<= calc-fnp-num
2) (nth (1+ calc-fnp-num
) expr
))
158 (and (not (Math-primp expr
)) (>= calc-fnp-num
1) (< calc-fnp-num
(length expr
))
159 (nth calc-fnp-num expr
)))))
161 (defun calc-find-nth-part-rec (expr) ; uses num, op
162 (or (if (and (setq calc-fnp-op
(assq (car-safe (nth 1 expr
)) calc-assoc-ops
))
163 (memq (car expr
) (nth 1 calc-fnp-op
)))
164 (calc-find-nth-part-rec (nth 1 expr
))
165 (and (= (setq calc-fnp-num
(1- calc-fnp-num
)) 0)
167 (if (and (setq calc-fnp-op
(assq (car-safe (nth 2 expr
)) calc-assoc-ops
))
168 (memq (car expr
) (nth 2 calc-fnp-op
)))
169 (calc-find-nth-part-rec (nth 2 expr
))
170 (and (= (setq calc-fnp-num
(1- calc-fnp-num
)) 0)
173 (defun calc-select-next (num)
176 (calc-select-previous (- num
))
178 (calc-prepare-selection)
179 (let* ((entry calc-selection-cache-entry
)
183 (while (>= (setq num
(1- num
)) 0)
184 (let* ((parent (calc-find-parent-formula (car entry
) sel
))
187 (and (eq p t
) (setq p nil
))
188 (while (and (setq p
(cdr p
))
189 (not (eq (car p
) sel
))))
191 (setq sel
(or (and calc-assoc-selections
192 (setq op
(assq (car-safe (nth 1 p
))
194 (memq (car parent
) (nth 2 op
))
197 (if (and calc-assoc-selections
198 (setq op
(assq (car-safe parent
) calc-assoc-ops
))
199 (consp (setq p
(calc-find-parent-formula
200 (car entry
) parent
)))
201 (eq (nth 1 p
) parent
)
202 (memq (car p
) (nth 1 op
)))
204 (error "No \"next\" sub-formula")))))
205 (calc-change-current-selection sel
))
206 (if (Math-primp (car entry
))
207 (calc-change-current-selection (car entry
))
208 (calc-select-part num
)))))))
210 (defun calc-select-previous (num)
213 (calc-select-next (- num
))
215 (calc-prepare-selection)
216 (let* ((entry calc-selection-cache-entry
)
220 (while (>= (setq num
(1- num
)) 0)
221 (let* ((parent (calc-find-parent-formula (car entry
) sel
))
222 (p (cdr-safe parent
))
225 (if (eq (car-safe parent
) 'intv
) (setq p
(cdr p
)))
226 (while (and (not (eq (car p
) sel
))
230 (setq sel
(or (and calc-assoc-selections
231 (setq op
(assq (car-safe prev
)
233 (memq (car parent
) (nth 1 op
))
236 (if (and calc-assoc-selections
237 (setq op
(assq (car-safe parent
) calc-assoc-ops
))
238 (consp (setq p
(calc-find-parent-formula
239 (car entry
) parent
)))
240 (eq (nth 2 p
) parent
)
241 (memq (car p
) (nth 2 op
)))
243 (error "No \"previous\" sub-formula")))))
244 (calc-change-current-selection sel
))
245 (if (Math-primp (car entry
))
246 (calc-change-current-selection (car entry
))
247 (let ((len (if (and calc-assoc-selections
248 (assq (car (car entry
)) calc-assoc-ops
))
249 (let (calc-fnp-op (calc-fnp-num 0))
250 (calc-find-nth-part-rec (car entry
))
252 (length (car entry
)))))
253 (calc-select-part (- len num
)))))))))
255 (defun calc-find-parent-formula (expr part
)
256 (cond ((eq expr part
) t
)
257 ((Math-primp expr
) nil
)
260 (while (and (setq p
(cdr p
))
261 (not (setq res
(calc-find-parent-formula
264 (if (eq res t
) expr res
))))))
267 (defun calc-find-assoc-parent-formula (expr part
)
268 (calc-grow-assoc-formula expr
(calc-find-parent-formula expr part
)))
270 (defun calc-grow-assoc-formula (expr part
)
271 (if calc-assoc-selections
272 (let ((op (assq (car-safe part
) calc-assoc-ops
)))
275 (while (and (consp (setq new
(calc-find-parent-formula
278 (nth (calc-find-sub-formula new part
) op
)))
283 (defun calc-find-sub-formula (expr part
)
284 (cond ((eq expr part
) t
)
285 ((Math-primp expr
) nil
)
288 (while (and (setq expr
(cdr expr
))
289 (not (calc-find-sub-formula (car expr
) part
)))
293 (defun calc-unselect (num)
296 (calc-prepare-selection num
)
297 (calc-change-current-selection nil
)))
299 (defun calc-clear-selections ()
302 (let ((limit (calc-stack-size))
305 (if (calc-top n
'sel
)
307 (calc-prepare-selection n
)
308 (calc-change-current-selection nil
)))
310 (calc-clear-command-flag 'position-point
)))
312 (defun calc-show-selections (arg)
315 (calc-preserve-point)
316 (setq calc-show-selections
(if arg
317 (> (prefix-numeric-value arg
) 0)
318 (not calc-show-selections
)))
319 (let ((p calc-stack
))
321 (or (null (nth 2 (car p
)))
322 (equal (car p
) calc-selection-cache-entry
)))
325 (let ((calc-selection-cache-default-entry
326 calc-selection-cache-entry
))
328 (and calc-selection-cache-entry
329 (let ((sel (nth 2 calc-selection-cache-entry
)))
330 (setcar (nthcdr 2 calc-selection-cache-entry
) nil
)
331 (calc-change-current-selection sel
)))))
332 (message (if calc-show-selections
333 "Displaying only selected part of formulas"
334 "Displaying all but selected part of formulas"))))
336 ;; The variables calc-final-point-line and calc-final-point-column
337 ;; are declared in calc.el, and are used throughout.
338 (defvar calc-final-point-line
)
339 (defvar calc-final-point-column
)
341 (defun calc-preserve-point ()
342 (or (looking-at "\\.\n+\\'")
344 (setq calc-final-point-line
(+ (count-lines (point-min) (point))
346 calc-final-point-column
(current-column))
347 (calc-set-command-flag 'position-point
))))
349 (defun calc-enable-selections (arg)
352 (calc-preserve-point)
353 (setq calc-use-selections
(if arg
354 (> (prefix-numeric-value arg
) 0)
355 (not calc-use-selections
)))
356 (calc-set-command-flag 'renum-stack
)
357 (message (if calc-use-selections
358 "Commands operate only on selected sub-formulas"
359 "Selections of sub-formulas have no effect"))))
361 (defun calc-break-selections (arg)
364 (calc-preserve-point)
365 (setq calc-assoc-selections
(if arg
366 (<= (prefix-numeric-value arg
) 0)
367 (not calc-assoc-selections
)))
368 (message (if calc-assoc-selections
369 "Selection treats a+b+c as a sum of three terms"
370 "Selection treats a+b+c as (a+b)+c"))))
372 (defun calc-prepare-selection (&optional num
)
373 (or num
(setq num
(calc-locate-cursor-element (point))))
374 (setq calc-selection-true-num num
375 calc-keep-selection t
)
376 (or (> num
0) (setq num
1))
377 ;; (if (or (< num 1) (> num (calc-stack-size)))
378 ;; (error "Cursor must be positioned on a stack element"))
379 (let* ((entry (calc-top num
'entry
))
381 (or (equal entry calc-selection-cache-entry
)
383 (setcar entry
(calc-encase-atoms (car entry
)))
384 (setq calc-selection-cache-entry entry
385 calc-selection-cache-num num
386 calc-selection-cache-comp
387 (let ((math-comp-tagged t
))
388 (math-compose-expr (car entry
) 0))
389 calc-selection-cache-offset
390 (+ (car (math-stack-value-offset calc-selection-cache-comp
))
391 (length calc-left-label
)
392 (if calc-line-numbering
4 0))))))
393 (calc-preserve-point))
395 ;;; The following ensures that no two subformulas will be "eq" to each other!
396 (defun calc-encase-atoms (x)
397 (if (or (not (consp x
))
398 (equal x
'(float 0 0)))
400 (calc-encase-atoms-rec x
)
403 (defun calc-encase-atoms-rec (x)
406 (if (eq (car x
) 'intv
)
408 (while (setq x
(cdr x
))
409 (if (or (not (consp (car x
)))
410 (equal (car x
) '(float 0 0)))
411 (setcar x
(list 'cplx
(car x
) 0))
412 (calc-encase-atoms-rec (car x
)))))))
414 ;; The variable math-comp-sel-tag is local to calc-find-selected-part,
415 ;; but is used by math-comp-sel-flat-term and math-comp-add-string-sel
416 ;; in calccomp.el, which are called (indirectly) by calc-find-selected-part.
418 (defun calc-find-selected-part ()
419 (let* ((math-comp-sel-hpos (- (current-column) calc-selection-cache-offset
))
423 (math-comp-sel-vpos (save-excursion
425 (let ((line (point)))
426 (calc-cursor-stack-index
427 calc-selection-cache-num
)
429 (while (< (point) line
)
431 (setq spaces
(+ spaces
432 (current-indentation))
434 (- lcount
(math-comp-ascent
435 calc-selection-cache-comp
) -
1))))
436 (math-comp-sel-cpos (- (point) toppt calc-selection-cache-offset
438 (math-comp-sel-tag nil
))
439 (and (>= math-comp-sel-hpos
0)
440 (> calc-selection-true-num
0)
441 (math-composition-to-string calc-selection-cache-comp
1000000))
442 (nth 1 math-comp-sel-tag
)))
444 (defun calc-change-current-selection (sub-expr)
445 (or (eq sub-expr
(nth 2 calc-selection-cache-entry
))
446 (let ((calc-prepared-composition calc-selection-cache-comp
)
447 (buffer-read-only nil
)
449 (calc-set-command-flag 'renum-stack
)
450 (setcar (nthcdr 2 calc-selection-cache-entry
) sub-expr
)
451 (calc-cursor-stack-index calc-selection-cache-num
)
453 (calc-cursor-stack-index (1- calc-selection-cache-num
))
454 (delete-region top
(point))
455 (let ((calc-selection-cache-default-entry calc-selection-cache-entry
))
456 (insert (math-format-stack-value calc-selection-cache-entry
)
459 (defun calc-top-selected (&optional n m
)
460 (and calc-any-selections
465 (calc-check-stack (+ n m -
1))
466 (let ((top (nthcdr (+ m calc-stack-top -
1) calc-stack
))
468 (while (>= (setq n
(1- n
)) 0)
469 (if (nth 2 (car top
))
470 (setq sel
(if sel t
(nth 2 (car top
)))))
471 (setq top
(cdr top
)))
474 ;; The variables calc-rsf-old and calc-rsf-new are local to
475 ;; calc-replace-sub-formula, but used by calc-replace-sub-formula-rec,
476 ;; which is called by calc-replace-sub-formula.
477 (defvar calc-rsf-old
)
478 (defvar calc-rsf-new
)
480 (defun calc-replace-sub-formula (expr calc-rsf-old calc-rsf-new
)
481 (setq calc-rsf-new
(calc-encase-atoms calc-rsf-new
))
482 (calc-replace-sub-formula-rec expr
))
484 (defun calc-replace-sub-formula-rec (expr)
485 (cond ((eq expr calc-rsf-old
) calc-rsf-new
)
486 ((Math-primp expr
) expr
)
489 (mapcar 'calc-replace-sub-formula-rec
(cdr expr
))))))
491 (defun calc-sel-error ()
492 (error "Invalid operation on sub-formulas"))
494 (defun calc-replace-selections (n vals m
)
495 (if (calc-top-selected n m
)
496 (let ((num (length vals
)))
497 (calc-preserve-point)
500 (let* ((old (calc-top-list n m
'entry
))
505 (if (nth 2 (car old
))
506 (setq val
(calc-encase-atoms (car vals
))
507 new
(cons (calc-replace-sub-formula (car (car old
))
512 (setq new
(cons (car vals
) new
)
514 (setq vals
(cdr vals
)
516 (calc-pop-stack n m t
)
517 (calc-push-list (nreverse new
)
518 m
(and calc-keep-selection
(nreverse sel
)))))
520 (let* ((old (calc-top-list n m
'entry
))
522 (while (and old
(not (nth 2 (car old
))))
523 (setq old
(cdr old
)))
525 (while (and (setq more
(cdr more
)) (not (nth 2 (car more
)))))
528 (calc-pop-stack n m t
)
530 (let ((val (calc-encase-atoms (car vals
))))
531 (calc-push-list (list (calc-replace-sub-formula
535 m
(and calc-keep-selection
(list val
))))
536 (calc-push-list vals
))))
537 (t (calc-sel-error))))
538 (calc-pop-stack n m t
)
539 (calc-push-list vals m
)))
541 (defun calc-delete-selection (n)
542 (let ((entry (calc-top n
'entry
)))
544 (if (eq (nth 2 entry
) (car entry
))
546 (calc-pop-stack 1 n t
)
547 (calc-push-list '(0) n
))
548 (let ((parent (calc-find-parent-formula (car entry
) (nth 2 entry
)))
550 (calc-preserve-point)
551 (calc-pop-stack 1 n t
)
552 (cond ((or (memq (car parent
) '(* / %
))
553 (and (eq (car parent
) '^
)
554 (eq (nth 2 parent
) (nth 2 entry
))))
556 ((memq (car parent
) '(vec calcFunc-min calcFunc-max
)))
557 ((and (assq (car parent
) calc-tweak-eqn-table
)
558 (= (length parent
) 3))
564 (calc-push-list (list
566 (calc-replace-sub-formula
569 (if (eq (nth 2 entry
) (nth 1 parent
))
574 (calc-push-list (list
576 (calc-replace-sub-formula (car entry
)
581 (calc-push-list (list
583 (calc-replace-sub-formula (car entry
)
589 (calc-pop-stack 1 n t
))))
591 (defun calc-roll-down-with-selections (n m
)
592 (let ((vals (append (calc-top-list m
1)
593 (calc-top-list (- n m
) (1+ m
))))
594 (sels (append (calc-top-list m
1 'sel
)
595 (calc-top-list (- n m
) (1+ m
) 'sel
))))
596 (calc-pop-push-list n vals
1 sels
)))
598 (defun calc-roll-up-with-selections (n m
)
599 (let ((vals (append (calc-top-list (- n m
) 1)
600 (calc-top-list m
(- n m -
1))))
601 (sels (append (calc-top-list (- n m
) 1 'sel
)
602 (calc-top-list m
(- n m -
1) 'sel
))))
603 (calc-pop-push-list n vals
1 sels
)))
605 ;; The variable calc-sel-reselect is local to several functions
606 ;; which call calc-auto-selection.
607 (defvar calc-sel-reselect
)
609 (defun calc-auto-selection (entry)
612 (setq calc-sel-reselect nil
)
613 (calc-prepare-selection)
614 (calc-grow-assoc-formula (car entry
) (calc-find-selected-part)))))
616 (defun calc-copy-selection ()
619 (calc-preserve-point)
620 (let* ((num (max 1 (calc-locate-cursor-element (point))))
621 (entry (calc-top num
'entry
)))
622 (calc-push (or (calc-auto-selection entry
) (car entry
))))))
624 (defun calc-del-selection ()
627 (calc-preserve-point)
628 (let* ((num (max 1 (calc-locate-cursor-element (point))))
629 (entry (calc-top num
'entry
))
630 (sel (calc-auto-selection entry
)))
631 (setcar (nthcdr 2 entry
) (and (not (eq sel
(car entry
))) sel
))
632 (calc-delete-selection num
))))
634 (defvar calc-selection-history nil
635 "History for calc selections.")
637 (defun calc-enter-selection ()
640 (calc-preserve-point)
641 (let* ((num (max 1 (calc-locate-cursor-element (point))))
642 (calc-sel-reselect calc-keep-selection
)
643 (entry (calc-top num
'entry
))
645 (sel (or (calc-auto-selection entry
) expr
))
647 (let ((calc-dollar-values (list sel
))
648 (calc-dollar-used 0))
649 (setq alg
(calc-do-alg-entry "" "Replace selection with: " nil
650 'calc-selection-history
))
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
)
683 (defvar calc-edit-top
)
685 (defun calc-finish-selection-edit (num sel reselect
)
686 (let ((buf (current-buffer))
687 (str (buffer-substring calc-edit-top
(point-max)))
689 (switch-to-buffer calc-original-buffer
)
690 (let ((val (math-read-expr str
)))
691 (if (eq (car-safe val
) 'error
)
693 (switch-to-buffer buf
)
694 (goto-char (+ start
(nth 1 val
)))
695 (error (nth 2 val
))))
697 (calc-preserve-point)
698 (if calc-edit-disp-trail
699 (calc-trail-display 1 t
))
700 (setq val
(calc-encase-atoms (calc-normalize val
)))
701 (let ((expr (calc-top num
'full
)))
702 (if (calc-find-sub-formula expr sel
)
703 (calc-pop-push-record-list 1 "edit"
704 (list (calc-replace-sub-formula
707 (list (and reselect val
)))
709 (error "Original selection has been lost")))))))
711 (defun calc-sel-evaluate (arg)
714 (calc-preserve-point)
715 (let* ((num (max 1 (calc-locate-cursor-element (point))))
716 (calc-sel-reselect calc-keep-selection
)
717 (entry (calc-top num
'entry
))
718 (sel (or (calc-auto-selection entry
) (car entry
))))
719 (calc-with-default-simplification
720 (let ((math-simplify-only nil
))
721 (calc-modify-simplify-mode arg
)
722 (let ((val (calc-encase-atoms (calc-normalize sel
))))
723 (calc-pop-push-record-list 1 "jsmp"
724 (list (calc-replace-sub-formula
725 (car entry
) sel val
))
727 (list (and calc-sel-reselect val
))))))
728 (calc-handle-whys))))
730 (defun calc-sel-expand-formula (arg)
733 (calc-preserve-point)
734 (let* ((num (max 1 (calc-locate-cursor-element (point))))
735 (calc-sel-reselect calc-keep-selection
)
736 (entry (calc-top num
'entry
))
737 (sel (or (calc-auto-selection entry
) (car entry
))))
738 (calc-with-default-simplification
739 (let ((math-simplify-only nil
))
740 (calc-modify-simplify-mode arg
)
741 (let* ((math-expand-formulas (> arg
0))
742 (val (calc-normalize sel
))
745 (setq top
(math-expand-formula val
))
746 (setq val
(calc-normalize top
)))
747 (setq val
(calc-encase-atoms val
))
748 (calc-pop-push-record-list 1 "jexf"
749 (list (calc-replace-sub-formula
750 (car entry
) sel val
))
752 (list (and calc-sel-reselect val
))))))
753 (calc-handle-whys))))
755 (defun calc-sel-mult-both-sides (arg &optional divide
)
758 (calc-preserve-point)
759 (let* ((no-simp (consp arg
))
760 (num (max 1 (calc-locate-cursor-element (point))))
761 (calc-sel-reselect calc-keep-selection
)
762 (entry (calc-top num
'entry
))
764 (sel (or (calc-auto-selection entry
) expr
))
765 (func (car-safe sel
))
767 (setq alg
(calc-with-default-simplification
768 (car (calc-do-alg-entry ""
770 "Divide both sides by: "
771 "Multiply both sides by: ")
772 nil
'calc-selection-history
))))
775 (if (and (or (eq func
'/)
776 (assq func calc-tweak-eqn-table
))
779 (or (memq func
'(/ calcFunc-eq calcFunc-neq
))
780 (if (math-known-nonposp alg
)
782 (setq func
(nth 1 (assq func
783 calc-tweak-eqn-table
)))
784 (or (math-known-negp alg
)
785 (message "Assuming this factor is nonzero")))
786 (or (math-known-posp alg
)
787 (if (math-known-nonnegp alg
)
788 (message "Assuming this factor is nonzero")
789 (message "Assuming this factor is positive")))))
790 (setq lhs
(list (if divide
'/ '*) (nth 1 sel
) alg
)
791 rhs
(list (if divide
'/ '*) (nth 2 sel
) alg
))
794 (setq lhs
(math-simplify lhs
)
795 rhs
(math-simplify rhs
))
797 (or (Math-equal (nth 1 sel
) 1)
798 (Math-equal (nth 1 sel
) -
1))
799 ; (and (memq (car-safe (nth 2 sel)) '(+ -))
800 ; (memq (car-safe alg) '(+ -))))
802 (setq rhs
(math-expand-term rhs
))))))
803 (if (and arg
(not no-simp
))
804 (setq rhs
(math-simplify
805 (calcFunc-expand rhs
(unless (= arg
0) arg
)))))
806 (setq alg
(calc-encase-atoms
807 (calc-normalize (list func lhs rhs
)))))
808 (setq rhs
(list (if divide
'* '/) sel alg
))
810 (setq rhs
(math-simplify rhs
)))
811 (setq alg
(calc-encase-atoms
812 (calc-normalize (if divide
814 (list '* alg rhs
))))))
815 (calc-pop-push-record-list 1 (if divide
"div" "mult")
816 (list (calc-replace-sub-formula
819 (list (and calc-sel-reselect alg
)))))
820 (calc-handle-whys))))
822 (defun calc-sel-div-both-sides (no-simp)
824 (calc-sel-mult-both-sides no-simp t
))
826 (defun calc-sel-add-both-sides (no-simp &optional subtract
)
829 (calc-preserve-point)
830 (let* ((num (max 1 (calc-locate-cursor-element (point))))
831 (calc-sel-reselect calc-keep-selection
)
832 (entry (calc-top num
'entry
))
834 (sel (or (calc-auto-selection entry
) expr
))
835 (func (car-safe sel
))
837 (setq alg
(calc-with-default-simplification
838 (car (calc-do-alg-entry ""
840 "Subtract from both sides: "
841 "Add to both sides: ")
842 nil
'calc-selection-history
))))
845 (if (and (assq func calc-tweak-eqn-table
)
848 (setq lhs
(list (if subtract
'-
'+) (nth 1 sel
) alg
)
849 rhs
(list (if subtract
'-
'+) (nth 2 sel
) alg
))
851 (setq lhs
(math-simplify lhs
)
852 rhs
(math-simplify rhs
)))
853 (setq alg
(calc-encase-atoms
854 (calc-normalize (list func lhs rhs
)))))
855 (setq rhs
(list (if subtract
'+ '-
) sel alg
))
857 (setq rhs
(math-simplify rhs
)))
858 (setq alg
(calc-encase-atoms
859 (calc-normalize (list (if subtract
'-
'+) alg rhs
)))))
860 (calc-pop-push-record-list 1 (if subtract
"sub" "add")
861 (list (calc-replace-sub-formula
864 (list (and calc-sel-reselect alg
)))))
865 (calc-handle-whys))))
867 (defun calc-sel-sub-both-sides (no-simp)
869 (calc-sel-add-both-sides no-simp t
))
873 ;; arch-tag: e5169792-777d-428f-bff5-acca66813fa2
874 ;;; calc-sel.el ends here