Mercurial > emacs
comparison lisp/calc/calc-sel.el @ 58336:2d07929a4d0b
(calc-selection-cache-entry): Moved declaration to earlier in the
file.
(calc-selection-cache-num, calc-selection-cache-comp)
(calc-selection-cache-offset, calc-selection-true-num)
(calc-final-point-line, calc-final-point-column)
(calc-original-buffer): Declare them.
(calc-fnp-op, calc-fnp-num): New variables.
(calc-find-nth-part, calc-find-nth-part-rec)
(calc-select-previous): Replace op and num by declared variables.
(calc-rsf-old, calc-rsf-new): New variables.
(calc-replace-sub-formula, calc-replace-sub-formula-rec):
Replace variables old and new by declared variables.
(calc-sel-reselect): New variable.
(calc-auto-selection, calc-enter-selection, calc-edit-selection)
(calc-sel-evaluate, calc-sel-expand-formula, calc-sel-expand-formula)
(calc-sel-mult-both-sides, calc-sel-add-both-sides): Replace variable
reselect with declared variable.
(calc-edit-disp-trail): Declare it.
(calc-finish-selection-edit): Replace variable disp-trail by declared
variable.
author | Jay Belanger <jay.p.belanger@gmail.com> |
---|---|
date | Fri, 19 Nov 2004 22:21:18 +0000 |
parents | 695cf19ef79e |
children | bf2edad57436 |
comparison
equal
deleted
inserted
replaced
58335:4e7e96bc6b95 | 58336:2d07929a4d0b |
---|---|
36 | 36 |
37 | 37 |
38 ;;; Selection commands. | 38 ;;; Selection commands. |
39 | 39 |
40 (defvar calc-keep-selection t) | 40 (defvar calc-keep-selection t) |
41 | |
42 (defvar calc-selection-cache-entry nil) | |
43 (defvar calc-selection-cache-num) | |
44 (defvar calc-selection-cache-comp) | |
45 (defvar calc-selection-cache-offset) | |
46 (defvar calc-selection-true-num) | |
41 | 47 |
42 (defun calc-select-here (num &optional once keep) | 48 (defun calc-select-here (num &optional once keep) |
43 (interactive "P") | 49 (interactive "P") |
44 (calc-wrapper | 50 (calc-wrapper |
45 (calc-prepare-selection) | 51 (calc-prepare-selection) |
139 num))) | 145 num))) |
140 (if sel | 146 (if sel |
141 (calc-change-current-selection sel) | 147 (calc-change-current-selection sel) |
142 (error "%d is not a valid sub-formula index" num))))) | 148 (error "%d is not a valid sub-formula index" num))))) |
143 | 149 |
144 (defun calc-find-nth-part (expr num) | 150 ;; The variables calc-fnp-op and calc-fnp-num are local to |
151 ;; calc-find-nth-part (and calc-select-previous) but used by | |
152 ;; calc-find-nth-part-rec, which is called by them. | |
153 (defvar calc-fnp-op) | |
154 (defvar calc-fnp-num) | |
155 | |
156 (defun calc-find-nth-part (expr calc-fnp-num) | |
145 (if (and calc-assoc-selections | 157 (if (and calc-assoc-selections |
146 (assq (car-safe expr) calc-assoc-ops)) | 158 (assq (car-safe expr) calc-assoc-ops)) |
147 (let (op) | 159 (let (calc-fnp-op) |
148 (calc-find-nth-part-rec expr)) | 160 (calc-find-nth-part-rec expr)) |
149 (if (eq (car-safe expr) 'intv) | 161 (if (eq (car-safe expr) 'intv) |
150 (and (>= num 1) (<= num 2) (nth (1+ num) expr)) | 162 (and (>= calc-fnp-num 1) (<= calc-fnp-num 2) (nth (1+ calc-fnp-num) expr)) |
151 (and (not (Math-primp expr)) (>= num 1) (< num (length expr)) | 163 (and (not (Math-primp expr)) (>= calc-fnp-num 1) (< calc-fnp-num (length expr)) |
152 (nth num expr))))) | 164 (nth calc-fnp-num expr))))) |
153 | 165 |
154 (defun calc-find-nth-part-rec (expr) ; uses num, op | 166 (defun calc-find-nth-part-rec (expr) ; uses num, op |
155 (or (if (and (setq op (assq (car-safe (nth 1 expr)) calc-assoc-ops)) | 167 (or (if (and (setq calc-fnp-op (assq (car-safe (nth 1 expr)) calc-assoc-ops)) |
156 (memq (car expr) (nth 1 op))) | 168 (memq (car expr) (nth 1 calc-fnp-op))) |
157 (calc-find-nth-part-rec (nth 1 expr)) | 169 (calc-find-nth-part-rec (nth 1 expr)) |
158 (and (= (setq num (1- num)) 0) | 170 (and (= (setq calc-fnp-num (1- calc-fnp-num)) 0) |
159 (nth 1 expr))) | 171 (nth 1 expr))) |
160 (if (and (setq op (assq (car-safe (nth 2 expr)) calc-assoc-ops)) | 172 (if (and (setq calc-fnp-op (assq (car-safe (nth 2 expr)) calc-assoc-ops)) |
161 (memq (car expr) (nth 2 op))) | 173 (memq (car expr) (nth 2 calc-fnp-op))) |
162 (calc-find-nth-part-rec (nth 2 expr)) | 174 (calc-find-nth-part-rec (nth 2 expr)) |
163 (and (= (setq num (1- num)) 0) | 175 (and (= (setq calc-fnp-num (1- calc-fnp-num)) 0) |
164 (nth 2 expr))))) | 176 (nth 2 expr))))) |
165 | 177 |
166 (defun calc-select-next (num) | 178 (defun calc-select-next (num) |
167 (interactive "p") | 179 (interactive "p") |
168 (if (< num 0) | 180 (if (< num 0) |
237 (calc-change-current-selection sel)) | 249 (calc-change-current-selection sel)) |
238 (if (Math-primp (car entry)) | 250 (if (Math-primp (car entry)) |
239 (calc-change-current-selection (car entry)) | 251 (calc-change-current-selection (car entry)) |
240 (let ((len (if (and calc-assoc-selections | 252 (let ((len (if (and calc-assoc-selections |
241 (assq (car (car entry)) calc-assoc-ops)) | 253 (assq (car (car entry)) calc-assoc-ops)) |
242 (let (op (num 0)) | 254 (let (calc-fnp-op (calc-fnp-num 0)) |
243 (calc-find-nth-part-rec (car entry)) | 255 (calc-find-nth-part-rec (car entry)) |
244 (- 1 num)) | 256 (- 1 calc-fnp-num)) |
245 (length (car entry))))) | 257 (length (car entry))))) |
246 (calc-select-part (- len num))))))))) | 258 (calc-select-part (- len num))))))))) |
247 | 259 |
248 (defun calc-find-parent-formula (expr part) | 260 (defun calc-find-parent-formula (expr part) |
249 (cond ((eq expr part) t) | 261 (cond ((eq expr part) t) |
324 (calc-change-current-selection sel))))) | 336 (calc-change-current-selection sel))))) |
325 (message (if calc-show-selections | 337 (message (if calc-show-selections |
326 "Displaying only selected part of formulas" | 338 "Displaying only selected part of formulas" |
327 "Displaying all but selected part of formulas")))) | 339 "Displaying all but selected part of formulas")))) |
328 | 340 |
341 ;; The variables calc-final-point-line and calc-final-point-column | |
342 ;; are declared in calc.el, and are used throughout. | |
343 (defvar calc-final-point-line) | |
344 (defvar calc-final-point-column) | |
345 | |
329 (defun calc-preserve-point () | 346 (defun calc-preserve-point () |
330 (or (looking-at "\\.\n+\\'") | 347 (or (looking-at "\\.\n+\\'") |
331 (progn | 348 (progn |
332 (setq calc-final-point-line (+ (count-lines (point-min) (point)) | 349 (setq calc-final-point-line (+ (count-lines (point-min) (point)) |
333 (if (bolp) 1 0)) | 350 (if (bolp) 1 0)) |
355 (not calc-assoc-selections))) | 372 (not calc-assoc-selections))) |
356 (message (if calc-assoc-selections | 373 (message (if calc-assoc-selections |
357 "Selection treats a+b+c as a sum of three terms" | 374 "Selection treats a+b+c as a sum of three terms" |
358 "Selection treats a+b+c as (a+b)+c")))) | 375 "Selection treats a+b+c as (a+b)+c")))) |
359 | 376 |
360 (defvar calc-selection-cache-entry nil) | |
361 (defun calc-prepare-selection (&optional num) | 377 (defun calc-prepare-selection (&optional num) |
362 (or num (setq num (calc-locate-cursor-element (point)))) | 378 (or num (setq num (calc-locate-cursor-element (point)))) |
363 (setq calc-selection-true-num num | 379 (setq calc-selection-true-num num |
364 calc-keep-selection t) | 380 calc-keep-selection t) |
365 (or (> num 0) (setq num 1)) | 381 (or (> num 0) (setq num 1)) |
454 (if (nth 2 (car top)) | 470 (if (nth 2 (car top)) |
455 (setq sel (if sel t (nth 2 (car top))))) | 471 (setq sel (if sel t (nth 2 (car top))))) |
456 (setq top (cdr top))) | 472 (setq top (cdr top))) |
457 sel)))) | 473 sel)))) |
458 | 474 |
459 (defun calc-replace-sub-formula (expr old new) | 475 ;; The variables calc-rsf-old and calc-rsf-new are local to |
460 (setq new (calc-encase-atoms new)) | 476 ;; calc-replace-sub-formula, but used by calc-replace-sub-formula-rec, |
477 ;; which is called by calc-replace-sub-formula. | |
478 (defvar calc-rsf-old) | |
479 (defvar calc-rsf-new) | |
480 | |
481 (defun calc-replace-sub-formula (expr calc-rsf-old calc-rsf-new) | |
482 (setq calc-rsf-new (calc-encase-atoms calc-rsf-new)) | |
461 (calc-replace-sub-formula-rec expr)) | 483 (calc-replace-sub-formula-rec expr)) |
462 | 484 |
463 (defun calc-replace-sub-formula-rec (expr) | 485 (defun calc-replace-sub-formula-rec (expr) |
464 (cond ((eq expr old) new) | 486 (cond ((eq expr calc-rsf-old) calc-rsf-new) |
465 ((Math-primp expr) expr) | 487 ((Math-primp expr) expr) |
466 (t | 488 (t |
467 (cons (car expr) | 489 (cons (car expr) |
468 (mapcar 'calc-replace-sub-formula-rec (cdr expr)))))) | 490 (mapcar 'calc-replace-sub-formula-rec (cdr expr)))))) |
469 | 491 |
579 (calc-top-list m (- n m -1)))) | 601 (calc-top-list m (- n m -1)))) |
580 (sels (append (calc-top-list (- n m) 1 'sel) | 602 (sels (append (calc-top-list (- n m) 1 'sel) |
581 (calc-top-list m (- n m -1) 'sel)))) | 603 (calc-top-list m (- n m -1) 'sel)))) |
582 (calc-pop-push-list n vals 1 sels))) | 604 (calc-pop-push-list n vals 1 sels))) |
583 | 605 |
606 ;; The variable calc-sel-reselect is local to several functions | |
607 ;; which call calc-auto-selection. | |
608 (defvar calc-sel-reselect) | |
609 | |
584 (defun calc-auto-selection (entry) | 610 (defun calc-auto-selection (entry) |
585 (or (nth 2 entry) | 611 (or (nth 2 entry) |
586 (progn | 612 (progn |
587 (and (boundp 'reselect) (setq reselect nil)) | 613 (setq calc-sel-reselect nil) |
588 (calc-prepare-selection) | 614 (calc-prepare-selection) |
589 (calc-grow-assoc-formula (car entry) (calc-find-selected-part))))) | 615 (calc-grow-assoc-formula (car entry) (calc-find-selected-part))))) |
590 | 616 |
591 (defun calc-copy-selection () | 617 (defun calc-copy-selection () |
592 (interactive) | 618 (interactive) |
609 (defun calc-enter-selection () | 635 (defun calc-enter-selection () |
610 (interactive) | 636 (interactive) |
611 (calc-wrapper | 637 (calc-wrapper |
612 (calc-preserve-point) | 638 (calc-preserve-point) |
613 (let* ((num (max 1 (calc-locate-cursor-element (point)))) | 639 (let* ((num (max 1 (calc-locate-cursor-element (point)))) |
614 (reselect calc-keep-selection) | 640 (calc-sel-reselect calc-keep-selection) |
615 (entry (calc-top num 'entry)) | 641 (entry (calc-top num 'entry)) |
616 (expr (car entry)) | 642 (expr (car entry)) |
617 (sel (or (calc-auto-selection entry) expr)) | 643 (sel (or (calc-auto-selection entry) expr)) |
618 alg) | 644 alg) |
619 (let ((calc-dollar-values (list sel)) | 645 (let ((calc-dollar-values (list sel)) |
624 (setq alg (calc-encase-atoms (car alg))) | 650 (setq alg (calc-encase-atoms (car alg))) |
625 (calc-pop-push-record-list 1 "repl" | 651 (calc-pop-push-record-list 1 "repl" |
626 (list (calc-replace-sub-formula | 652 (list (calc-replace-sub-formula |
627 expr sel alg)) | 653 expr sel alg)) |
628 num | 654 num |
629 (list (and reselect alg)))))) | 655 (list (and calc-sel-reselect alg)))))) |
630 (calc-handle-whys)))) | 656 (calc-handle-whys)))) |
631 | 657 |
632 (defun calc-edit-selection () | 658 (defun calc-edit-selection () |
633 (interactive) | 659 (interactive) |
634 (calc-wrapper | 660 (calc-wrapper |
635 (calc-preserve-point) | 661 (calc-preserve-point) |
636 (let* ((num (max 1 (calc-locate-cursor-element (point)))) | 662 (let* ((num (max 1 (calc-locate-cursor-element (point)))) |
637 (reselect calc-keep-selection) | 663 (calc-sel-reselect calc-keep-selection) |
638 (entry (calc-top num 'entry)) | 664 (entry (calc-top num 'entry)) |
639 (expr (car entry)) | 665 (expr (car entry)) |
640 (sel (or (calc-auto-selection entry) expr)) | 666 (sel (or (calc-auto-selection entry) expr)) |
641 alg) | 667 alg) |
642 (let ((str (math-showing-full-precision | 668 (let ((str (math-showing-full-precision |
643 (math-format-nice-expr sel (frame-width))))) | 669 (math-format-nice-expr sel (frame-width))))) |
644 (calc-edit-mode (list 'calc-finish-selection-edit | 670 (calc-edit-mode (list 'calc-finish-selection-edit |
645 num (list 'quote sel) reselect)) | 671 num (list 'quote sel) calc-sel-reselect)) |
646 (insert str "\n")))) | 672 (insert str "\n")))) |
647 (calc-show-edit-buffer)) | 673 (calc-show-edit-buffer)) |
674 | |
675 (defvar calc-original-buffer) | |
676 | |
677 ;; The variable calc-edit-disp-trail is local to calc-edit-finish, | |
678 ;; in calc-yank.el. | |
679 (defvar calc-edit-disp-trail) | |
648 | 680 |
649 (defun calc-finish-selection-edit (num sel reselect) | 681 (defun calc-finish-selection-edit (num sel reselect) |
650 (let ((buf (current-buffer)) | 682 (let ((buf (current-buffer)) |
651 (str (buffer-substring (point) (point-max))) | 683 (str (buffer-substring (point) (point-max))) |
652 (start (point))) | 684 (start (point))) |
657 (switch-to-buffer buf) | 689 (switch-to-buffer buf) |
658 (goto-char (+ start (nth 1 val))) | 690 (goto-char (+ start (nth 1 val))) |
659 (error (nth 2 val)))) | 691 (error (nth 2 val)))) |
660 (calc-wrapper | 692 (calc-wrapper |
661 (calc-preserve-point) | 693 (calc-preserve-point) |
662 (if disp-trail | 694 (if calc-edit-disp-trail |
663 (calc-trail-display 1 t)) | 695 (calc-trail-display 1 t)) |
664 (setq val (calc-encase-atoms (calc-normalize val))) | 696 (setq val (calc-encase-atoms (calc-normalize val))) |
665 (let ((expr (calc-top num 'full))) | 697 (let ((expr (calc-top num 'full))) |
666 (if (calc-find-sub-formula expr sel) | 698 (if (calc-find-sub-formula expr sel) |
667 (calc-pop-push-record-list 1 "edit" | 699 (calc-pop-push-record-list 1 "edit" |
675 (defun calc-sel-evaluate (arg) | 707 (defun calc-sel-evaluate (arg) |
676 (interactive "p") | 708 (interactive "p") |
677 (calc-slow-wrapper | 709 (calc-slow-wrapper |
678 (calc-preserve-point) | 710 (calc-preserve-point) |
679 (let* ((num (max 1 (calc-locate-cursor-element (point)))) | 711 (let* ((num (max 1 (calc-locate-cursor-element (point)))) |
680 (reselect calc-keep-selection) | 712 (calc-sel-reselect calc-keep-selection) |
681 (entry (calc-top num 'entry)) | 713 (entry (calc-top num 'entry)) |
682 (sel (or (calc-auto-selection entry) (car entry)))) | 714 (sel (or (calc-auto-selection entry) (car entry)))) |
683 (calc-with-default-simplification | 715 (calc-with-default-simplification |
684 (let ((math-simplify-only nil)) | 716 (let ((math-simplify-only nil)) |
685 (calc-modify-simplify-mode arg) | 717 (calc-modify-simplify-mode arg) |
686 (let ((val (calc-encase-atoms (calc-normalize sel)))) | 718 (let ((val (calc-encase-atoms (calc-normalize sel)))) |
687 (calc-pop-push-record-list 1 "jsmp" | 719 (calc-pop-push-record-list 1 "jsmp" |
688 (list (calc-replace-sub-formula | 720 (list (calc-replace-sub-formula |
689 (car entry) sel val)) | 721 (car entry) sel val)) |
690 num | 722 num |
691 (list (and reselect val)))))) | 723 (list (and calc-sel-reselect val)))))) |
692 (calc-handle-whys)))) | 724 (calc-handle-whys)))) |
693 | 725 |
694 (defun calc-sel-expand-formula (arg) | 726 (defun calc-sel-expand-formula (arg) |
695 (interactive "p") | 727 (interactive "p") |
696 (calc-slow-wrapper | 728 (calc-slow-wrapper |
697 (calc-preserve-point) | 729 (calc-preserve-point) |
698 (let* ((num (max 1 (calc-locate-cursor-element (point)))) | 730 (let* ((num (max 1 (calc-locate-cursor-element (point)))) |
699 (reselect calc-keep-selection) | 731 (calc-sel-reselect calc-keep-selection) |
700 (entry (calc-top num 'entry)) | 732 (entry (calc-top num 'entry)) |
701 (sel (or (calc-auto-selection entry) (car entry)))) | 733 (sel (or (calc-auto-selection entry) (car entry)))) |
702 (calc-with-default-simplification | 734 (calc-with-default-simplification |
703 (let ((math-simplify-only nil)) | 735 (let ((math-simplify-only nil)) |
704 (calc-modify-simplify-mode arg) | 736 (calc-modify-simplify-mode arg) |
711 (setq val (calc-encase-atoms val)) | 743 (setq val (calc-encase-atoms val)) |
712 (calc-pop-push-record-list 1 "jexf" | 744 (calc-pop-push-record-list 1 "jexf" |
713 (list (calc-replace-sub-formula | 745 (list (calc-replace-sub-formula |
714 (car entry) sel val)) | 746 (car entry) sel val)) |
715 num | 747 num |
716 (list (and reselect val)))))) | 748 (list (and calc-sel-reselect val)))))) |
717 (calc-handle-whys)))) | 749 (calc-handle-whys)))) |
718 | 750 |
719 (defun calc-sel-mult-both-sides (no-simp &optional divide) | 751 (defun calc-sel-mult-both-sides (no-simp &optional divide) |
720 (interactive "P") | 752 (interactive "P") |
721 (calc-wrapper | 753 (calc-wrapper |
722 (calc-preserve-point) | 754 (calc-preserve-point) |
723 (let* ((num (max 1 (calc-locate-cursor-element (point)))) | 755 (let* ((num (max 1 (calc-locate-cursor-element (point)))) |
724 (reselect calc-keep-selection) | 756 (calc-sel-reselect calc-keep-selection) |
725 (entry (calc-top num 'entry)) | 757 (entry (calc-top num 'entry)) |
726 (expr (car entry)) | 758 (expr (car entry)) |
727 (sel (or (calc-auto-selection entry) expr)) | 759 (sel (or (calc-auto-selection entry) expr)) |
728 (func (car-safe sel)) | 760 (func (car-safe sel)) |
729 alg lhs rhs) | 761 alg lhs rhs) |
772 (list '* alg rhs)))))) | 804 (list '* alg rhs)))))) |
773 (calc-pop-push-record-list 1 (if divide "div" "mult") | 805 (calc-pop-push-record-list 1 (if divide "div" "mult") |
774 (list (calc-replace-sub-formula | 806 (list (calc-replace-sub-formula |
775 expr sel alg)) | 807 expr sel alg)) |
776 num | 808 num |
777 (list (and reselect alg))))) | 809 (list (and calc-sel-reselect alg))))) |
778 (calc-handle-whys)))) | 810 (calc-handle-whys)))) |
779 | 811 |
780 (defun calc-sel-div-both-sides (no-simp) | 812 (defun calc-sel-div-both-sides (no-simp) |
781 (interactive "P") | 813 (interactive "P") |
782 (calc-sel-mult-both-sides no-simp t)) | 814 (calc-sel-mult-both-sides no-simp t)) |
784 (defun calc-sel-add-both-sides (no-simp &optional subtract) | 816 (defun calc-sel-add-both-sides (no-simp &optional subtract) |
785 (interactive "P") | 817 (interactive "P") |
786 (calc-wrapper | 818 (calc-wrapper |
787 (calc-preserve-point) | 819 (calc-preserve-point) |
788 (let* ((num (max 1 (calc-locate-cursor-element (point)))) | 820 (let* ((num (max 1 (calc-locate-cursor-element (point)))) |
789 (reselect calc-keep-selection) | 821 (calc-sel-reselect calc-keep-selection) |
790 (entry (calc-top num 'entry)) | 822 (entry (calc-top num 'entry)) |
791 (expr (car entry)) | 823 (expr (car entry)) |
792 (sel (or (calc-auto-selection entry) expr)) | 824 (sel (or (calc-auto-selection entry) expr)) |
793 (func (car-safe sel)) | 825 (func (car-safe sel)) |
794 alg lhs rhs) | 826 alg lhs rhs) |
816 (calc-normalize (list (if subtract '- '+) alg rhs))))) | 848 (calc-normalize (list (if subtract '- '+) alg rhs))))) |
817 (calc-pop-push-record-list 1 (if subtract "sub" "add") | 849 (calc-pop-push-record-list 1 (if subtract "sub" "add") |
818 (list (calc-replace-sub-formula | 850 (list (calc-replace-sub-formula |
819 expr sel alg)) | 851 expr sel alg)) |
820 num | 852 num |
821 (list (and reselect alg))))) | 853 (list (and calc-sel-reselect alg))))) |
822 (calc-handle-whys)))) | 854 (calc-handle-whys)))) |
823 | 855 |
824 (defun calc-sel-sub-both-sides (no-simp) | 856 (defun calc-sel-sub-both-sides (no-simp) |
825 (interactive "P") | 857 (interactive "P") |
826 (calc-sel-add-both-sides no-simp t)) | 858 (calc-sel-add-both-sides no-simp t)) |