Mercurial > emacs
annotate lisp/calc/calc-sel.el @ 110263:280c5216180d
Make sure original ispell arg list is initialized in (ispell-start-process).
* textmodes/ispell.el (ispell-start-process): Make sure original
arg list is properly initialized (Bug#6993, Bug#6994).
author | Agustin martin <agustin.martin@hispalinux.es> |
---|---|
date | Tue, 07 Sep 2010 20:01:23 +0200 |
parents | bc0b9af387a7 |
children | 417b1e4d63cd |
rev | line source |
---|---|
41271
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
1 ;;; calc-sel.el --- data selection functions for Calc |
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
2 |
64325
1db49616ce05
Update copyright information.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
60908
diff
changeset
|
3 ;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, |
106815 | 4 ;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. |
41271
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
5 |
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
6 ;; Author: David Gillespie <daveg@synaptics.com> |
77465
1154f082efd9
Update maintainer's address.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
76595
diff
changeset
|
7 ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> |
40785 | 8 |
9 ;; This file is part of GNU Emacs. | |
10 | |
94654
6c9af2bfcfee
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
11 ;; GNU Emacs is free software: you can redistribute it and/or modify |
76595
497d17a80bb8
Change form of license text to match rest of Emacs.
Glenn Morris <rgm@gnu.org>
parents:
75346
diff
changeset
|
12 ;; it under the terms of the GNU General Public License as published by |
94654
6c9af2bfcfee
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
13 ;; the Free Software Foundation, either version 3 of the License, or |
6c9af2bfcfee
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
14 ;; (at your option) any later version. |
40785 | 15 |
76595
497d17a80bb8
Change form of license text to match rest of Emacs.
Glenn Morris <rgm@gnu.org>
parents:
75346
diff
changeset
|
16 ;; GNU Emacs is distributed in the hope that it will be useful, |
497d17a80bb8
Change form of license text to match rest of Emacs.
Glenn Morris <rgm@gnu.org>
parents:
75346
diff
changeset
|
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
497d17a80bb8
Change form of license text to match rest of Emacs.
Glenn Morris <rgm@gnu.org>
parents:
75346
diff
changeset
|
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
497d17a80bb8
Change form of license text to match rest of Emacs.
Glenn Morris <rgm@gnu.org>
parents:
75346
diff
changeset
|
19 ;; GNU General Public License for more details. |
497d17a80bb8
Change form of license text to match rest of Emacs.
Glenn Morris <rgm@gnu.org>
parents:
75346
diff
changeset
|
20 |
497d17a80bb8
Change form of license text to match rest of Emacs.
Glenn Morris <rgm@gnu.org>
parents:
75346
diff
changeset
|
21 ;; You should have received a copy of the GNU General Public License |
94654
6c9af2bfcfee
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
40785 | 23 |
41271
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
24 ;;; Commentary: |
40785 | 25 |
41271
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
26 ;;; Code: |
40785 | 27 |
28 ;; This file is autoloaded from calc-ext.el. | |
58671
904fb3627e77
Add a provide statement.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58466
diff
changeset
|
29 |
40785 | 30 (require 'calc-ext) |
31 (require 'calc-macs) | |
32 | |
33 ;;; Selection commands. | |
34 | |
41271
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
35 (defvar calc-keep-selection t) |
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
36 |
58336
2d07929a4d0b
(calc-selection-cache-entry): Moved declaration to earlier in the
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
37 (defvar calc-selection-cache-entry nil) |
2d07929a4d0b
(calc-selection-cache-entry): Moved declaration to earlier in the
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
38 (defvar calc-selection-cache-num) |
2d07929a4d0b
(calc-selection-cache-entry): Moved declaration to earlier in the
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
39 (defvar calc-selection-cache-comp) |
2d07929a4d0b
(calc-selection-cache-entry): Moved declaration to earlier in the
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
40 (defvar calc-selection-cache-offset) |
2d07929a4d0b
(calc-selection-cache-entry): Moved declaration to earlier in the
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
41 (defvar calc-selection-true-num) |
2d07929a4d0b
(calc-selection-cache-entry): Moved declaration to earlier in the
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
42 |
40785 | 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)"))) | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49263
diff
changeset
|
54 (calc-change-current-selection |
40785 | 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)) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40998
diff
changeset
|
64 (car entry)))))))) |
40785 | 65 |
66 (defun calc-select-once (num) | |
67 (interactive "P") | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40998
diff
changeset
|
68 (calc-select-here num t)) |
40785 | 69 |
70 (defun calc-select-here-maybe (num) | |
71 (interactive "P") | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40998
diff
changeset
|
72 (calc-select-here num nil t)) |
40785 | 73 |
74 (defun calc-select-once-maybe (num) | |
75 (interactive "P") | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40998
diff
changeset
|
76 (calc-select-here num t t)) |
40785 | 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))) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40998
diff
changeset
|
96 (car entry)))))) |
40785 | 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)) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40998
diff
changeset
|
109 (calc-select-here num))))) |
40785 | 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)) | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49263
diff
changeset
|
117 (calc-change-current-selection |
40785 | 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)))) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40998
diff
changeset
|
131 sel)))))) |
40785 | 132 |
133 (defun calc-select-part (num) | |
134 (interactive "P") | |
101001
14b421290b2f
Replace last-command-char with last-command-event.
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
135 (or num (setq num (- last-command-event ?0))) |
40785 | 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) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40998
diff
changeset
|
143 (error "%d is not a valid sub-formula index" num))))) |
40785 | 144 |
58336
2d07929a4d0b
(calc-selection-cache-entry): Moved declaration to earlier in the
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
145 ;; The variables calc-fnp-op and calc-fnp-num are local to |
2d07929a4d0b
(calc-selection-cache-entry): Moved declaration to earlier in the
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
146 ;; calc-find-nth-part (and calc-select-previous) but used by |
2d07929a4d0b
(calc-selection-cache-entry): Moved declaration to earlier in the
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
147 ;; calc-find-nth-part-rec, which is called by them. |
2d07929a4d0b
(calc-selection-cache-entry): Moved declaration to earlier in the
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
148 (defvar calc-fnp-op) |
2d07929a4d0b
(calc-selection-cache-entry): Moved declaration to earlier in the
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
149 (defvar calc-fnp-num) |
2d07929a4d0b
(calc-selection-cache-entry): Moved declaration to earlier in the
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
150 |
2d07929a4d0b
(calc-selection-cache-entry): Moved declaration to earlier in the
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
151 (defun calc-find-nth-part (expr calc-fnp-num) |
40785 | 152 (if (and calc-assoc-selections |
153 (assq (car-safe expr) calc-assoc-ops)) | |
58336
2d07929a4d0b
(calc-selection-cache-entry): Moved declaration to earlier in the
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
154 (let (calc-fnp-op) |
40785 | 155 (calc-find-nth-part-rec expr)) |
156 (if (eq (car-safe expr) 'intv) | |
58336
2d07929a4d0b
(calc-selection-cache-entry): Moved declaration to earlier in the
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
157 (and (>= calc-fnp-num 1) (<= calc-fnp-num 2) (nth (1+ calc-fnp-num) expr)) |
2d07929a4d0b
(calc-selection-cache-entry): Moved declaration to earlier in the
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
158 (and (not (Math-primp expr)) (>= calc-fnp-num 1) (< calc-fnp-num (length expr)) |
2d07929a4d0b
(calc-selection-cache-entry): Moved declaration to earlier in the
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
159 (nth calc-fnp-num expr))))) |
40785 | 160 |
161 (defun calc-find-nth-part-rec (expr) ; uses num, op | |
58336
2d07929a4d0b
(calc-selection-cache-entry): Moved declaration to earlier in the
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
162 (or (if (and (setq calc-fnp-op (assq (car-safe (nth 1 expr)) calc-assoc-ops)) |
2d07929a4d0b
(calc-selection-cache-entry): Moved declaration to earlier in the
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
163 (memq (car expr) (nth 1 calc-fnp-op))) |
40785 | 164 (calc-find-nth-part-rec (nth 1 expr)) |
58336
2d07929a4d0b
(calc-selection-cache-entry): Moved declaration to earlier in the
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
165 (and (= (setq calc-fnp-num (1- calc-fnp-num)) 0) |
40785 | 166 (nth 1 expr))) |
58336
2d07929a4d0b
(calc-selection-cache-entry): Moved declaration to earlier in the
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
167 (if (and (setq calc-fnp-op (assq (car-safe (nth 2 expr)) calc-assoc-ops)) |
2d07929a4d0b
(calc-selection-cache-entry): Moved declaration to earlier in the
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
168 (memq (car expr) (nth 2 calc-fnp-op))) |
40785 | 169 (calc-find-nth-part-rec (nth 2 expr)) |
58336
2d07929a4d0b
(calc-selection-cache-entry): Moved declaration to earlier in the
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
170 (and (= (setq calc-fnp-num (1- calc-fnp-num)) 0) |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40998
diff
changeset
|
171 (nth 2 expr))))) |
40785 | 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)) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40998
diff
changeset
|
208 (calc-select-part num))))))) |
40785 | 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)) | |
58336
2d07929a4d0b
(calc-selection-cache-entry): Moved declaration to earlier in the
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
249 (let (calc-fnp-op (calc-fnp-num 0)) |
40785 | 250 (calc-find-nth-part-rec (car entry)) |
58336
2d07929a4d0b
(calc-selection-cache-entry): Moved declaration to earlier in the
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
251 (- 1 calc-fnp-num)) |
40785 | 252 (length (car entry))))) |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40998
diff
changeset
|
253 (calc-select-part (- len num))))))))) |
40785 | 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 | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40998
diff
changeset
|
264 (if (eq res t) expr res)))))) |
40785 | 265 |
266 | |
267 (defun calc-find-assoc-parent-formula (expr part) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40998
diff
changeset
|
268 (calc-grow-assoc-formula expr (calc-find-parent-formula expr part))) |
40785 | 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) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40998
diff
changeset
|
281 part)) |
40785 | 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))) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40998
diff
changeset
|
291 (and expr num))))) |
40785 | 292 |
293 (defun calc-unselect (num) | |
294 (interactive "P") | |
295 (calc-wrapper | |
296 (calc-prepare-selection num) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40998
diff
changeset
|
297 (calc-change-current-selection nil))) |
40785 | 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)))) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40998
diff
changeset
|
310 (calc-clear-command-flag 'position-point))) |
40785 | 311 |
109682
bc0b9af387a7
calc.el (calc-trail-mode,calc-refresh): Use `face' property to italicize headers.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
106815
diff
changeset
|
312 (defvar calc-highlight-selections-with-faces) |
bc0b9af387a7
calc.el (calc-trail-mode,calc-refresh): Use `face' property to italicize headers.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
106815
diff
changeset
|
313 |
40785 | 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 | |
109682
bc0b9af387a7
calc.el (calc-trail-mode,calc-refresh): Use `face' property to italicize headers.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
106815
diff
changeset
|
335 (if calc-highlight-selections-with-faces |
bc0b9af387a7
calc.el (calc-trail-mode,calc-refresh): Use `face' property to italicize headers.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
106815
diff
changeset
|
336 "De-emphasizing all but selected part of formulas" |
bc0b9af387a7
calc.el (calc-trail-mode,calc-refresh): Use `face' property to italicize headers.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
106815
diff
changeset
|
337 "Displaying only selected part of formulas") |
bc0b9af387a7
calc.el (calc-trail-mode,calc-refresh): Use `face' property to italicize headers.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
106815
diff
changeset
|
338 (if calc-highlight-selections-with-faces |
bc0b9af387a7
calc.el (calc-trail-mode,calc-refresh): Use `face' property to italicize headers.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
106815
diff
changeset
|
339 "Emphasizing selected part of formulas" |
bc0b9af387a7
calc.el (calc-trail-mode,calc-refresh): Use `face' property to italicize headers.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
106815
diff
changeset
|
340 "Displaying all but selected part of formulas"))))) |
40785 | 341 |
58336
2d07929a4d0b
(calc-selection-cache-entry): Moved declaration to earlier in the
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
342 ;; The variables calc-final-point-line and calc-final-point-column |
2d07929a4d0b
(calc-selection-cache-entry): Moved declaration to earlier in the
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
343 ;; are declared in calc.el, and are used throughout. |
2d07929a4d0b
(calc-selection-cache-entry): Moved declaration to earlier in the
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
344 (defvar calc-final-point-line) |
2d07929a4d0b
(calc-selection-cache-entry): Moved declaration to earlier in the
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
345 (defvar calc-final-point-column) |
2d07929a4d0b
(calc-selection-cache-entry): Moved declaration to earlier in the
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
346 |
40785 | 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)) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40998
diff
changeset
|
353 (calc-set-command-flag 'position-point)))) |
40785 | 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" | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40998
diff
changeset
|
365 "Selections of sub-formulas have no effect")))) |
40785 | 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" | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40998
diff
changeset
|
376 "Selection treats a+b+c as (a+b)+c")))) |
40785 | 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)))))) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40998
diff
changeset
|
399 (calc-preserve-point)) |
40785 | 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) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40998
diff
changeset
|
407 x)) |
40785 | 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)) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40998
diff
changeset
|
418 (calc-encase-atoms-rec (car x))))))) |
40785 | 419 |
58466 | 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 | |
40785 | 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)) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40998
diff
changeset
|
448 (nth 1 math-comp-sel-tag))) |
40785 | 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) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40998
diff
changeset
|
463 "\n"))))) |
40785 | 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))) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40998
diff
changeset
|
478 sel)))) |
40785 | 479 |
58336
2d07929a4d0b
(calc-selection-cache-entry): Moved declaration to earlier in the
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
480 ;; The variables calc-rsf-old and calc-rsf-new are local to |
2d07929a4d0b
(calc-selection-cache-entry): Moved declaration to earlier in the
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
481 ;; calc-replace-sub-formula, but used by calc-replace-sub-formula-rec, |
2d07929a4d0b
(calc-selection-cache-entry): Moved declaration to earlier in the
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
482 ;; which is called by calc-replace-sub-formula. |
2d07929a4d0b
(calc-selection-cache-entry): Moved declaration to earlier in the
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
483 (defvar calc-rsf-old) |
2d07929a4d0b
(calc-selection-cache-entry): Moved declaration to earlier in the
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
484 (defvar calc-rsf-new) |
2d07929a4d0b
(calc-selection-cache-entry): Moved declaration to earlier in the
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
485 |
2d07929a4d0b
(calc-selection-cache-entry): Moved declaration to earlier in the
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
486 (defun calc-replace-sub-formula (expr calc-rsf-old calc-rsf-new) |
2d07929a4d0b
(calc-selection-cache-entry): Moved declaration to earlier in the
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
487 (setq calc-rsf-new (calc-encase-atoms calc-rsf-new)) |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40998
diff
changeset
|
488 (calc-replace-sub-formula-rec expr)) |
40785 | 489 |
490 (defun calc-replace-sub-formula-rec (expr) | |
58336
2d07929a4d0b
(calc-selection-cache-entry): Moved declaration to earlier in the
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
491 (cond ((eq expr calc-rsf-old) calc-rsf-new) |
40785 | 492 ((Math-primp expr) expr) |
493 (t | |
494 (cons (car expr) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40998
diff
changeset
|
495 (mapcar 'calc-replace-sub-formula-rec (cdr expr)))))) |
40785 | 496 |
497 (defun calc-sel-error () | |
60908
7b8e42efa46a
* calc/calc-forms.el, calc/calc-sel: Replace `illegal' with
Werner LEMBERG <wl@gnu.org>
parents:
59307
diff
changeset
|
498 (error "Invalid operation on sub-formulas")) |
40785 | 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) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40998
diff
changeset
|
545 (calc-push-list vals m))) |
40785 | 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))))) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40998
diff
changeset
|
595 (calc-pop-stack 1 n t)))) |
40785 | 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)))) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40998
diff
changeset
|
602 (calc-pop-push-list n vals 1 sels))) |
40785 | 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)))) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40998
diff
changeset
|
609 (calc-pop-push-list n vals 1 sels))) |
40785 | 610 |
58336
2d07929a4d0b
(calc-selection-cache-entry): Moved declaration to earlier in the
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
611 ;; The variable calc-sel-reselect is local to several functions |
2d07929a4d0b
(calc-selection-cache-entry): Moved declaration to earlier in the
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
612 ;; which call calc-auto-selection. |
2d07929a4d0b
(calc-selection-cache-entry): Moved declaration to earlier in the
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
613 (defvar calc-sel-reselect) |
2d07929a4d0b
(calc-selection-cache-entry): Moved declaration to earlier in the
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
614 |
40785 | 615 (defun calc-auto-selection (entry) |
616 (or (nth 2 entry) | |
617 (progn | |
58336
2d07929a4d0b
(calc-selection-cache-entry): Moved declaration to earlier in the
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
618 (setq calc-sel-reselect nil) |
40785 | 619 (calc-prepare-selection) |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40998
diff
changeset
|
620 (calc-grow-assoc-formula (car entry) (calc-find-selected-part))))) |
40785 | 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))) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40998
diff
changeset
|
628 (calc-push (or (calc-auto-selection entry) (car entry)))))) |
40785 | 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)) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40998
diff
changeset
|
638 (calc-delete-selection num)))) |
40785 | 639 |
72040
327ca65acc1b
(calc-selection-history): New variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
68636
diff
changeset
|
640 (defvar calc-selection-history nil |
327ca65acc1b
(calc-selection-history): New variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
68636
diff
changeset
|
641 "History for calc selections.") |
327ca65acc1b
(calc-selection-history): New variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
68636
diff
changeset
|
642 |
40785 | 643 (defun calc-enter-selection () |
644 (interactive) | |
645 (calc-wrapper | |
646 (calc-preserve-point) | |
647 (let* ((num (max 1 (calc-locate-cursor-element (point)))) | |
58336
2d07929a4d0b
(calc-selection-cache-entry): Moved declaration to earlier in the
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
648 (calc-sel-reselect calc-keep-selection) |
40785 | 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)) | |
72040
327ca65acc1b
(calc-selection-history): New variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
68636
diff
changeset
|
655 (setq alg (calc-do-alg-entry "" "Replace selection with: " nil |
327ca65acc1b
(calc-selection-history): New variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
68636
diff
changeset
|
656 'calc-selection-history)) |
40785 | 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 | |
58336
2d07929a4d0b
(calc-selection-cache-entry): Moved declaration to earlier in the
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
664 (list (and calc-sel-reselect alg)))))) |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40998
diff
changeset
|
665 (calc-handle-whys)))) |
40785 | 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)))) | |
58336
2d07929a4d0b
(calc-selection-cache-entry): Moved declaration to earlier in the
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
672 (calc-sel-reselect calc-keep-selection) |
40785 | 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 | |
40998
ee9c2872370b
Use `frame-width' instead of `screen-width',
Eli Zaretskii <eliz@gnu.org>
parents:
40785
diff
changeset
|
678 (math-format-nice-expr sel (frame-width))))) |
40785 | 679 (calc-edit-mode (list 'calc-finish-selection-edit |
58336
2d07929a4d0b
(calc-selection-cache-entry): Moved declaration to earlier in the
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
680 num (list 'quote sel) calc-sel-reselect)) |
40785 | 681 (insert str "\n")))) |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40998
diff
changeset
|
682 (calc-show-edit-buffer)) |
40785 | 683 |
58336
2d07929a4d0b
(calc-selection-cache-entry): Moved declaration to earlier in the
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
684 (defvar calc-original-buffer) |
2d07929a4d0b
(calc-selection-cache-entry): Moved declaration to earlier in the
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
685 |
2d07929a4d0b
(calc-selection-cache-entry): Moved declaration to earlier in the
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
686 ;; The variable calc-edit-disp-trail is local to calc-edit-finish, |
2d07929a4d0b
(calc-selection-cache-entry): Moved declaration to earlier in the
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
687 ;; in calc-yank.el. |
2d07929a4d0b
(calc-selection-cache-entry): Moved declaration to earlier in the
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
688 (defvar calc-edit-disp-trail) |
59307
bef2fe94c4a5
(calc-finish-selection-edit): Use calc-edit-top for the beginning of
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58671
diff
changeset
|
689 (defvar calc-edit-top) |
58336
2d07929a4d0b
(calc-selection-cache-entry): Moved declaration to earlier in the
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
690 |
40785 | 691 (defun calc-finish-selection-edit (num sel reselect) |
692 (let ((buf (current-buffer)) | |
59307
bef2fe94c4a5
(calc-finish-selection-edit): Use calc-edit-top for the beginning of
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58671
diff
changeset
|
693 (str (buffer-substring calc-edit-top (point-max))) |
40785 | 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) | |
58336
2d07929a4d0b
(calc-selection-cache-entry): Moved declaration to earlier in the
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
704 (if calc-edit-disp-trail |
40785 | 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) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40998
diff
changeset
|
715 (error "Original selection has been lost"))))))) |
40785 | 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)))) | |
58336
2d07929a4d0b
(calc-selection-cache-entry): Moved declaration to earlier in the
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
722 (calc-sel-reselect calc-keep-selection) |
40785 | 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 | |
58336
2d07929a4d0b
(calc-selection-cache-entry): Moved declaration to earlier in the
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
733 (list (and calc-sel-reselect val)))))) |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40998
diff
changeset
|
734 (calc-handle-whys)))) |
40785 | 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)))) | |
58336
2d07929a4d0b
(calc-selection-cache-entry): Moved declaration to earlier in the
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
741 (calc-sel-reselect calc-keep-selection) |
40785 | 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 | |
58336
2d07929a4d0b
(calc-selection-cache-entry): Moved declaration to earlier in the
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
758 (list (and calc-sel-reselect val)))))) |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40998
diff
changeset
|
759 (calc-handle-whys)))) |
40785 | 760 |
101528
b07dab1a7538
(cal-sel-mult-both-sides): Add an option to expand the denominator.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
101001
diff
changeset
|
761 (defun calc-sel-mult-both-sides (arg &optional divide) |
40785 | 762 (interactive "P") |
763 (calc-wrapper | |
764 (calc-preserve-point) | |
101528
b07dab1a7538
(cal-sel-mult-both-sides): Add an option to expand the denominator.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
101001
diff
changeset
|
765 (let* ((no-simp (consp arg)) |
b07dab1a7538
(cal-sel-mult-both-sides): Add an option to expand the denominator.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
101001
diff
changeset
|
766 (num (max 1 (calc-locate-cursor-element (point)))) |
58336
2d07929a4d0b
(calc-selection-cache-entry): Moved declaration to earlier in the
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
767 (calc-sel-reselect calc-keep-selection) |
40785 | 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: " | |
72040
327ca65acc1b
(calc-selection-history): New variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
68636
diff
changeset
|
777 "Multiply both sides by: ") |
327ca65acc1b
(calc-selection-history): New variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
68636
diff
changeset
|
778 nil 'calc-selection-history)))) |
40785 | 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) | |
101528
b07dab1a7538
(cal-sel-mult-both-sides): Add an option to expand the denominator.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
101001
diff
changeset
|
804 (Math-equal (nth 1 sel) -1)) |
b07dab1a7538
(cal-sel-mult-both-sides): Add an option to expand the denominator.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
101001
diff
changeset
|
805 ; (and (memq (car-safe (nth 2 sel)) '(+ -)) |
b07dab1a7538
(cal-sel-mult-both-sides): Add an option to expand the denominator.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
101001
diff
changeset
|
806 ; (memq (car-safe alg) '(+ -)))) |
b07dab1a7538
(cal-sel-mult-both-sides): Add an option to expand the denominator.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
101001
diff
changeset
|
807 (unless arg |
b07dab1a7538
(cal-sel-mult-both-sides): Add an option to expand the denominator.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
101001
diff
changeset
|
808 (setq rhs (math-expand-term rhs)))))) |
b07dab1a7538
(cal-sel-mult-both-sides): Add an option to expand the denominator.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
101001
diff
changeset
|
809 (if (and arg (not no-simp)) |
101558
ab3d548d13f2
(calc-sel-expand-formula): Simplify expanded denominator.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
101528
diff
changeset
|
810 (setq rhs (math-simplify |
ab3d548d13f2
(calc-sel-expand-formula): Simplify expanded denominator.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
101528
diff
changeset
|
811 (calcFunc-expand rhs (unless (= arg 0) arg))))) |
40785 | 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 | |
58336
2d07929a4d0b
(calc-selection-cache-entry): Moved declaration to earlier in the
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
825 (list (and calc-sel-reselect alg))))) |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40998
diff
changeset
|
826 (calc-handle-whys)))) |
40785 | 827 |
828 (defun calc-sel-div-both-sides (no-simp) | |
829 (interactive "P") | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40998
diff
changeset
|
830 (calc-sel-mult-both-sides no-simp t)) |
40785 | 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)))) | |
58336
2d07929a4d0b
(calc-selection-cache-entry): Moved declaration to earlier in the
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
837 (calc-sel-reselect calc-keep-selection) |
40785 | 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: " | |
72040
327ca65acc1b
(calc-selection-history): New variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
68636
diff
changeset
|
847 "Add to both sides: ") |
327ca65acc1b
(calc-selection-history): New variable.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
68636
diff
changeset
|
848 nil 'calc-selection-history)))) |
40785 | 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 | |
58336
2d07929a4d0b
(calc-selection-cache-entry): Moved declaration to earlier in the
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
870 (list (and calc-sel-reselect alg))))) |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40998
diff
changeset
|
871 (calc-handle-whys)))) |
40785 | 872 |
873 (defun calc-sel-sub-both-sides (no-simp) | |
874 (interactive "P") | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40998
diff
changeset
|
875 (calc-sel-add-both-sides no-simp t)) |
40785 | 876 |
58671
904fb3627e77
Add a provide statement.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58466
diff
changeset
|
877 (provide 'calc-sel) |
904fb3627e77
Add a provide statement.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58466
diff
changeset
|
878 |
93975
1e3a407766b9
Fix up comment convention on the arch-tag lines.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
79702
diff
changeset
|
879 ;; arch-tag: e5169792-777d-428f-bff5-acca66813fa2 |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40998
diff
changeset
|
880 ;;; calc-sel.el ends here |