/[emacs]/emacs/lisp/calc/calc-sel.el
ViewVC logotype

Diff of /emacs/lisp/calc/calc-sel.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.7 by miles, Mon Sep 1 15:45:18 2003 UTC revision 1.8 by jpb, Fri Nov 19 22:21:18 2004 UTC
# Line 39  Line 39 
39    
40  (defvar calc-keep-selection t)  (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)
47    
48  (defun calc-select-here (num &optional once keep)  (defun calc-select-here (num &optional once keep)
49    (interactive "P")    (interactive "P")
50    (calc-wrapper    (calc-wrapper
# Line 141  Line 147 
147           (calc-change-current-selection sel)           (calc-change-current-selection sel)
148         (error "%d is not a valid sub-formula index" num)))))         (error "%d is not a valid sub-formula index" num)))))
149    
150  (defun calc-find-nth-part (expr num)  ;; 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)
157    (if (and calc-assoc-selections    (if (and calc-assoc-selections
158             (assq (car-safe expr) calc-assoc-ops))             (assq (car-safe expr) calc-assoc-ops))
159        (let (op)        (let (calc-fnp-op)
160          (calc-find-nth-part-rec expr))          (calc-find-nth-part-rec expr))
161      (if (eq (car-safe expr) 'intv)      (if (eq (car-safe expr) 'intv)
162          (and (>= num 1) (<= num 2) (nth (1+ num) expr))          (and (>= calc-fnp-num 1) (<= calc-fnp-num 2) (nth (1+ calc-fnp-num) expr))
163        (and (not (Math-primp expr)) (>= num 1) (< num (length expr))        (and (not (Math-primp expr)) (>= calc-fnp-num 1) (< calc-fnp-num (length expr))
164             (nth num expr)))))             (nth calc-fnp-num expr)))))
165    
166  (defun calc-find-nth-part-rec (expr)   ; uses num, op  (defun calc-find-nth-part-rec (expr)   ; uses num, op
167    (or (if (and (setq op (assq (car-safe (nth 1 expr)) calc-assoc-ops))    (or (if (and (setq calc-fnp-op (assq (car-safe (nth 1 expr)) calc-assoc-ops))
168                 (memq (car expr) (nth 1 op)))                 (memq (car expr) (nth 1 calc-fnp-op)))
169            (calc-find-nth-part-rec (nth 1 expr))            (calc-find-nth-part-rec (nth 1 expr))
170          (and (= (setq num (1- num)) 0)          (and (= (setq calc-fnp-num (1- calc-fnp-num)) 0)
171               (nth 1 expr)))               (nth 1 expr)))
172        (if (and (setq op (assq (car-safe (nth 2 expr)) calc-assoc-ops))        (if (and (setq calc-fnp-op (assq (car-safe (nth 2 expr)) calc-assoc-ops))
173                 (memq (car expr) (nth 2 op)))                 (memq (car expr) (nth 2 calc-fnp-op)))
174            (calc-find-nth-part-rec (nth 2 expr))            (calc-find-nth-part-rec (nth 2 expr))
175          (and (= (setq num (1- num)) 0)          (and (= (setq calc-fnp-num (1- calc-fnp-num)) 0)
176               (nth 2 expr)))))               (nth 2 expr)))))
177    
178  (defun calc-select-next (num)  (defun calc-select-next (num)
# Line 239  Line 251 
251               (calc-change-current-selection (car entry))               (calc-change-current-selection (car entry))
252             (let ((len (if (and calc-assoc-selections             (let ((len (if (and calc-assoc-selections
253                                 (assq (car (car entry)) calc-assoc-ops))                                 (assq (car (car entry)) calc-assoc-ops))
254                            (let (op (num 0))                            (let (calc-fnp-op (calc-fnp-num 0))
255                              (calc-find-nth-part-rec (car entry))                              (calc-find-nth-part-rec (car entry))
256                              (- 1 num))                              (- 1 calc-fnp-num))
257                          (length (car entry)))))                          (length (car entry)))))
258               (calc-select-part (- len num)))))))))               (calc-select-part (- len num)))))))))
259    
# Line 326  Line 338 
338                  "Displaying only selected part of formulas"                  "Displaying only selected part of formulas"
339                "Displaying all but selected part of formulas"))))                "Displaying all but selected part of formulas"))))
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    
346  (defun calc-preserve-point ()  (defun calc-preserve-point ()
347    (or (looking-at "\\.\n+\\'")    (or (looking-at "\\.\n+\\'")
348        (progn        (progn
# Line 357  Line 374 
374                  "Selection treats a+b+c as a sum of three terms"                  "Selection treats a+b+c as a sum of three terms"
375                "Selection treats a+b+c as (a+b)+c"))))                "Selection treats a+b+c as (a+b)+c"))))
376    
 (defvar calc-selection-cache-entry nil)  
377  (defun calc-prepare-selection (&optional num)  (defun calc-prepare-selection (&optional num)
378    (or num (setq num (calc-locate-cursor-element (point))))    (or num (setq num (calc-locate-cursor-element (point))))
379    (setq calc-selection-true-num num    (setq calc-selection-true-num num
# Line 456  Line 472 
472               (setq top (cdr top)))               (setq top (cdr top)))
473             sel))))             sel))))
474    
475  (defun calc-replace-sub-formula (expr old new)  ;; The variables calc-rsf-old and calc-rsf-new are local to
476    (setq new (calc-encase-atoms new))  ;; 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))
483    (calc-replace-sub-formula-rec expr))    (calc-replace-sub-formula-rec expr))
484    
485  (defun calc-replace-sub-formula-rec (expr)  (defun calc-replace-sub-formula-rec (expr)
486    (cond ((eq expr old) new)    (cond ((eq expr calc-rsf-old) calc-rsf-new)
487          ((Math-primp expr) expr)          ((Math-primp expr) expr)
488          (t          (t
489           (cons (car expr)           (cons (car expr)
# Line 581  Line 603 
603                        (calc-top-list m (- n m -1) 'sel))))                        (calc-top-list m (- n m -1) 'sel))))
604      (calc-pop-push-list n vals 1 sels)))      (calc-pop-push-list n vals 1 sels)))
605    
606    ;; The variable calc-sel-reselect is local to several functions
607    ;; which call calc-auto-selection.
608    (defvar calc-sel-reselect)
609    
610  (defun calc-auto-selection (entry)  (defun calc-auto-selection (entry)
611    (or (nth 2 entry)    (or (nth 2 entry)
612        (progn        (progn
613          (and (boundp 'reselect) (setq reselect nil))          (setq calc-sel-reselect nil)
614          (calc-prepare-selection)          (calc-prepare-selection)
615          (calc-grow-assoc-formula (car entry) (calc-find-selected-part)))))          (calc-grow-assoc-formula (car entry) (calc-find-selected-part)))))
616    
# Line 611  Line 637 
637    (calc-wrapper    (calc-wrapper
638     (calc-preserve-point)     (calc-preserve-point)
639     (let* ((num (max 1 (calc-locate-cursor-element (point))))     (let* ((num (max 1 (calc-locate-cursor-element (point))))
640            (reselect calc-keep-selection)            (calc-sel-reselect calc-keep-selection)
641            (entry (calc-top num 'entry))            (entry (calc-top num 'entry))
642            (expr (car entry))            (expr (car entry))
643            (sel (or (calc-auto-selection entry) expr))            (sel (or (calc-auto-selection entry) expr))
# Line 626  Line 652 
652                                           (list (calc-replace-sub-formula                                           (list (calc-replace-sub-formula
653                                                  expr sel alg))                                                  expr sel alg))
654                                           num                                           num
655                                           (list (and reselect alg))))))                                           (list (and calc-sel-reselect alg))))))
656       (calc-handle-whys))))       (calc-handle-whys))))
657    
658  (defun calc-edit-selection ()  (defun calc-edit-selection ()
# Line 634  Line 660 
660    (calc-wrapper    (calc-wrapper
661     (calc-preserve-point)     (calc-preserve-point)
662     (let* ((num (max 1 (calc-locate-cursor-element (point))))     (let* ((num (max 1 (calc-locate-cursor-element (point))))
663            (reselect calc-keep-selection)            (calc-sel-reselect calc-keep-selection)
664            (entry (calc-top num 'entry))            (entry (calc-top num 'entry))
665            (expr (car entry))            (expr (car entry))
666            (sel (or (calc-auto-selection entry) expr))            (sel (or (calc-auto-selection entry) expr))
# Line 642  Line 668 
668       (let ((str (math-showing-full-precision       (let ((str (math-showing-full-precision
669                   (math-format-nice-expr sel (frame-width)))))                   (math-format-nice-expr sel (frame-width)))))
670         (calc-edit-mode (list 'calc-finish-selection-edit         (calc-edit-mode (list 'calc-finish-selection-edit
671                               num (list 'quote sel) reselect))                               num (list 'quote sel) calc-sel-reselect))
672         (insert str "\n"))))         (insert str "\n"))))
673    (calc-show-edit-buffer))    (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)
680    
681  (defun calc-finish-selection-edit (num sel reselect)  (defun calc-finish-selection-edit (num sel reselect)
682    (let ((buf (current-buffer))    (let ((buf (current-buffer))
683          (str (buffer-substring (point) (point-max)))          (str (buffer-substring (point) (point-max)))
# Line 659  Line 691 
691              (error (nth 2 val))))              (error (nth 2 val))))
692        (calc-wrapper        (calc-wrapper
693         (calc-preserve-point)         (calc-preserve-point)
694         (if disp-trail         (if calc-edit-disp-trail
695             (calc-trail-display 1 t))             (calc-trail-display 1 t))
696         (setq val (calc-encase-atoms (calc-normalize val)))         (setq val (calc-encase-atoms (calc-normalize val)))
697         (let ((expr (calc-top num 'full)))         (let ((expr (calc-top num 'full)))
# Line 677  Line 709 
709    (calc-slow-wrapper    (calc-slow-wrapper
710     (calc-preserve-point)     (calc-preserve-point)
711     (let* ((num (max 1 (calc-locate-cursor-element (point))))     (let* ((num (max 1 (calc-locate-cursor-element (point))))
712            (reselect calc-keep-selection)            (calc-sel-reselect calc-keep-selection)
713            (entry (calc-top num 'entry))            (entry (calc-top num 'entry))
714            (sel (or (calc-auto-selection entry) (car entry))))            (sel (or (calc-auto-selection entry) (car entry))))
715       (calc-with-default-simplification       (calc-with-default-simplification
# Line 688  Line 720 
720                                       (list (calc-replace-sub-formula                                       (list (calc-replace-sub-formula
721                                              (car entry) sel val))                                              (car entry) sel val))
722                                       num                                       num
723                                       (list (and reselect val))))))                                       (list (and calc-sel-reselect val))))))
724       (calc-handle-whys))))       (calc-handle-whys))))
725    
726  (defun calc-sel-expand-formula (arg)  (defun calc-sel-expand-formula (arg)
# Line 696  Line 728 
728    (calc-slow-wrapper    (calc-slow-wrapper
729     (calc-preserve-point)     (calc-preserve-point)
730     (let* ((num (max 1 (calc-locate-cursor-element (point))))     (let* ((num (max 1 (calc-locate-cursor-element (point))))
731            (reselect calc-keep-selection)            (calc-sel-reselect calc-keep-selection)
732            (entry (calc-top num 'entry))            (entry (calc-top num 'entry))
733            (sel (or (calc-auto-selection entry) (car entry))))            (sel (or (calc-auto-selection entry) (car entry))))
734       (calc-with-default-simplification       (calc-with-default-simplification
# Line 713  Line 745 
745                                       (list (calc-replace-sub-formula                                       (list (calc-replace-sub-formula
746                                              (car entry) sel val))                                              (car entry) sel val))
747                                       num                                       num
748                                       (list (and reselect val))))))                                       (list (and calc-sel-reselect val))))))
749       (calc-handle-whys))))       (calc-handle-whys))))
750    
751  (defun calc-sel-mult-both-sides (no-simp &optional divide)  (defun calc-sel-mult-both-sides (no-simp &optional divide)
# Line 721  Line 753 
753    (calc-wrapper    (calc-wrapper
754     (calc-preserve-point)     (calc-preserve-point)
755     (let* ((num (max 1 (calc-locate-cursor-element (point))))     (let* ((num (max 1 (calc-locate-cursor-element (point))))
756            (reselect calc-keep-selection)            (calc-sel-reselect calc-keep-selection)
757            (entry (calc-top num 'entry))            (entry (calc-top num 'entry))
758            (expr (car entry))            (expr (car entry))
759            (sel (or (calc-auto-selection entry) expr))            (sel (or (calc-auto-selection entry) expr))
# Line 774  Line 806 
806                                         (list (calc-replace-sub-formula                                         (list (calc-replace-sub-formula
807                                                expr sel alg))                                                expr sel alg))
808                                         num                                         num
809                                         (list (and reselect alg)))))                                         (list (and calc-sel-reselect alg)))))
810       (calc-handle-whys))))       (calc-handle-whys))))
811    
812  (defun calc-sel-div-both-sides (no-simp)  (defun calc-sel-div-both-sides (no-simp)
# Line 786  Line 818 
818    (calc-wrapper    (calc-wrapper
819     (calc-preserve-point)     (calc-preserve-point)
820     (let* ((num (max 1 (calc-locate-cursor-element (point))))     (let* ((num (max 1 (calc-locate-cursor-element (point))))
821            (reselect calc-keep-selection)            (calc-sel-reselect calc-keep-selection)
822            (entry (calc-top num 'entry))            (entry (calc-top num 'entry))
823            (expr (car entry))            (expr (car entry))
824            (sel (or (calc-auto-selection entry) expr))            (sel (or (calc-auto-selection entry) expr))
# Line 818  Line 850 
850                                         (list (calc-replace-sub-formula                                         (list (calc-replace-sub-formula
851                                                expr sel alg))                                                expr sel alg))
852                                         num                                         num
853                                         (list (and reselect alg)))))                                         (list (and calc-sel-reselect alg)))))
854       (calc-handle-whys))))       (calc-handle-whys))))
855    
856  (defun calc-sel-sub-both-sides (no-simp)  (defun calc-sel-sub-both-sides (no-simp)

Legend:
Removed from v.1.7  
changed lines
  Added in v.1.8

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26