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