Mercurial > emacs
annotate lisp/calc/calc-sel.el @ 110410:f2e111723c3a
Merge changes made in Gnus trunk.
Reimplement nnimap, and do tweaks to the rest of the code to support that.
* gnus-int.el (gnus-finish-retrieve-group-infos)
(gnus-retrieve-group-data-early): New functions.
* gnus-range.el (gnus-range-nconcat): New function.
* gnus-start.el (gnus-get-unread-articles): Support early retrieval of
data.
(gnus-read-active-for-groups): Support finishing the early retrieval of
data.
* gnus-sum.el (gnus-summary-move-article): Pass the move-to group name
if the move is internal, so that nnimap can do fast internal moves.
* gnus.el (gnus-article-special-mark-lists): Add uid/active tuples, for
nnimap usage.
* nnimap.el: Rewritten.
* nnmail.el (nnmail-inhibit-default-split-group): New internal variable
to allow the mail splitting to not return a default group. This is
useful for nnimap, which will leave unmatched mail in the inbox.
* utf7.el (utf7-encode): Autoload.
Implement shell connection.
* nnimap.el (nnimap-open-shell-stream): New function.
(nnimap-open-connection): Use it.
Get the number of lines by using BODYSTRUCTURE.
(nnimap-transform-headers): Get the number of lines in each message.
(nnimap-retrieve-headers): Query for BODYSTRUCTURE so that we get the
number of lines.
Not all servers return UIDNEXT. Work past this problem.
Remove junk from end of file.
Fix typo in "bogus" section.
Make capabilties be case-insensitive.
Require cl when compiling.
Don't bug out if the LIST command doesn't have any parameters.
2010-09-17 Knut Anders Hatlen <kahatlen@gmail.com> (tiny change)
* nnimap.el (nnimap-get-groups): Don't bug out if the LIST command
doesn't have any parameters.
(mm-text-html-renderer): Document gnus-article-html.
2010-09-17 Julien Danjou <julien@danjou.info> (tiny fix)
* mm-decode.el (mm-text-html-renderer): Document gnus-article-html.
* dgnushack.el: Define netrc-credentials.
If the user doesn't have a /etc/services, supply some sensible port defaults.
Have `unseen-or-unread' select an unread unseen article first.
(nntp-open-server): Return whether the open was successful or not.
Throughout all files, replace (save-excursion (set-buffer ...)) with (with-current-buffer ... ).
Save result so that it doesn't say "failed" all the time.
Add ~/.authinfo to the default, since that's probably most useful for users.
Don't use the "finish" method when we're reading from the agent.
Add some more nnimap-relevant agent stuff to nnagent.el.
* nnimap.el (nnimap-with-process-buffer): Removed.
Revert one line that was changed by mistake in the last checkin.
(nnimap-open-connection): Don't error out when we can't make a connection
nnimap-related changes to avoid bugging out if we can't contact a server.
* gnus-start.el (gnus-get-unread-articles): Don't try to scan groups
from methods that are denied.
* nnimap.el (nnimap-possibly-change-group): Return nil if we can't log
in.
(nnimap-finish-retrieve-group-infos): Make sure we're not waiting for
nothing.
* gnus-sum.el (gnus-select-newsgroup): Indent.
author | Katsumi Yamaoka <yamaoka@jpl.org> |
---|---|
date | Sat, 18 Sep 2010 10:02:19 +0000 |
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 |