Commit | Line | Data |
---|---|---|
3132f345 CW |
1 | ;;; calc-sel.el --- data selection functions for Calc |
2 | ||
58ba2f8f | 3 | ;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, |
5df4f04c | 4 | ;; 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. |
3132f345 CW |
5 | |
6 | ;; Author: David Gillespie <daveg@synaptics.com> | |
e8fff8ed | 7 | ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> |
136211a9 EZ |
8 | |
9 | ;; This file is part of GNU Emacs. | |
10 | ||
662c9c64 | 11 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
7c671b23 | 12 | ;; it under the terms of the GNU General Public License as published by |
662c9c64 GM |
13 | ;; the Free Software Foundation, either version 3 of the License, or |
14 | ;; (at your option) any later version. | |
7c671b23 | 15 | |
136211a9 | 16 | ;; GNU Emacs is distributed in the hope that it will be useful, |
7c671b23 GM |
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. | |
20 | ||
21 | ;; You should have received a copy of the GNU General Public License | |
662c9c64 | 22 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
136211a9 | 23 | |
3132f345 | 24 | ;;; Commentary: |
136211a9 | 25 | |
3132f345 | 26 | ;;; Code: |
136211a9 EZ |
27 | |
28 | ;; This file is autoloaded from calc-ext.el. | |
136211a9 | 29 | |
da0ae499 | 30 | (require 'calc-ext) |
136211a9 EZ |
31 | (require 'calc-macs) |
32 | ||
136211a9 EZ |
33 | ;;; Selection commands. |
34 | ||
3132f345 CW |
35 | (defvar calc-keep-selection t) |
36 | ||
8416e352 JB |
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) | |
42 | ||
136211a9 EZ |
43 | (defun calc-select-here (num &optional once keep) |
44 | (interactive "P") | |
45 | (calc-wrapper | |
46 | (calc-prepare-selection) | |
47 | (let ((found (calc-find-selected-part)) | |
48 | (entry calc-selection-cache-entry)) | |
49 | (or (and keep (nth 2 entry)) | |
50 | (progn | |
51 | (if once (progn | |
52 | (setq calc-keep-selection nil) | |
53 | (message "(Selection will apply to next command only)"))) | |
a1506d29 | 54 | (calc-change-current-selection |
136211a9 EZ |
55 | (if found |
56 | (if (and num (> (setq num (prefix-numeric-value num)) 0)) | |
57 | (progn | |
58 | (while (and (>= (setq num (1- num)) 0) | |
59 | (not (eq found (car entry)))) | |
60 | (setq found (calc-find-assoc-parent-formula | |
61 | (car entry) found))) | |
62 | found) | |
63 | (calc-grow-assoc-formula (car entry) found)) | |
bf77c646 | 64 | (car entry)))))))) |
136211a9 EZ |
65 | |
66 | (defun calc-select-once (num) | |
67 | (interactive "P") | |
bf77c646 | 68 | (calc-select-here num t)) |
136211a9 EZ |
69 | |
70 | (defun calc-select-here-maybe (num) | |
71 | (interactive "P") | |
bf77c646 | 72 | (calc-select-here num nil t)) |
136211a9 EZ |
73 | |
74 | (defun calc-select-once-maybe (num) | |
75 | (interactive "P") | |
bf77c646 | 76 | (calc-select-here num t t)) |
136211a9 EZ |
77 | |
78 | (defun calc-select-additional () | |
79 | (interactive) | |
80 | (calc-wrapper | |
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 | |
86 | (if found | |
87 | (let ((sel (nth 2 entry))) | |
88 | (if sel | |
89 | (progn | |
90 | (while (not (or (eq sel (car entry)) | |
91 | (calc-find-sub-formula sel found))) | |
92 | (setq sel (calc-find-assoc-parent-formula | |
93 | (car entry) sel))) | |
94 | sel) | |
95 | (calc-grow-assoc-formula (car entry) found))) | |
bf77c646 | 96 | (car entry)))))) |
136211a9 EZ |
97 | |
98 | (defun calc-select-more (num) | |
99 | (interactive "P") | |
100 | (calc-wrapper | |
101 | (calc-prepare-selection) | |
102 | (let ((entry calc-selection-cache-entry)) | |
103 | (if (nth 2 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)) | |
bf77c646 | 109 | (calc-select-here num))))) |
136211a9 EZ |
110 | |
111 | (defun calc-select-less (num) | |
112 | (interactive "p") | |
113 | (calc-wrapper | |
114 | (calc-prepare-selection) | |
115 | (let ((found (calc-find-selected-part)) | |
116 | (entry calc-selection-cache-entry)) | |
a1506d29 | 117 | (calc-change-current-selection |
136211a9 EZ |
118 | (and found |
119 | (let ((sel (nth 2 entry)) | |
120 | old index op) | |
121 | (while (and sel | |
122 | (not (eq sel found)) | |
123 | (>= (setq num (1- num)) 0)) | |
124 | (setq old sel | |
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)))) | |
bf77c646 | 131 | sel)))))) |
136211a9 EZ |
132 | |
133 | (defun calc-select-part (num) | |
134 | (interactive "P") | |
e93c003e | 135 | (or num (setq num (- last-command-event ?0))) |
136211a9 EZ |
136 | (calc-wrapper |
137 | (calc-prepare-selection) | |
138 | (let ((sel (calc-find-nth-part (or (nth 2 calc-selection-cache-entry) | |
139 | (car calc-selection-cache-entry)) | |
140 | num))) | |
141 | (if sel | |
142 | (calc-change-current-selection sel) | |
bf77c646 | 143 | (error "%d is not a valid sub-formula index" num))))) |
136211a9 | 144 | |
8416e352 JB |
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. | |
148 | (defvar calc-fnp-op) | |
149 | (defvar calc-fnp-num) | |
150 | ||
151 | (defun calc-find-nth-part (expr calc-fnp-num) | |
136211a9 EZ |
152 | (if (and calc-assoc-selections |
153 | (assq (car-safe expr) calc-assoc-ops)) | |
8416e352 | 154 | (let (calc-fnp-op) |
136211a9 EZ |
155 | (calc-find-nth-part-rec expr)) |
156 | (if (eq (car-safe expr) 'intv) | |
8416e352 JB |
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))))) | |
136211a9 EZ |
160 | |
161 | (defun calc-find-nth-part-rec (expr) ; uses num, op | |
8416e352 JB |
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))) | |
136211a9 | 164 | (calc-find-nth-part-rec (nth 1 expr)) |
8416e352 | 165 | (and (= (setq calc-fnp-num (1- calc-fnp-num)) 0) |
136211a9 | 166 | (nth 1 expr))) |
8416e352 JB |
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))) | |
136211a9 | 169 | (calc-find-nth-part-rec (nth 2 expr)) |
8416e352 | 170 | (and (= (setq calc-fnp-num (1- calc-fnp-num)) 0) |
bf77c646 | 171 | (nth 2 expr))))) |
136211a9 EZ |
172 | |
173 | (defun calc-select-next (num) | |
174 | (interactive "p") | |
175 | (if (< num 0) | |
176 | (calc-select-previous (- num)) | |
177 | (calc-wrapper | |
178 | (calc-prepare-selection) | |
179 | (let* ((entry calc-selection-cache-entry) | |
180 | (sel (nth 2 entry))) | |
181 | (if sel | |
182 | (progn | |
183 | (while (>= (setq num (1- num)) 0) | |
184 | (let* ((parent (calc-find-parent-formula (car entry) sel)) | |
185 | (p parent) | |
186 | op) | |
187 | (and (eq p t) (setq p nil)) | |
188 | (while (and (setq p (cdr p)) | |
189 | (not (eq (car p) sel)))) | |
190 | (if (cdr p) | |
191 | (setq sel (or (and calc-assoc-selections | |
192 | (setq op (assq (car-safe (nth 1 p)) | |
193 | calc-assoc-ops)) | |
194 | (memq (car parent) (nth 2 op)) | |
195 | (nth 1 (nth 1 p))) | |
196 | (nth 1 p))) | |
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))) | |
203 | (setq sel (nth 2 p)) | |
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)) | |
bf77c646 | 208 | (calc-select-part num))))))) |
136211a9 EZ |
209 | |
210 | (defun calc-select-previous (num) | |
211 | (interactive "p") | |
212 | (if (< num 0) | |
213 | (calc-select-next (- num)) | |
214 | (calc-wrapper | |
215 | (calc-prepare-selection) | |
216 | (let* ((entry calc-selection-cache-entry) | |
217 | (sel (nth 2 entry))) | |
218 | (if sel | |
219 | (progn | |
220 | (while (>= (setq num (1- num)) 0) | |
221 | (let* ((parent (calc-find-parent-formula (car entry) sel)) | |
222 | (p (cdr-safe parent)) | |
223 | (prev nil) | |
224 | op) | |
225 | (if (eq (car-safe parent) 'intv) (setq p (cdr p))) | |
226 | (while (and (not (eq (car p) sel)) | |
227 | (setq prev (car p) | |
228 | p (cdr p)))) | |
229 | (if prev | |
230 | (setq sel (or (and calc-assoc-selections | |
231 | (setq op (assq (car-safe prev) | |
232 | calc-assoc-ops)) | |
233 | (memq (car parent) (nth 1 op)) | |
234 | (nth 2 prev)) | |
235 | prev)) | |
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))) | |
242 | (setq sel (nth 1 p)) | |
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)) | |
8416e352 | 249 | (let (calc-fnp-op (calc-fnp-num 0)) |
136211a9 | 250 | (calc-find-nth-part-rec (car entry)) |
8416e352 | 251 | (- 1 calc-fnp-num)) |
136211a9 | 252 | (length (car entry))))) |
bf77c646 | 253 | (calc-select-part (- len num))))))))) |
136211a9 EZ |
254 | |
255 | (defun calc-find-parent-formula (expr part) | |
256 | (cond ((eq expr part) t) | |
257 | ((Math-primp expr) nil) | |
258 | (t | |
259 | (let ((p expr) res) | |
260 | (while (and (setq p (cdr p)) | |
261 | (not (setq res (calc-find-parent-formula | |
262 | (car p) part))))) | |
263 | (and p | |
bf77c646 | 264 | (if (eq res t) expr res)))))) |
136211a9 EZ |
265 | |
266 | ||
267 | (defun calc-find-assoc-parent-formula (expr part) | |
bf77c646 | 268 | (calc-grow-assoc-formula expr (calc-find-parent-formula expr part))) |
136211a9 EZ |
269 | |
270 | (defun calc-grow-assoc-formula (expr part) | |
271 | (if calc-assoc-selections | |
272 | (let ((op (assq (car-safe part) calc-assoc-ops))) | |
273 | (if op | |
274 | (let (new) | |
275 | (while (and (consp (setq new (calc-find-parent-formula | |
276 | expr part))) | |
277 | (memq (car new) | |
278 | (nth (calc-find-sub-formula new part) op))) | |
279 | (setq part new)))) | |
280 | part) | |
bf77c646 | 281 | part)) |
136211a9 EZ |
282 | |
283 | (defun calc-find-sub-formula (expr part) | |
284 | (cond ((eq expr part) t) | |
285 | ((Math-primp expr) nil) | |
286 | (t | |
287 | (let ((num 1)) | |
288 | (while (and (setq expr (cdr expr)) | |
289 | (not (calc-find-sub-formula (car expr) part))) | |
290 | (setq num (1+ num))) | |
bf77c646 | 291 | (and expr num))))) |
136211a9 EZ |
292 | |
293 | (defun calc-unselect (num) | |
294 | (interactive "P") | |
295 | (calc-wrapper | |
296 | (calc-prepare-selection num) | |
bf77c646 | 297 | (calc-change-current-selection nil))) |
136211a9 EZ |
298 | |
299 | (defun calc-clear-selections () | |
300 | (interactive) | |
301 | (calc-wrapper | |
302 | (let ((limit (calc-stack-size)) | |
303 | (n 1)) | |
304 | (while (<= n limit) | |
305 | (if (calc-top n 'sel) | |
306 | (progn | |
307 | (calc-prepare-selection n) | |
308 | (calc-change-current-selection nil))) | |
309 | (setq n (1+ n)))) | |
bf77c646 | 310 | (calc-clear-command-flag 'position-point))) |
136211a9 | 311 | |
2c695727 JB |
312 | (defvar calc-highlight-selections-with-faces) |
313 | ||
136211a9 EZ |
314 | (defun calc-show-selections (arg) |
315 | (interactive "P") | |
316 | (calc-wrapper | |
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)) | |
322 | (while (and p | |
323 | (or (null (nth 2 (car p))) | |
324 | (equal (car p) calc-selection-cache-entry))) | |
325 | (setq p (cdr p))) | |
326 | (or (and p | |
327 | (let ((calc-selection-cache-default-entry | |
328 | calc-selection-cache-entry)) | |
329 | (calc-do-refresh))) | |
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 | |
2c695727 JB |
335 | (if calc-highlight-selections-with-faces |
336 | "De-emphasizing all but selected part of formulas" | |
337 | "Displaying only selected part of formulas") | |
338 | (if calc-highlight-selections-with-faces | |
339 | "Emphasizing selected part of formulas" | |
340 | "Displaying all but selected part of formulas"))))) | |
136211a9 | 341 | |
8416e352 JB |
342 | ;; The variables calc-final-point-line and calc-final-point-column |
343 | ;; are declared in calc.el, and are used throughout. | |
344 | (defvar calc-final-point-line) | |
345 | (defvar calc-final-point-column) | |
346 | ||
136211a9 EZ |
347 | (defun calc-preserve-point () |
348 | (or (looking-at "\\.\n+\\'") | |
349 | (progn | |
350 | (setq calc-final-point-line (+ (count-lines (point-min) (point)) | |
351 | (if (bolp) 1 0)) | |
352 | calc-final-point-column (current-column)) | |
bf77c646 | 353 | (calc-set-command-flag 'position-point)))) |
136211a9 EZ |
354 | |
355 | (defun calc-enable-selections (arg) | |
356 | (interactive "P") | |
357 | (calc-wrapper | |
358 | (calc-preserve-point) | |
359 | (setq calc-use-selections (if arg | |
360 | (> (prefix-numeric-value arg) 0) | |
361 | (not calc-use-selections))) | |
362 | (calc-set-command-flag 'renum-stack) | |
363 | (message (if calc-use-selections | |
364 | "Commands operate only on selected sub-formulas" | |
bf77c646 | 365 | "Selections of sub-formulas have no effect")))) |
136211a9 EZ |
366 | |
367 | (defun calc-break-selections (arg) | |
368 | (interactive "P") | |
369 | (calc-wrapper | |
370 | (calc-preserve-point) | |
371 | (setq calc-assoc-selections (if arg | |
372 | (<= (prefix-numeric-value arg) 0) | |
373 | (not calc-assoc-selections))) | |
374 | (message (if calc-assoc-selections | |
375 | "Selection treats a+b+c as a sum of three terms" | |
bf77c646 | 376 | "Selection treats a+b+c as (a+b)+c")))) |
136211a9 EZ |
377 | |
378 | (defun calc-prepare-selection (&optional num) | |
379 | (or num (setq num (calc-locate-cursor-element (point)))) | |
380 | (setq calc-selection-true-num num | |
381 | calc-keep-selection t) | |
382 | (or (> num 0) (setq num 1)) | |
383 | ;; (if (or (< num 1) (> num (calc-stack-size))) | |
384 | ;; (error "Cursor must be positioned on a stack element")) | |
385 | (let* ((entry (calc-top num 'entry)) | |
386 | ww w) | |
387 | (or (equal entry calc-selection-cache-entry) | |
388 | (progn | |
389 | (setcar entry (calc-encase-atoms (car entry))) | |
390 | (setq calc-selection-cache-entry entry | |
391 | calc-selection-cache-num num | |
392 | calc-selection-cache-comp | |
393 | (let ((math-comp-tagged t)) | |
394 | (math-compose-expr (car entry) 0)) | |
395 | calc-selection-cache-offset | |
396 | (+ (car (math-stack-value-offset calc-selection-cache-comp)) | |
397 | (length calc-left-label) | |
398 | (if calc-line-numbering 4 0)))))) | |
bf77c646 | 399 | (calc-preserve-point)) |
136211a9 EZ |
400 | |
401 | ;;; The following ensures that no two subformulas will be "eq" to each other! | |
402 | (defun calc-encase-atoms (x) | |
403 | (if (or (not (consp x)) | |
404 | (equal x '(float 0 0))) | |
405 | (list 'cplx x 0) | |
406 | (calc-encase-atoms-rec x) | |
bf77c646 | 407 | x)) |
136211a9 EZ |
408 | |
409 | (defun calc-encase-atoms-rec (x) | |
410 | (or (Math-primp x) | |
411 | (progn | |
412 | (if (eq (car x) 'intv) | |
413 | (setq x (cdr x))) | |
414 | (while (setq x (cdr x)) | |
415 | (if (or (not (consp (car x))) | |
416 | (equal (car x) '(float 0 0))) | |
417 | (setcar x (list 'cplx (car x) 0)) | |
bf77c646 | 418 | (calc-encase-atoms-rec (car x))))))) |
136211a9 | 419 | |
1c80b98b JB |
420 | ;; The variable math-comp-sel-tag is local to calc-find-selected-part, |
421 | ;; but is used by math-comp-sel-flat-term and math-comp-add-string-sel | |
422 | ;; in calccomp.el, which are called (indirectly) by calc-find-selected-part. | |
423 | ||
136211a9 EZ |
424 | (defun calc-find-selected-part () |
425 | (let* ((math-comp-sel-hpos (- (current-column) calc-selection-cache-offset)) | |
426 | toppt | |
427 | (lcount 0) | |
428 | (spaces 0) | |
429 | (math-comp-sel-vpos (save-excursion | |
430 | (beginning-of-line) | |
431 | (let ((line (point))) | |
432 | (calc-cursor-stack-index | |
433 | calc-selection-cache-num) | |
434 | (setq toppt (point)) | |
435 | (while (< (point) line) | |
436 | (forward-line 1) | |
437 | (setq spaces (+ spaces | |
438 | (current-indentation)) | |
439 | lcount (1+ lcount))) | |
440 | (- lcount (math-comp-ascent | |
441 | calc-selection-cache-comp) -1)))) | |
442 | (math-comp-sel-cpos (- (point) toppt calc-selection-cache-offset | |
443 | spaces lcount)) | |
444 | (math-comp-sel-tag nil)) | |
445 | (and (>= math-comp-sel-hpos 0) | |
446 | (> calc-selection-true-num 0) | |
447 | (math-composition-to-string calc-selection-cache-comp 1000000)) | |
bf77c646 | 448 | (nth 1 math-comp-sel-tag))) |
136211a9 EZ |
449 | |
450 | (defun calc-change-current-selection (sub-expr) | |
451 | (or (eq sub-expr (nth 2 calc-selection-cache-entry)) | |
452 | (let ((calc-prepared-composition calc-selection-cache-comp) | |
453 | (buffer-read-only nil) | |
454 | top) | |
455 | (calc-set-command-flag 'renum-stack) | |
456 | (setcar (nthcdr 2 calc-selection-cache-entry) sub-expr) | |
457 | (calc-cursor-stack-index calc-selection-cache-num) | |
458 | (setq top (point)) | |
459 | (calc-cursor-stack-index (1- calc-selection-cache-num)) | |
460 | (delete-region top (point)) | |
461 | (let ((calc-selection-cache-default-entry calc-selection-cache-entry)) | |
462 | (insert (math-format-stack-value calc-selection-cache-entry) | |
bf77c646 | 463 | "\n"))))) |
136211a9 EZ |
464 | |
465 | (defun calc-top-selected (&optional n m) | |
466 | (and calc-any-selections | |
467 | calc-use-selections | |
468 | (progn | |
469 | (or n (setq n 1)) | |
470 | (or m (setq m 1)) | |
471 | (calc-check-stack (+ n m -1)) | |
472 | (let ((top (nthcdr (+ m calc-stack-top -1) calc-stack)) | |
473 | (sel nil)) | |
474 | (while (>= (setq n (1- n)) 0) | |
475 | (if (nth 2 (car top)) | |
476 | (setq sel (if sel t (nth 2 (car top))))) | |
477 | (setq top (cdr top))) | |
bf77c646 | 478 | sel)))) |
136211a9 | 479 | |
8416e352 JB |
480 | ;; The variables calc-rsf-old and calc-rsf-new are local to |
481 | ;; calc-replace-sub-formula, but used by calc-replace-sub-formula-rec, | |
482 | ;; which is called by calc-replace-sub-formula. | |
483 | (defvar calc-rsf-old) | |
484 | (defvar calc-rsf-new) | |
485 | ||
486 | (defun calc-replace-sub-formula (expr calc-rsf-old calc-rsf-new) | |
487 | (setq calc-rsf-new (calc-encase-atoms calc-rsf-new)) | |
bf77c646 | 488 | (calc-replace-sub-formula-rec expr)) |
136211a9 EZ |
489 | |
490 | (defun calc-replace-sub-formula-rec (expr) | |
8416e352 | 491 | (cond ((eq expr calc-rsf-old) calc-rsf-new) |
136211a9 EZ |
492 | ((Math-primp expr) expr) |
493 | (t | |
494 | (cons (car expr) | |
bf77c646 | 495 | (mapcar 'calc-replace-sub-formula-rec (cdr expr)))))) |
136211a9 EZ |
496 | |
497 | (defun calc-sel-error () | |
25f72ec0 | 498 | (error "Invalid operation on sub-formulas")) |
136211a9 EZ |
499 | |
500 | (defun calc-replace-selections (n vals m) | |
501 | (if (calc-top-selected n m) | |
502 | (let ((num (length vals))) | |
503 | (calc-preserve-point) | |
504 | (cond | |
505 | ((= n num) | |
506 | (let* ((old (calc-top-list n m 'entry)) | |
507 | (new nil) | |
508 | (sel nil) | |
509 | val) | |
510 | (while old | |
511 | (if (nth 2 (car old)) | |
512 | (setq val (calc-encase-atoms (car vals)) | |
513 | new (cons (calc-replace-sub-formula (car (car old)) | |
514 | (nth 2 (car old)) | |
515 | val) | |
516 | new) | |
517 | sel (cons val sel)) | |
518 | (setq new (cons (car vals) new) | |
519 | sel (cons nil sel))) | |
520 | (setq vals (cdr vals) | |
521 | old (cdr old))) | |
522 | (calc-pop-stack n m t) | |
523 | (calc-push-list (nreverse new) | |
524 | m (and calc-keep-selection (nreverse sel))))) | |
525 | ((= num 1) | |
526 | (let* ((old (calc-top-list n m 'entry)) | |
527 | more) | |
528 | (while (and old (not (nth 2 (car old)))) | |
529 | (setq old (cdr old))) | |
530 | (setq more old) | |
531 | (while (and (setq more (cdr more)) (not (nth 2 (car more))))) | |
532 | (and more | |
533 | (calc-sel-error)) | |
534 | (calc-pop-stack n m t) | |
535 | (if old | |
536 | (let ((val (calc-encase-atoms (car vals)))) | |
537 | (calc-push-list (list (calc-replace-sub-formula | |
538 | (car (car old)) | |
539 | (nth 2 (car old)) | |
540 | val)) | |
541 | m (and calc-keep-selection (list val)))) | |
542 | (calc-push-list vals)))) | |
543 | (t (calc-sel-error)))) | |
544 | (calc-pop-stack n m t) | |
bf77c646 | 545 | (calc-push-list vals m))) |
136211a9 EZ |
546 | |
547 | (defun calc-delete-selection (n) | |
548 | (let ((entry (calc-top n 'entry))) | |
549 | (if (nth 2 entry) | |
550 | (if (eq (nth 2 entry) (car entry)) | |
551 | (progn | |
552 | (calc-pop-stack 1 n t) | |
553 | (calc-push-list '(0) n)) | |
554 | (let ((parent (calc-find-parent-formula (car entry) (nth 2 entry))) | |
555 | (repl nil)) | |
556 | (calc-preserve-point) | |
557 | (calc-pop-stack 1 n t) | |
558 | (cond ((or (memq (car parent) '(* / %)) | |
559 | (and (eq (car parent) '^) | |
560 | (eq (nth 2 parent) (nth 2 entry)))) | |
561 | (setq repl 1)) | |
562 | ((memq (car parent) '(vec calcFunc-min calcFunc-max))) | |
563 | ((and (assq (car parent) calc-tweak-eqn-table) | |
564 | (= (length parent) 3)) | |
565 | (setq repl 'del)) | |
566 | (t | |
567 | (setq repl 0))) | |
568 | (cond | |
569 | ((eq repl 'del) | |
570 | (calc-push-list (list | |
571 | (calc-normalize | |
572 | (calc-replace-sub-formula | |
573 | (car entry) | |
574 | parent | |
575 | (if (eq (nth 2 entry) (nth 1 parent)) | |
576 | (nth 2 parent) | |
577 | (nth 1 parent))))) | |
578 | n)) | |
579 | (repl | |
580 | (calc-push-list (list | |
581 | (calc-normalize | |
582 | (calc-replace-sub-formula (car entry) | |
583 | (nth 2 entry) | |
584 | repl))) | |
585 | n)) | |
586 | (t | |
587 | (calc-push-list (list | |
588 | (calc-normalize | |
589 | (calc-replace-sub-formula (car entry) | |
590 | parent | |
591 | (delq (nth 2 entry) | |
592 | (copy-sequence | |
593 | parent))))) | |
594 | n))))) | |
bf77c646 | 595 | (calc-pop-stack 1 n t)))) |
136211a9 EZ |
596 | |
597 | (defun calc-roll-down-with-selections (n m) | |
598 | (let ((vals (append (calc-top-list m 1) | |
599 | (calc-top-list (- n m) (1+ m)))) | |
600 | (sels (append (calc-top-list m 1 'sel) | |
601 | (calc-top-list (- n m) (1+ m) 'sel)))) | |
bf77c646 | 602 | (calc-pop-push-list n vals 1 sels))) |
136211a9 EZ |
603 | |
604 | (defun calc-roll-up-with-selections (n m) | |
605 | (let ((vals (append (calc-top-list (- n m) 1) | |
606 | (calc-top-list m (- n m -1)))) | |
607 | (sels (append (calc-top-list (- n m) 1 'sel) | |
608 | (calc-top-list m (- n m -1) 'sel)))) | |
bf77c646 | 609 | (calc-pop-push-list n vals 1 sels))) |
136211a9 | 610 | |
8416e352 JB |
611 | ;; The variable calc-sel-reselect is local to several functions |
612 | ;; which call calc-auto-selection. | |
613 | (defvar calc-sel-reselect) | |
614 | ||
136211a9 EZ |
615 | (defun calc-auto-selection (entry) |
616 | (or (nth 2 entry) | |
617 | (progn | |
8416e352 | 618 | (setq calc-sel-reselect nil) |
136211a9 | 619 | (calc-prepare-selection) |
bf77c646 | 620 | (calc-grow-assoc-formula (car entry) (calc-find-selected-part))))) |
136211a9 EZ |
621 | |
622 | (defun calc-copy-selection () | |
623 | (interactive) | |
624 | (calc-wrapper | |
625 | (calc-preserve-point) | |
626 | (let* ((num (max 1 (calc-locate-cursor-element (point)))) | |
627 | (entry (calc-top num 'entry))) | |
bf77c646 | 628 | (calc-push (or (calc-auto-selection entry) (car entry)))))) |
136211a9 EZ |
629 | |
630 | (defun calc-del-selection () | |
631 | (interactive) | |
632 | (calc-wrapper | |
633 | (calc-preserve-point) | |
634 | (let* ((num (max 1 (calc-locate-cursor-element (point)))) | |
635 | (entry (calc-top num 'entry)) | |
636 | (sel (calc-auto-selection entry))) | |
637 | (setcar (nthcdr 2 entry) (and (not (eq sel (car entry))) sel)) | |
bf77c646 | 638 | (calc-delete-selection num)))) |
136211a9 | 639 | |
64d96023 JB |
640 | (defvar calc-selection-history nil |
641 | "History for calc selections.") | |
642 | ||
136211a9 EZ |
643 | (defun calc-enter-selection () |
644 | (interactive) | |
645 | (calc-wrapper | |
646 | (calc-preserve-point) | |
647 | (let* ((num (max 1 (calc-locate-cursor-element (point)))) | |
8416e352 | 648 | (calc-sel-reselect calc-keep-selection) |
136211a9 EZ |
649 | (entry (calc-top num 'entry)) |
650 | (expr (car entry)) | |
651 | (sel (or (calc-auto-selection entry) expr)) | |
652 | alg) | |
653 | (let ((calc-dollar-values (list sel)) | |
654 | (calc-dollar-used 0)) | |
64d96023 JB |
655 | (setq alg (calc-do-alg-entry "" "Replace selection with: " nil |
656 | 'calc-selection-history)) | |
136211a9 EZ |
657 | (and alg |
658 | (progn | |
659 | (setq alg (calc-encase-atoms (car alg))) | |
660 | (calc-pop-push-record-list 1 "repl" | |
661 | (list (calc-replace-sub-formula | |
662 | expr sel alg)) | |
663 | num | |
8416e352 | 664 | (list (and calc-sel-reselect alg)))))) |
bf77c646 | 665 | (calc-handle-whys)))) |
136211a9 EZ |
666 | |
667 | (defun calc-edit-selection () | |
668 | (interactive) | |
669 | (calc-wrapper | |
670 | (calc-preserve-point) | |
671 | (let* ((num (max 1 (calc-locate-cursor-element (point)))) | |
8416e352 | 672 | (calc-sel-reselect calc-keep-selection) |
136211a9 EZ |
673 | (entry (calc-top num 'entry)) |
674 | (expr (car entry)) | |
675 | (sel (or (calc-auto-selection entry) expr)) | |
676 | alg) | |
677 | (let ((str (math-showing-full-precision | |
8f66f479 | 678 | (math-format-nice-expr sel (frame-width))))) |
136211a9 | 679 | (calc-edit-mode (list 'calc-finish-selection-edit |
8416e352 | 680 | num (list 'quote sel) calc-sel-reselect)) |
136211a9 | 681 | (insert str "\n")))) |
bf77c646 | 682 | (calc-show-edit-buffer)) |
136211a9 | 683 | |
8416e352 JB |
684 | (defvar calc-original-buffer) |
685 | ||
686 | ;; The variable calc-edit-disp-trail is local to calc-edit-finish, | |
687 | ;; in calc-yank.el. | |
688 | (defvar calc-edit-disp-trail) | |
519c0d00 | 689 | (defvar calc-edit-top) |
8416e352 | 690 | |
136211a9 EZ |
691 | (defun calc-finish-selection-edit (num sel reselect) |
692 | (let ((buf (current-buffer)) | |
519c0d00 | 693 | (str (buffer-substring calc-edit-top (point-max))) |
136211a9 EZ |
694 | (start (point))) |
695 | (switch-to-buffer calc-original-buffer) | |
696 | (let ((val (math-read-expr str))) | |
697 | (if (eq (car-safe val) 'error) | |
698 | (progn | |
699 | (switch-to-buffer buf) | |
700 | (goto-char (+ start (nth 1 val))) | |
701 | (error (nth 2 val)))) | |
702 | (calc-wrapper | |
703 | (calc-preserve-point) | |
8416e352 | 704 | (if calc-edit-disp-trail |
136211a9 EZ |
705 | (calc-trail-display 1 t)) |
706 | (setq val (calc-encase-atoms (calc-normalize val))) | |
707 | (let ((expr (calc-top num 'full))) | |
708 | (if (calc-find-sub-formula expr sel) | |
709 | (calc-pop-push-record-list 1 "edit" | |
710 | (list (calc-replace-sub-formula | |
711 | expr sel val)) | |
712 | num | |
713 | (list (and reselect val))) | |
714 | (calc-push val) | |
bf77c646 | 715 | (error "Original selection has been lost"))))))) |
136211a9 EZ |
716 | |
717 | (defun calc-sel-evaluate (arg) | |
718 | (interactive "p") | |
719 | (calc-slow-wrapper | |
720 | (calc-preserve-point) | |
721 | (let* ((num (max 1 (calc-locate-cursor-element (point)))) | |
8416e352 | 722 | (calc-sel-reselect calc-keep-selection) |
136211a9 EZ |
723 | (entry (calc-top num 'entry)) |
724 | (sel (or (calc-auto-selection entry) (car entry)))) | |
725 | (calc-with-default-simplification | |
726 | (let ((math-simplify-only nil)) | |
727 | (calc-modify-simplify-mode arg) | |
728 | (let ((val (calc-encase-atoms (calc-normalize sel)))) | |
729 | (calc-pop-push-record-list 1 "jsmp" | |
730 | (list (calc-replace-sub-formula | |
731 | (car entry) sel val)) | |
732 | num | |
8416e352 | 733 | (list (and calc-sel-reselect val)))))) |
bf77c646 | 734 | (calc-handle-whys)))) |
136211a9 EZ |
735 | |
736 | (defun calc-sel-expand-formula (arg) | |
737 | (interactive "p") | |
738 | (calc-slow-wrapper | |
739 | (calc-preserve-point) | |
740 | (let* ((num (max 1 (calc-locate-cursor-element (point)))) | |
8416e352 | 741 | (calc-sel-reselect calc-keep-selection) |
136211a9 EZ |
742 | (entry (calc-top num 'entry)) |
743 | (sel (or (calc-auto-selection entry) (car entry)))) | |
744 | (calc-with-default-simplification | |
745 | (let ((math-simplify-only nil)) | |
746 | (calc-modify-simplify-mode arg) | |
747 | (let* ((math-expand-formulas (> arg 0)) | |
748 | (val (calc-normalize sel)) | |
749 | top) | |
750 | (and (<= arg 0) | |
751 | (setq top (math-expand-formula val)) | |
752 | (setq val (calc-normalize top))) | |
753 | (setq val (calc-encase-atoms val)) | |
754 | (calc-pop-push-record-list 1 "jexf" | |
755 | (list (calc-replace-sub-formula | |
756 | (car entry) sel val)) | |
757 | num | |
8416e352 | 758 | (list (and calc-sel-reselect val)))))) |
bf77c646 | 759 | (calc-handle-whys)))) |
136211a9 | 760 | |
d22546d5 | 761 | (defun calc-sel-mult-both-sides (arg &optional divide) |
136211a9 EZ |
762 | (interactive "P") |
763 | (calc-wrapper | |
764 | (calc-preserve-point) | |
d22546d5 JB |
765 | (let* ((no-simp (consp arg)) |
766 | (num (max 1 (calc-locate-cursor-element (point)))) | |
8416e352 | 767 | (calc-sel-reselect calc-keep-selection) |
136211a9 EZ |
768 | (entry (calc-top num 'entry)) |
769 | (expr (car entry)) | |
770 | (sel (or (calc-auto-selection entry) expr)) | |
771 | (func (car-safe sel)) | |
772 | alg lhs rhs) | |
773 | (setq alg (calc-with-default-simplification | |
774 | (car (calc-do-alg-entry "" | |
775 | (if divide | |
776 | "Divide both sides by: " | |
64d96023 JB |
777 | "Multiply both sides by: ") |
778 | nil 'calc-selection-history)))) | |
136211a9 EZ |
779 | (and alg |
780 | (progn | |
781 | (if (and (or (eq func '/) | |
782 | (assq func calc-tweak-eqn-table)) | |
783 | (= (length sel) 3)) | |
784 | (progn | |
785 | (or (memq func '(/ calcFunc-eq calcFunc-neq)) | |
786 | (if (math-known-nonposp alg) | |
787 | (progn | |
788 | (setq func (nth 1 (assq func | |
789 | calc-tweak-eqn-table))) | |
790 | (or (math-known-negp alg) | |
791 | (message "Assuming this factor is nonzero"))) | |
792 | (or (math-known-posp alg) | |
793 | (if (math-known-nonnegp alg) | |
794 | (message "Assuming this factor is nonzero") | |
795 | (message "Assuming this factor is positive"))))) | |
796 | (setq lhs (list (if divide '/ '*) (nth 1 sel) alg) | |
797 | rhs (list (if divide '/ '*) (nth 2 sel) alg)) | |
798 | (or no-simp | |
799 | (progn | |
800 | (setq lhs (math-simplify lhs) | |
801 | rhs (math-simplify rhs)) | |
802 | (and (eq func '/) | |
803 | (or (Math-equal (nth 1 sel) 1) | |
d22546d5 JB |
804 | (Math-equal (nth 1 sel) -1)) |
805 | ; (and (memq (car-safe (nth 2 sel)) '(+ -)) | |
806 | ; (memq (car-safe alg) '(+ -)))) | |
807 | (unless arg | |
808 | (setq rhs (math-expand-term rhs)))))) | |
809 | (if (and arg (not no-simp)) | |
170bc4f7 JB |
810 | (setq rhs (math-simplify |
811 | (calcFunc-expand rhs (unless (= arg 0) arg))))) | |
136211a9 EZ |
812 | (setq alg (calc-encase-atoms |
813 | (calc-normalize (list func lhs rhs))))) | |
814 | (setq rhs (list (if divide '* '/) sel alg)) | |
815 | (or no-simp | |
816 | (setq rhs (math-simplify rhs))) | |
817 | (setq alg (calc-encase-atoms | |
818 | (calc-normalize (if divide | |
819 | (list '/ rhs alg) | |
820 | (list '* alg rhs)))))) | |
821 | (calc-pop-push-record-list 1 (if divide "div" "mult") | |
822 | (list (calc-replace-sub-formula | |
823 | expr sel alg)) | |
824 | num | |
8416e352 | 825 | (list (and calc-sel-reselect alg))))) |
bf77c646 | 826 | (calc-handle-whys)))) |
136211a9 EZ |
827 | |
828 | (defun calc-sel-div-both-sides (no-simp) | |
829 | (interactive "P") | |
bf77c646 | 830 | (calc-sel-mult-both-sides no-simp t)) |
136211a9 EZ |
831 | |
832 | (defun calc-sel-add-both-sides (no-simp &optional subtract) | |
833 | (interactive "P") | |
834 | (calc-wrapper | |
835 | (calc-preserve-point) | |
836 | (let* ((num (max 1 (calc-locate-cursor-element (point)))) | |
8416e352 | 837 | (calc-sel-reselect calc-keep-selection) |
136211a9 EZ |
838 | (entry (calc-top num 'entry)) |
839 | (expr (car entry)) | |
840 | (sel (or (calc-auto-selection entry) expr)) | |
841 | (func (car-safe sel)) | |
842 | alg lhs rhs) | |
843 | (setq alg (calc-with-default-simplification | |
844 | (car (calc-do-alg-entry "" | |
845 | (if subtract | |
846 | "Subtract from both sides: " | |
64d96023 JB |
847 | "Add to both sides: ") |
848 | nil 'calc-selection-history)))) | |
136211a9 EZ |
849 | (and alg |
850 | (progn | |
851 | (if (and (assq func calc-tweak-eqn-table) | |
852 | (= (length sel) 3)) | |
853 | (progn | |
854 | (setq lhs (list (if subtract '- '+) (nth 1 sel) alg) | |
855 | rhs (list (if subtract '- '+) (nth 2 sel) alg)) | |
856 | (or no-simp | |
857 | (setq lhs (math-simplify lhs) | |
858 | rhs (math-simplify rhs))) | |
859 | (setq alg (calc-encase-atoms | |
860 | (calc-normalize (list func lhs rhs))))) | |
861 | (setq rhs (list (if subtract '+ '-) sel alg)) | |
862 | (or no-simp | |
863 | (setq rhs (math-simplify rhs))) | |
864 | (setq alg (calc-encase-atoms | |
865 | (calc-normalize (list (if subtract '- '+) alg rhs))))) | |
866 | (calc-pop-push-record-list 1 (if subtract "sub" "add") | |
867 | (list (calc-replace-sub-formula | |
868 | expr sel alg)) | |
869 | num | |
8416e352 | 870 | (list (and calc-sel-reselect alg))))) |
bf77c646 | 871 | (calc-handle-whys)))) |
136211a9 EZ |
872 | |
873 | (defun calc-sel-sub-both-sides (no-simp) | |
874 | (interactive "P") | |
bf77c646 | 875 | (calc-sel-add-both-sides no-simp t)) |
136211a9 | 876 | |
da0ae499 JB |
877 | (provide 'calc-sel) |
878 | ||
cbee283d | 879 | ;; arch-tag: e5169792-777d-428f-bff5-acca66813fa2 |
bf77c646 | 880 | ;;; calc-sel.el ends here |