1 ;;; calc-sel.el --- data selection functions for Calc
3 ;; Copyright (C) 1990-1993, 2001-2017 Free Software Foundation, Inc.
5 ;; Author: David Gillespie <daveg@synaptics.com>
7 ;; This file is part of GNU Emacs.
9 ;; GNU Emacs is free software: you can redistribute it and/or modify
10 ;; it under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation, either version 3 of the License, or
12 ;; (at your option) any later version.
14 ;; GNU Emacs is distributed in the hope that it will be useful,
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 ;; GNU General Public License for more details.
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
26 ;; This file is autoloaded from calc-ext.el.
31 ;;; Selection commands.
33 (defvar calc-keep-selection t
)
35 (defvar calc-selection-cache-entry nil
)
36 (defvar calc-selection-cache-num
)
37 (defvar calc-selection-cache-comp
)
38 (defvar calc-selection-cache-offset
)
39 (defvar calc-selection-true-num
)
41 (defun calc-select-here (num &optional once keep
)
44 (calc-prepare-selection)
45 (let ((found (calc-find-selected-part))
46 (entry calc-selection-cache-entry
))
47 (or (and keep
(nth 2 entry
))
50 (setq calc-keep-selection nil
)
51 (message "(Selection will apply to next command only)")))
52 (calc-change-current-selection
54 (if (and num
(> (setq num
(prefix-numeric-value num
)) 0))
56 (while (and (>= (setq num
(1- num
)) 0)
57 (not (eq found
(car entry
))))
58 (setq found
(calc-find-assoc-parent-formula
61 (calc-grow-assoc-formula (car entry
) found
))
64 (defun calc-select-once (num)
66 (calc-select-here num t
))
68 (defun calc-select-here-maybe (num)
70 (calc-select-here num nil t
))
72 (defun calc-select-once-maybe (num)
74 (calc-select-here num t t
))
76 (defun calc-select-additional ()
79 (let (calc-keep-selection)
80 (calc-prepare-selection))
81 (let ((found (calc-find-selected-part))
82 (entry calc-selection-cache-entry
))
83 (calc-change-current-selection
85 (let ((sel (nth 2 entry
)))
88 (while (not (or (eq sel
(car entry
))
89 (calc-find-sub-formula sel found
)))
90 (setq sel
(calc-find-assoc-parent-formula
93 (calc-grow-assoc-formula (car entry
) found
)))
96 (defun calc-select-more (num)
99 (calc-prepare-selection)
100 (let ((entry calc-selection-cache-entry
))
102 (let ((sel (nth 2 entry
)))
103 (while (and (not (eq sel
(car entry
)))
104 (>= (setq num
(1- (prefix-numeric-value num
))) 0))
105 (setq sel
(calc-find-assoc-parent-formula (car entry
) sel
)))
106 (calc-change-current-selection sel
))
107 (calc-select-here num
)))))
109 (defun calc-select-less (num)
112 (calc-prepare-selection)
113 (let ((found (calc-find-selected-part))
114 (entry calc-selection-cache-entry
))
115 (calc-change-current-selection
117 (let ((sel (nth 2 entry
))
121 (>= (setq num
(1- num
)) 0))
123 index
(calc-find-sub-formula sel found
))
124 (and (setq sel
(and index
(nth index old
)))
125 calc-assoc-selections
126 (setq op
(assq (car-safe sel
) calc-assoc-ops
))
127 (memq (car old
) (nth index op
))
128 (setq num
(1+ num
))))
131 (defun calc-select-part (num)
133 (or num
(setq num
(- last-command-event ?
0)))
135 (calc-prepare-selection)
136 (let ((sel (calc-find-nth-part (or (nth 2 calc-selection-cache-entry
)
137 (car calc-selection-cache-entry
))
140 (calc-change-current-selection sel
)
141 (error "%d is not a valid sub-formula index" num
)))))
143 ;; The variables calc-fnp-op and calc-fnp-num are local to
144 ;; calc-find-nth-part (and calc-select-previous) but used by
145 ;; calc-find-nth-part-rec, which is called by them.
147 (defvar calc-fnp-num
)
149 (defun calc-find-nth-part (expr calc-fnp-num
)
150 (if (and calc-assoc-selections
151 (assq (car-safe expr
) calc-assoc-ops
))
153 (calc-find-nth-part-rec expr
))
154 (if (eq (car-safe expr
) 'intv
)
155 (and (>= calc-fnp-num
1) (<= calc-fnp-num
2) (nth (1+ calc-fnp-num
) expr
))
156 (and (not (Math-primp expr
)) (>= calc-fnp-num
1) (< calc-fnp-num
(length expr
))
157 (nth calc-fnp-num expr
)))))
159 (defun calc-find-nth-part-rec (expr) ; uses num, op
160 (or (if (and (setq calc-fnp-op
(assq (car-safe (nth 1 expr
)) calc-assoc-ops
))
161 (memq (car expr
) (nth 1 calc-fnp-op
)))
162 (calc-find-nth-part-rec (nth 1 expr
))
163 (and (= (setq calc-fnp-num
(1- calc-fnp-num
)) 0)
165 (if (and (setq calc-fnp-op
(assq (car-safe (nth 2 expr
)) calc-assoc-ops
))
166 (memq (car expr
) (nth 2 calc-fnp-op
)))
167 (calc-find-nth-part-rec (nth 2 expr
))
168 (and (= (setq calc-fnp-num
(1- calc-fnp-num
)) 0)
171 (defun calc-select-next (num)
174 (calc-select-previous (- num
))
176 (calc-prepare-selection)
177 (let* ((entry calc-selection-cache-entry
)
181 (while (>= (setq num
(1- num
)) 0)
182 (let* ((parent (calc-find-parent-formula (car entry
) sel
))
185 (and (eq p t
) (setq p nil
))
186 (while (and (setq p
(cdr p
))
187 (not (eq (car p
) sel
))))
189 (setq sel
(or (and calc-assoc-selections
190 (setq op
(assq (car-safe (nth 1 p
))
192 (memq (car parent
) (nth 2 op
))
195 (if (and calc-assoc-selections
196 (setq op
(assq (car-safe parent
) calc-assoc-ops
))
197 (consp (setq p
(calc-find-parent-formula
198 (car entry
) parent
)))
199 (eq (nth 1 p
) parent
)
200 (memq (car p
) (nth 1 op
)))
202 (error "No \"next\" sub-formula")))))
203 (calc-change-current-selection sel
))
204 (if (Math-primp (car entry
))
205 (calc-change-current-selection (car entry
))
206 (calc-select-part num
)))))))
208 (defun calc-select-previous (num)
211 (calc-select-next (- num
))
213 (calc-prepare-selection)
214 (let* ((entry calc-selection-cache-entry
)
218 (while (>= (setq num
(1- num
)) 0)
219 (let* ((parent (calc-find-parent-formula (car entry
) sel
))
220 (p (cdr-safe parent
))
223 (if (eq (car-safe parent
) 'intv
) (setq p
(cdr p
)))
224 (while (and (not (eq (car p
) sel
))
228 (setq sel
(or (and calc-assoc-selections
229 (setq op
(assq (car-safe prev
)
231 (memq (car parent
) (nth 1 op
))
234 (if (and calc-assoc-selections
235 (setq op
(assq (car-safe parent
) calc-assoc-ops
))
236 (consp (setq p
(calc-find-parent-formula
237 (car entry
) parent
)))
238 (eq (nth 2 p
) parent
)
239 (memq (car p
) (nth 2 op
)))
241 (error "No \"previous\" sub-formula")))))
242 (calc-change-current-selection sel
))
243 (if (Math-primp (car entry
))
244 (calc-change-current-selection (car entry
))
245 (let ((len (if (and calc-assoc-selections
246 (assq (car (car entry
)) calc-assoc-ops
))
247 (let (calc-fnp-op (calc-fnp-num 0))
248 (calc-find-nth-part-rec (car entry
))
250 (length (car entry
)))))
251 (calc-select-part (- len num
)))))))))
253 (defun calc-find-parent-formula (expr part
)
254 (cond ((eq expr part
) t
)
255 ((Math-primp expr
) nil
)
258 (while (and (setq p
(cdr p
))
259 (not (setq res
(calc-find-parent-formula
262 (if (eq res t
) expr res
))))))
265 (defun calc-find-assoc-parent-formula (expr part
)
266 (calc-grow-assoc-formula expr
(calc-find-parent-formula expr part
)))
268 (defun calc-grow-assoc-formula (expr part
)
269 (if calc-assoc-selections
270 (let ((op (assq (car-safe part
) calc-assoc-ops
)))
273 (while (and (consp (setq new
(calc-find-parent-formula
276 (nth (calc-find-sub-formula new part
) op
)))
281 (defun calc-find-sub-formula (expr part
)
282 (cond ((eq expr part
) t
)
283 ((Math-primp expr
) nil
)
286 (while (and (setq expr
(cdr expr
))
287 (not (calc-find-sub-formula (car expr
) part
)))
291 (defun calc-unselect (num)
294 (calc-prepare-selection num
)
295 (calc-change-current-selection nil
)))
297 (defun calc-clear-selections ()
300 (let ((limit (calc-stack-size))
303 (if (calc-top n
'sel
)
305 (calc-prepare-selection n
)
306 (calc-change-current-selection nil
)))
308 (calc-clear-command-flag 'position-point
)))
310 (defvar calc-highlight-selections-with-faces
)
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 (if calc-highlight-selections-with-faces
334 "De-emphasizing all but selected part of formulas"
335 "Displaying only selected part of formulas")
336 (if calc-highlight-selections-with-faces
337 "Emphasizing 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 "Invalid 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 (defvar calc-selection-history nil
639 "History for calc selections.")
641 (defun calc-enter-selection ()
644 (calc-preserve-point)
645 (let* ((num (max 1 (calc-locate-cursor-element (point))))
646 (calc-sel-reselect calc-keep-selection
)
647 (entry (calc-top num
'entry
))
649 (sel (or (calc-auto-selection entry
) expr
))
651 (let ((calc-dollar-values (list sel
))
652 (calc-dollar-used 0))
653 (setq alg
(calc-do-alg-entry "" "Replace selection with: " nil
654 'calc-selection-history
))
657 (setq alg
(calc-encase-atoms (car alg
)))
658 (calc-pop-push-record-list 1 "repl"
659 (list (calc-replace-sub-formula
662 (list (and calc-sel-reselect alg
))))))
663 (calc-handle-whys))))
665 (defun calc-edit-selection ()
668 (calc-preserve-point)
669 (let* ((num (max 1 (calc-locate-cursor-element (point))))
670 (calc-sel-reselect calc-keep-selection
)
671 (entry (calc-top num
'entry
))
673 (sel (or (calc-auto-selection entry
) expr
))
675 (let ((str (math-showing-full-precision
676 (math-format-nice-expr sel
(frame-width)))))
677 (calc-edit-mode (list 'calc-finish-selection-edit
678 num
(list 'quote sel
) calc-sel-reselect
))
680 (calc-show-edit-buffer))
682 (defvar calc-original-buffer
)
684 ;; The variable calc-edit-disp-trail is local to calc-edit-finish,
686 (defvar calc-edit-disp-trail
)
687 (defvar calc-edit-top
)
689 (defun calc-finish-selection-edit (num sel reselect
)
690 (let ((buf (current-buffer))
691 (str (buffer-substring calc-edit-top
(point-max)))
693 (switch-to-buffer calc-original-buffer
)
694 (let ((val (math-read-expr str
)))
695 (if (eq (car-safe val
) 'error
)
697 (switch-to-buffer buf
)
698 (goto-char (+ start
(nth 1 val
)))
699 (error (nth 2 val
))))
701 (calc-preserve-point)
702 (if calc-edit-disp-trail
703 (calc-trail-display 1 t
))
704 (setq val
(calc-encase-atoms (calc-normalize val
)))
705 (let ((expr (calc-top num
'full
)))
706 (if (calc-find-sub-formula expr sel
)
707 (calc-pop-push-record-list 1 "edit"
708 (list (calc-replace-sub-formula
711 (list (and reselect val
)))
713 (error "Original selection has been lost")))))))
715 (defun calc-sel-evaluate (arg)
718 (calc-preserve-point)
719 (let* ((num (max 1 (calc-locate-cursor-element (point))))
720 (calc-sel-reselect calc-keep-selection
)
721 (entry (calc-top num
'entry
))
722 (sel (or (calc-auto-selection entry
) (car entry
))))
723 (calc-with-default-simplification
724 (let ((math-simplify-only nil
))
725 (calc-modify-simplify-mode arg
)
726 (let ((val (calc-encase-atoms (calc-normalize sel
))))
727 (calc-pop-push-record-list 1 "jsmp"
728 (list (calc-replace-sub-formula
729 (car entry
) sel val
))
731 (list (and calc-sel-reselect val
))))))
732 (calc-handle-whys))))
734 (defun calc-sel-expand-formula (arg)
737 (calc-preserve-point)
738 (let* ((num (max 1 (calc-locate-cursor-element (point))))
739 (calc-sel-reselect calc-keep-selection
)
740 (entry (calc-top num
'entry
))
741 (sel (or (calc-auto-selection entry
) (car entry
))))
742 (calc-with-default-simplification
743 (let ((math-simplify-only nil
))
744 (calc-modify-simplify-mode arg
)
745 (let* ((math-expand-formulas (> arg
0))
746 (val (calc-normalize sel
))
749 (setq top
(math-expand-formula val
))
750 (setq val
(calc-normalize top
)))
751 (setq val
(calc-encase-atoms val
))
752 (calc-pop-push-record-list 1 "jexf"
753 (list (calc-replace-sub-formula
754 (car entry
) sel val
))
756 (list (and calc-sel-reselect val
))))))
757 (calc-handle-whys))))
759 (defun calc-sel-mult-both-sides (arg &optional divide
)
762 (calc-preserve-point)
763 (let* ((no-simp (consp arg
))
764 (num (max 1 (calc-locate-cursor-element (point))))
765 (calc-sel-reselect calc-keep-selection
)
766 (entry (calc-top num
'entry
))
768 (sel (or (calc-auto-selection entry
) expr
))
769 (func (car-safe sel
))
771 (setq alg
(calc-with-default-simplification
772 (car (calc-do-alg-entry ""
774 "Divide both sides by: "
775 "Multiply both sides by: ")
776 nil
'calc-selection-history
))))
779 (if (and (or (eq func
'/)
780 (assq func calc-tweak-eqn-table
))
783 (or (memq func
'(/ calcFunc-eq calcFunc-neq
))
784 (if (math-known-nonposp alg
)
786 (setq func
(nth 1 (assq func
787 calc-tweak-eqn-table
)))
788 (or (math-known-negp alg
)
789 (message "Assuming this factor is nonzero")))
790 (or (math-known-posp alg
)
791 (if (math-known-nonnegp alg
)
792 (message "Assuming this factor is nonzero")
793 (message "Assuming this factor is positive")))))
794 (setq lhs
(list (if divide
'/ '*) (nth 1 sel
) alg
)
795 rhs
(list (if divide
'/ '*) (nth 2 sel
) alg
))
798 (setq lhs
(math-simplify lhs
)
799 rhs
(math-simplify rhs
))
801 (or (Math-equal (nth 1 sel
) 1)
802 (Math-equal (nth 1 sel
) -
1))
803 ; (and (memq (car-safe (nth 2 sel)) '(+ -))
804 ; (memq (car-safe alg) '(+ -))))
806 (setq rhs
(math-expand-term rhs
))))))
807 (if (and arg
(not no-simp
))
808 (setq rhs
(math-simplify
809 (calcFunc-expand rhs
(unless (= arg
0) arg
)))))
810 (setq alg
(calc-encase-atoms
811 (calc-normalize (list func lhs rhs
)))))
812 (setq rhs
(list (if divide
'* '/) sel alg
))
814 (setq rhs
(math-simplify rhs
)))
815 (setq alg
(calc-encase-atoms
816 (calc-normalize (if divide
818 (list '* alg rhs
))))))
819 (calc-pop-push-record-list 1 (if divide
"div" "mult")
820 (list (calc-replace-sub-formula
823 (list (and calc-sel-reselect alg
)))))
824 (calc-handle-whys))))
826 (defun calc-sel-div-both-sides (no-simp)
828 (calc-sel-mult-both-sides no-simp t
))
830 (defun calc-sel-add-both-sides (no-simp &optional subtract
)
833 (calc-preserve-point)
834 (let* ((num (max 1 (calc-locate-cursor-element (point))))
835 (calc-sel-reselect calc-keep-selection
)
836 (entry (calc-top num
'entry
))
838 (sel (or (calc-auto-selection entry
) expr
))
839 (func (car-safe sel
))
841 (setq alg
(calc-with-default-simplification
842 (car (calc-do-alg-entry ""
844 "Subtract from both sides: "
845 "Add to both sides: ")
846 nil
'calc-selection-history
))))
849 (if (and (assq func calc-tweak-eqn-table
)
852 (setq lhs
(list (if subtract
'-
'+) (nth 1 sel
) alg
)
853 rhs
(list (if subtract
'-
'+) (nth 2 sel
) alg
))
855 (setq lhs
(math-simplify lhs
)
856 rhs
(math-simplify rhs
)))
857 (setq alg
(calc-encase-atoms
858 (calc-normalize (list func lhs rhs
)))))
859 (setq rhs
(list (if subtract
'+ '-
) sel alg
))
861 (setq rhs
(math-simplify rhs
)))
862 (setq alg
(calc-encase-atoms
863 (calc-normalize (list (if subtract
'-
'+) alg rhs
)))))
864 (calc-pop-push-record-list 1 (if subtract
"sub" "add")
865 (list (calc-replace-sub-formula
868 (list (and calc-sel-reselect alg
)))))
869 (calc-handle-whys))))
871 (defun calc-sel-sub-both-sides (no-simp)
873 (calc-sel-add-both-sides no-simp t
))
877 ;;; calc-sel.el ends here