Mercurial > emacs
annotate lisp/calc/calc-store.el @ 59677:d762442d2c8f
(auto_window_vscroll_p): New boolean.
(syms_of_window): DEFVAR_BOOL it.
(Fpos_visible_in_window_p): Extend return value to include RTOP
and RBOT values if FULLY is nil.
(window_scroll_pixel_based): Adjust vscroll for partially visible
rows if auto_window_vscroll_p is set.
(Fset_window_vscroll): Do nothing if vscroll is not modified.
author | Kim F. Storm <storm@cua.dk> |
---|---|
date | Sat, 22 Jan 2005 01:41:47 +0000 |
parents | b851b98f8dc1 |
children | be3370bd02da f6b4d0ebf147 |
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-store.el --- value storage 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 |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
3 ;; Copyright (C) 1990, 1991, 1992, 1993, 2001 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
|
4 |
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
5 ;; Author: David Gillespie <daveg@synaptics.com> |
58547
1e95f60dbab4
(calc-given-value, calc-store-opers): Declare them.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
6 ;; Maintainer: Jay Belanger <belanger@truman.edu> |
40785 | 7 |
8 ;; This file is part of GNU Emacs. | |
9 | |
10 ;; GNU Emacs is distributed in the hope that it will be useful, | |
11 ;; but WITHOUT ANY WARRANTY. No author or distributor | |
12 ;; accepts responsibility to anyone for the consequences of using it | |
13 ;; or for whether it serves any particular purpose or works at all, | |
14 ;; unless he says so in writing. Refer to the GNU Emacs General Public | |
15 ;; License for full details. | |
16 | |
17 ;; Everyone is granted permission to copy, modify and redistribute | |
18 ;; GNU Emacs, but only under the conditions described in the | |
19 ;; GNU Emacs General Public License. A copy of this license is | |
20 ;; supposed to have been given to you along with GNU Emacs so you | |
21 ;; can know your rights and responsibilities. It should be in a | |
22 ;; file named COPYING. Among other things, the copyright notice | |
23 ;; and this notice must be preserved on all copies. | |
24 | |
41271
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
25 ;;; Commentary: |
40785 | 26 |
41271
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
27 ;;; Code: |
40785 | 28 |
29 ;; This file is autoloaded from calc-ext.el. | |
58673
202eaef4ca19
Add a provide statement.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58547
diff
changeset
|
30 |
40785 | 31 (require 'calc-ext) |
32 (require 'calc-macs) | |
33 | |
34 ;;; Memory commands. | |
35 | |
41271
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
36 (defvar calc-store-keep nil) |
40785 | 37 (defun calc-store (&optional var) |
38 (interactive) | |
39 (let ((calc-store-keep t)) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
40 (calc-store-into var))) |
40785 | 41 |
41271
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
42 (defvar calc-given-value-flag nil) |
58547
1e95f60dbab4
(calc-given-value, calc-store-opers): Declare them.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
43 (defvar calc-given-value) |
1e95f60dbab4
(calc-given-value, calc-store-opers): Declare them.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
44 |
40785 | 45 (defun calc-store-into (&optional var) |
46 (interactive) | |
47 (calc-wrapper | |
48 (let ((calc-given-value nil) | |
49 (calc-given-value-flag 1)) | |
50 (or var (setq var (calc-read-var-name "Store: " t))) | |
51 (if var | |
52 (let ((found (assq var '( ( + . calc-store-plus ) | |
53 ( - . calc-store-minus ) | |
54 ( * . calc-store-times ) | |
55 ( / . calc-store-div ) | |
56 ( ^ . calc-store-power ) | |
57 ( | . calc-store-concat ) )))) | |
58 (if found | |
59 (funcall (cdr found)) | |
60 (calc-store-value var (or calc-given-value (calc-top 1)) | |
61 "" calc-given-value-flag) | |
62 (message "Stored to variable \"%s\"" (calc-var-name var)))) | |
63 (setq var (calc-is-assignments (calc-top 1))) | |
64 (if var | |
65 (while var | |
66 (calc-store-value (car (car var)) (cdr (car var)) | |
67 (if (not (cdr var)) "") | |
68 (if (not (cdr var)) 1)) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
69 (setq var (cdr var)))))))) |
40785 | 70 |
71 (defun calc-store-plus (&optional var) | |
72 (interactive) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
73 (calc-store-binary var "+" '+)) |
40785 | 74 |
75 (defun calc-store-minus (&optional var) | |
76 (interactive) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
77 (calc-store-binary var "-" '-)) |
40785 | 78 |
79 (defun calc-store-times (&optional var) | |
80 (interactive) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
81 (calc-store-binary var "*" '*)) |
40785 | 82 |
83 (defun calc-store-div (&optional var) | |
84 (interactive) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
85 (calc-store-binary var "/" '/)) |
40785 | 86 |
87 (defun calc-store-power (&optional var) | |
88 (interactive) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
89 (calc-store-binary var "^" '^)) |
40785 | 90 |
91 (defun calc-store-concat (&optional var) | |
92 (interactive) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
93 (calc-store-binary var "|" '|)) |
40785 | 94 |
95 (defun calc-store-neg (n &optional var) | |
96 (interactive "p") | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
97 (calc-store-binary var "n" '/ (- n))) |
40785 | 98 |
99 (defun calc-store-inv (n &optional var) | |
100 (interactive "p") | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
101 (calc-store-binary var "&" '^ (- n))) |
40785 | 102 |
103 (defun calc-store-incr (n &optional var) | |
104 (interactive "p") | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
105 (calc-store-binary var "n" '- (- n))) |
40785 | 106 |
107 (defun calc-store-decr (n &optional var) | |
108 (interactive "p") | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
109 (calc-store-binary var "n" '- n)) |
40785 | 110 |
111 (defun calc-store-value (var value tag &optional pop) | |
112 (if var | |
113 (let ((old (calc-var-value var))) | |
114 (set var value) | |
115 (if pop (or calc-store-keep (calc-pop-stack pop))) | |
116 (calc-record-undo (list 'store (symbol-name var) old)) | |
117 (if tag | |
118 (let ((calc-full-trail-vectors nil)) | |
119 (calc-record value (format ">%s%s" tag (calc-var-name var))))) | |
120 (and (memq var '(var-e var-i var-pi var-phi var-gamma)) | |
121 (eq (car-safe old) 'special-const) | |
122 (message "(Note: Built-in definition of %s has been lost)" var)) | |
123 (and (memq var '(var-inf var-uinf var-nan)) | |
124 (null old) | |
125 (message "(Note: %s has built-in meanings which may interfere)" | |
126 var)) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
127 (calc-refresh-evaltos var)))) |
40785 | 128 |
129 (defun calc-var-name (var) | |
130 (if (symbolp var) (setq var (symbol-name var))) | |
131 (if (string-match "\\`var-." var) | |
132 (substring var 4) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
133 var)) |
40785 | 134 |
135 (defun calc-store-binary (var tag func &optional val) | |
136 (calc-wrapper | |
137 (let ((calc-simplify-mode (if (eq calc-simplify-mode 'none) | |
138 'num calc-simplify-mode)) | |
139 (value (or val (calc-top 1)))) | |
140 (or var (setq var (calc-read-var-name (format "Store %s: " tag)))) | |
141 (if var | |
142 (let ((old (calc-var-value var))) | |
143 (or old | |
144 (error "No such variable: \"%s\"" (calc-var-name var))) | |
145 (if (stringp old) | |
146 (setq old (math-read-expr old))) | |
147 (if (eq (car-safe old) 'error) | |
148 (error "Bad format in variable contents: %s" (nth 2 old))) | |
149 (calc-store-value var | |
150 (calc-normalize (if (calc-is-inverse) | |
151 (list func value old) | |
152 (list func old value))) | |
153 tag (and (not val) 1)) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
154 (message "Stored to variable \"%s\"" (calc-var-name var))))))) |
40785 | 155 |
58547
1e95f60dbab4
(calc-given-value, calc-store-opers): Declare them.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
156 (defvar calc-var-name-map nil "Keymap for reading Calc variable names.") |
1e95f60dbab4
(calc-given-value, calc-store-opers): Declare them.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
157 (if calc-var-name-map |
1e95f60dbab4
(calc-given-value, calc-store-opers): Declare them.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
158 () |
1e95f60dbab4
(calc-given-value, calc-store-opers): Declare them.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
159 (setq calc-var-name-map (copy-keymap minibuffer-local-completion-map)) |
1e95f60dbab4
(calc-given-value, calc-store-opers): Declare them.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
160 (define-key calc-var-name-map " " 'self-insert-command) |
1e95f60dbab4
(calc-given-value, calc-store-opers): Declare them.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
161 (mapcar (function |
1e95f60dbab4
(calc-given-value, calc-store-opers): Declare them.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
162 (lambda (x) |
1e95f60dbab4
(calc-given-value, calc-store-opers): Declare them.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
163 (define-key calc-var-name-map (char-to-string x) |
1e95f60dbab4
(calc-given-value, calc-store-opers): Declare them.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
164 'calcVar-digit))) |
1e95f60dbab4
(calc-given-value, calc-store-opers): Declare them.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
165 "0123456789") |
1e95f60dbab4
(calc-given-value, calc-store-opers): Declare them.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
166 (mapcar (function |
1e95f60dbab4
(calc-given-value, calc-store-opers): Declare them.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
167 (lambda (x) |
1e95f60dbab4
(calc-given-value, calc-store-opers): Declare them.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
168 (define-key calc-var-name-map (char-to-string x) |
1e95f60dbab4
(calc-given-value, calc-store-opers): Declare them.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
169 'calcVar-oper))) |
1e95f60dbab4
(calc-given-value, calc-store-opers): Declare them.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
170 "+-*/^|")) |
1e95f60dbab4
(calc-given-value, calc-store-opers): Declare them.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
171 |
1e95f60dbab4
(calc-given-value, calc-store-opers): Declare them.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
172 (defvar calc-store-opers) |
1e95f60dbab4
(calc-given-value, calc-store-opers): Declare them.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
173 |
40785 | 174 (defun calc-read-var-name (prompt &optional calc-store-opers) |
175 (setq calc-given-value nil | |
176 calc-aborted-prefix nil) | |
59090
ce01a490300d
(calc-read-var-name): Remove initial "var-" from minibuffer.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58673
diff
changeset
|
177 (let ((var (concat |
ce01a490300d
(calc-read-var-name): Remove initial "var-" from minibuffer.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58673
diff
changeset
|
178 "var-" |
ce01a490300d
(calc-read-var-name): Remove initial "var-" from minibuffer.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58673
diff
changeset
|
179 (let ((minibuffer-completion-table |
ce01a490300d
(calc-read-var-name): Remove initial "var-" from minibuffer.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58673
diff
changeset
|
180 (mapcar (lambda (x) (substring x 4)) |
ce01a490300d
(calc-read-var-name): Remove initial "var-" from minibuffer.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58673
diff
changeset
|
181 (all-completions "var-" obarray))) |
ce01a490300d
(calc-read-var-name): Remove initial "var-" from minibuffer.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58673
diff
changeset
|
182 (minibuffer-completion-predicate |
ce01a490300d
(calc-read-var-name): Remove initial "var-" from minibuffer.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58673
diff
changeset
|
183 (lambda (x) (boundp (intern (concat "var-" x))))) |
ce01a490300d
(calc-read-var-name): Remove initial "var-" from minibuffer.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58673
diff
changeset
|
184 (minibuffer-completion-confirm t)) |
ce01a490300d
(calc-read-var-name): Remove initial "var-" from minibuffer.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58673
diff
changeset
|
185 (read-from-minibuffer prompt nil calc-var-name-map nil))))) |
40785 | 186 (setq calc-aborted-prefix "") |
59090
ce01a490300d
(calc-read-var-name): Remove initial "var-" from minibuffer.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58673
diff
changeset
|
187 (and (not (equal var "var-")) |
40785 | 188 (if (string-match "\\`\\([-a-zA-Z0-9]+\\) *:?=" var) |
189 (if (null calc-given-value-flag) | |
190 (error "Assignment is not allowed in this command") | |
191 (let ((svar (intern (substring var 0 (match-end 1))))) | |
192 (setq calc-given-value-flag 0 | |
193 calc-given-value (math-read-expr | |
194 (substring var (match-end 0)))) | |
195 (if (eq (car-safe calc-given-value) 'error) | |
196 (error "Bad format: %s" (nth 2 calc-given-value))) | |
197 (setq calc-given-value (math-evaluate-expr calc-given-value)) | |
198 svar)) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
199 (intern var))))) |
40785 | 200 |
201 (defun calcVar-digit () | |
202 (interactive) | |
59265
eb45d1b6dbc3
(calcVar-digit, calcVar-oper): Remove need for "var-" at the
Jay Belanger <jay.p.belanger@gmail.com>
parents:
59211
diff
changeset
|
203 (if (calc-minibuffer-contains "\\'") |
40785 | 204 (if (eq calc-store-opers 0) |
205 (beep) | |
206 (insert "q") | |
207 (self-insert-and-exit)) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
208 (self-insert-command 1))) |
40785 | 209 |
210 (defun calcVar-oper () | |
211 (interactive) | |
212 (if (and (eq calc-store-opers t) | |
59265
eb45d1b6dbc3
(calcVar-digit, calcVar-oper): Remove need for "var-" at the
Jay Belanger <jay.p.belanger@gmail.com>
parents:
59211
diff
changeset
|
213 (calc-minibuffer-contains "\\'")) |
40785 | 214 (progn |
215 (erase-buffer) | |
216 (self-insert-and-exit)) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
217 (self-insert-command 1))) |
40785 | 218 |
219 (defun calc-store-map (&optional oper var) | |
220 (interactive) | |
221 (calc-wrapper | |
222 (let* ((sel-mode nil) | |
223 (calc-dollar-values (mapcar 'calc-get-stack-element | |
224 (nthcdr calc-stack-top calc-stack))) | |
225 (calc-dollar-used 0) | |
226 (oper (or oper (calc-get-operator "Store Mapping"))) | |
227 (nargs (car oper))) | |
228 (or var (setq var (calc-read-var-name (format "Store Mapping %s: " | |
229 (nth 2 oper))))) | |
230 (if var | |
231 (let ((old (or (calc-var-value var) | |
232 (error "No such variable: \"%s\"" | |
233 (calc-var-name var)))) | |
234 (calc-simplify-mode (if (eq calc-simplify-mode 'none) | |
235 'num calc-simplify-mode)) | |
236 (values (and (> nargs 1) | |
237 (calc-top-list (1- nargs) (1+ calc-dollar-used))))) | |
238 (message "Working...") | |
239 (calc-set-command-flag 'clear-message) | |
240 (if (stringp old) | |
241 (setq old (math-read-expr old))) | |
242 (if (eq (car-safe old) 'error) | |
243 (error "Bad format in variable contents: %s" (nth 2 old))) | |
244 (setq values (if (calc-is-inverse) | |
245 (append values (list old)) | |
246 (append (list old) values))) | |
247 (calc-store-value var | |
248 (calc-normalize (cons (nth 1 oper) values)) | |
249 (nth 2 oper) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
250 (+ calc-dollar-used (1- nargs)))))))) |
40785 | 251 |
252 (defun calc-store-exchange (&optional var) | |
253 (interactive) | |
254 (calc-wrapper | |
255 (let ((calc-given-value nil) | |
256 (calc-given-value-flag 1) | |
257 top) | |
258 (or var (setq var (calc-read-var-name "Exchange with: "))) | |
259 (if var | |
260 (let ((value (calc-var-value var))) | |
261 (or value | |
262 (error "No such variable: \"%s\"" (calc-var-name var))) | |
263 (if (eq (car-safe value) 'special-const) | |
264 (error "%s is a special constant" var)) | |
265 (setq top (or calc-given-value (calc-top 1))) | |
266 (calc-store-value var top nil) | |
267 (calc-pop-push-record calc-given-value-flag | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
268 (concat "<>" (calc-var-name var)) value)))))) |
40785 | 269 |
270 (defun calc-unstore (&optional var) | |
271 (interactive) | |
272 (calc-wrapper | |
273 (or var (setq var (calc-read-var-name "Unstore: "))) | |
274 (if var | |
275 (progn | |
276 (and (memq var '(var-e var-i var-pi var-phi var-gamma)) | |
277 (eq (car-safe (calc-var-value var)) 'special-const) | |
278 (message "(Note: Built-in definition of %s has been lost)" var)) | |
279 (if (and (boundp var) (symbol-value var)) | |
280 (message "Unstored variable \"%s\"" (calc-var-name var)) | |
281 (message "Variable \"%s\" remains unstored" (calc-var-name var))) | |
282 (makunbound var) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
283 (calc-refresh-evaltos var))))) |
40785 | 284 |
285 (defun calc-let (&optional var) | |
286 (interactive) | |
287 (calc-wrapper | |
288 (let* ((calc-given-value nil) | |
289 (calc-given-value-flag 1) | |
290 thing value) | |
291 (or var (setq var (calc-read-var-name "Let variable: "))) | |
292 (if calc-given-value | |
293 (setq value calc-given-value | |
294 thing (calc-top 1)) | |
295 (setq value (calc-top 1) | |
296 thing (calc-top 2))) | |
297 (setq var (if var | |
298 (list (cons var value)) | |
299 (calc-is-assignments value))) | |
300 (if var | |
301 (calc-pop-push-record | |
302 (1+ calc-given-value-flag) | |
303 (concat "=" (calc-var-name (car (car var)))) | |
304 (let ((saved-val (mapcar (function | |
305 (lambda (v) | |
306 (and (boundp (car v)) | |
307 (symbol-value (car v))))) | |
308 var))) | |
309 (unwind-protect | |
310 (let ((vv var)) | |
311 (while vv | |
312 (set (car (car vv)) (calc-normalize (cdr (car vv)))) | |
313 (calc-refresh-evaltos (car (car vv))) | |
314 (setq vv (cdr vv))) | |
315 (math-evaluate-expr thing)) | |
316 (while saved-val | |
317 (if (car saved-val) | |
318 (set (car (car var)) (car saved-val)) | |
319 (makunbound (car (car var)))) | |
320 (setq saved-val (cdr saved-val) | |
321 var (cdr var))) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
322 (calc-handle-whys)))))))) |
40785 | 323 |
324 (defun calc-is-assignments (value) | |
325 (if (memq (car-safe value) '(calcFunc-eq calcFunc-assign)) | |
326 (and (eq (car-safe (nth 1 value)) 'var) | |
327 (list (cons (nth 2 (nth 1 value)) (nth 2 value)))) | |
328 (if (eq (car-safe value) 'vec) | |
329 (let ((vv nil)) | |
330 (while (and (setq value (cdr value)) | |
331 (memq (car-safe (car value)) | |
332 '(calcFunc-eq calcFunc-assign)) | |
333 (eq (car-safe (nth 1 (car value))) 'var)) | |
334 (setq vv (cons (cons (nth 2 (nth 1 (car value))) | |
335 (nth 2 (car value))) | |
336 vv))) | |
337 (and (not value) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
338 vv))))) |
40785 | 339 |
340 (defun calc-recall (&optional var) | |
341 (interactive) | |
342 (calc-wrapper | |
343 (or var (setq var (calc-read-var-name "Recall: "))) | |
344 (if var | |
345 (let ((value (calc-var-value var))) | |
346 (or value | |
347 (error "No such variable: \"%s\"" (calc-var-name var))) | |
348 (if (stringp value) | |
349 (setq value (math-read-expr value))) | |
350 (if (eq (car-safe value) 'error) | |
351 (error "Bad format in variable contents: %s" (nth 2 value))) | |
352 (setq value (calc-normalize value)) | |
353 (let ((calc-full-trail-vectors nil)) | |
354 (calc-record value (concat "<" (calc-var-name var)))) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
355 (calc-push value))))) |
40785 | 356 |
357 (defun calc-store-quick () | |
358 (interactive) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
359 (calc-store (intern (format "var-q%c" last-command-char)))) |
40785 | 360 |
361 (defun calc-store-into-quick () | |
362 (interactive) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
363 (calc-store-into (intern (format "var-q%c" last-command-char)))) |
40785 | 364 |
365 (defun calc-recall-quick () | |
366 (interactive) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
367 (calc-recall (intern (format "var-q%c" last-command-char)))) |
40785 | 368 |
369 (defun calc-copy-variable (&optional var1 var2) | |
370 (interactive) | |
371 (calc-wrapper | |
372 (or var1 (setq var1 (calc-read-var-name "Copy variable: "))) | |
373 (if var1 | |
374 (let ((value (calc-var-value var1))) | |
375 (or value | |
59211
999144478c9a
(calc-copy-variable): Fix mistyped variable name. Display variable
Jay Belanger <jay.p.belanger@gmail.com>
parents:
59090
diff
changeset
|
376 (error "No such variable: \"%s\"" (calc-var-name var1))) |
40785 | 377 (or var2 (setq var2 (calc-read-var-name |
59211
999144478c9a
(calc-copy-variable): Fix mistyped variable name. Display variable
Jay Belanger <jay.p.belanger@gmail.com>
parents:
59090
diff
changeset
|
378 (format "Copy variable: %s, to: " |
999144478c9a
(calc-copy-variable): Fix mistyped variable name. Display variable
Jay Belanger <jay.p.belanger@gmail.com>
parents:
59090
diff
changeset
|
379 (calc-var-name var1))))) |
40785 | 380 (if var2 |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
381 (calc-store-value var2 value "")))))) |
40785 | 382 |
41271
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
383 (defvar calc-last-edited-variable nil) |
40785 | 384 (defun calc-edit-variable (&optional var) |
385 (interactive) | |
386 (calc-wrapper | |
387 (or var (setq var (calc-read-var-name | |
388 (if calc-last-edited-variable | |
389 (format "Edit: (default %s) " | |
390 (calc-var-name calc-last-edited-variable)) | |
391 "Edit: ")))) | |
392 (or var (setq var calc-last-edited-variable)) | |
393 (if var | |
394 (let* ((value (calc-var-value var))) | |
395 (if (eq (car-safe value) 'special-const) | |
396 (error "%s is a special constant" var)) | |
397 (setq calc-last-edited-variable var) | |
398 (calc-edit-mode (list 'calc-finish-stack-edit (list 'quote var)) | |
399 t | |
59299
b851b98f8dc1
(calc-edit-variable): Change title to match new header.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
59265
diff
changeset
|
400 (concat "Editing variable `" (calc-var-name var) "'. ")) |
40785 | 401 (and value |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
402 (insert (math-format-nice-expr value (frame-width)) "\n"))))) |
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
403 (calc-show-edit-buffer)) |
40785 | 404 |
405 (defun calc-edit-Decls () | |
406 (interactive) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
407 (calc-edit-variable 'var-Decls)) |
40785 | 408 |
409 (defun calc-edit-EvalRules () | |
410 (interactive) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
411 (calc-edit-variable 'var-EvalRules)) |
40785 | 412 |
413 (defun calc-edit-FitRules () | |
414 (interactive) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
415 (calc-edit-variable 'var-FitRules)) |
40785 | 416 |
417 (defun calc-edit-GenCount () | |
418 (interactive) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
419 (calc-edit-variable 'var-GenCount)) |
40785 | 420 |
421 (defun calc-edit-Holidays () | |
422 (interactive) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
423 (calc-edit-variable 'var-Holidays)) |
40785 | 424 |
425 (defun calc-edit-IntegLimit () | |
426 (interactive) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
427 (calc-edit-variable 'var-IntegLimit)) |
40785 | 428 |
429 (defun calc-edit-LineStyles () | |
430 (interactive) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
431 (calc-edit-variable 'var-LineStyles)) |
40785 | 432 |
433 (defun calc-edit-PointStyles () | |
434 (interactive) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
435 (calc-edit-variable 'var-PointStyles)) |
40785 | 436 |
437 (defun calc-edit-PlotRejects () | |
438 (interactive) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
439 (calc-edit-variable 'var-PlotRejects)) |
40785 | 440 |
441 (defun calc-edit-AlgSimpRules () | |
442 (interactive) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
443 (calc-edit-variable 'var-AlgSimpRules)) |
40785 | 444 |
445 (defun calc-edit-TimeZone () | |
446 (interactive) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
447 (calc-edit-variable 'var-TimeZone)) |
40785 | 448 |
449 (defun calc-edit-Units () | |
450 (interactive) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
451 (calc-edit-variable 'var-Units)) |
40785 | 452 |
453 (defun calc-edit-ExtSimpRules () | |
454 (interactive) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
455 (calc-edit-variable 'var-ExtSimpRules)) |
40785 | 456 |
457 (defun calc-declare-variable (&optional var) | |
458 (interactive) | |
459 (calc-wrapper | |
460 (or var (setq var (calc-read-var-name "Declare: " 0))) | |
461 (or var (setq var 'var-All)) | |
462 (let* (dp decl def row rp) | |
463 (or (and (calc-var-value 'var-Decls) | |
464 (eq (car-safe var-Decls) 'vec)) | |
465 (setq var-Decls (list 'vec))) | |
466 (setq dp var-Decls) | |
467 (while (and (setq dp (cdr dp)) | |
468 (or (not (eq (car-safe (car dp)) 'vec)) | |
469 (/= (length (car dp)) 3) | |
470 (progn | |
471 (setq row (nth 1 (car dp)) | |
472 rp row) | |
473 (if (eq (car-safe row) 'vec) | |
474 (progn | |
475 (while | |
476 (and (setq rp (cdr rp)) | |
477 (or (not (eq (car-safe (car rp)) 'var)) | |
478 (not (eq (nth 2 (car rp)) var))))) | |
479 (setq rp (car rp))) | |
480 (if (or (not (eq (car-safe row) 'var)) | |
481 (not (eq (nth 2 row) var))) | |
482 (setq rp nil))) | |
483 (not rp))))) | |
484 (calc-unread-command ?\C-a) | |
485 (setq decl (read-string (format "Declare: %s to be: " var) | |
486 (and rp | |
487 (math-format-flat-expr (nth 2 (car dp)) 0)))) | |
488 (setq decl (and (string-match "[^ \t]" decl) | |
489 (math-read-exprs decl))) | |
490 (if (eq (car-safe decl) 'error) | |
491 (error "Bad format in declaration: %s" (nth 2 decl))) | |
492 (if (cdr decl) | |
493 (setq decl (cons 'vec decl)) | |
494 (setq decl (car decl))) | |
495 (and (eq (car-safe decl) 'vec) | |
496 (= (length decl) 2) | |
497 (setq decl (nth 1 decl))) | |
498 (calc-record (append '(vec) (list (math-build-var-name var)) | |
499 (and decl (list decl))) | |
500 "decl") | |
501 (setq var-Decls (copy-sequence var-Decls)) | |
502 (if (eq (car-safe row) 'vec) | |
503 (progn | |
504 (setcdr row (delq rp (cdr row))) | |
505 (or (cdr row) | |
506 (setq var-Decls (delq (car dp) var-Decls)))) | |
507 (setq var-Decls (delq (car dp) var-Decls))) | |
508 (if decl | |
509 (progn | |
510 (setq dp (and (not (eq var 'var-All)) var-Decls)) | |
511 (while (and (setq dp (cdr dp)) | |
512 (or (not (eq (car-safe (car dp)) 'vec)) | |
513 (/= (length (car dp)) 3) | |
514 (not (equal (nth 2 (car dp)) decl))))) | |
515 (if dp | |
516 (setcar (cdr (car dp)) | |
517 (append (if (eq (car-safe (nth 1 (car dp))) 'vec) | |
518 (nth 1 (car dp)) | |
519 (list 'vec (nth 1 (car dp)))) | |
520 (list (math-build-var-name var)))) | |
521 (setq var-Decls (append var-Decls | |
522 (list (list 'vec | |
523 (math-build-var-name var) | |
524 decl))))))) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
525 (calc-refresh-evaltos 'var-Decls)))) |
40785 | 526 |
41271
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
527 (defvar calc-dont-insert-variables '(var-FitRules var-FactorRules |
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
528 var-CommuteRules var-JumpRules |
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
529 var-DistribRules var-MergeRules |
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
530 var-NegateRules var-InvertRules |
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
531 var-IntegAfterRules |
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
532 var-TimeZone var-PlotRejects |
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
533 var-PlotData1 var-PlotData2 |
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
534 var-PlotData3 var-PlotData4 |
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
535 var-PlotData5 var-PlotData6 |
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
536 var-DUMMY)) |
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
537 |
58547
1e95f60dbab4
(calc-given-value, calc-store-opers): Declare them.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
538 ;; The variable calc-pv-pos is local to calc-permanent-variable, but |
1e95f60dbab4
(calc-given-value, calc-store-opers): Declare them.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
539 ;; used by calc-insert-permanent-variable, which is called by |
1e95f60dbab4
(calc-given-value, calc-store-opers): Declare them.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
540 ;; calc-permanent-variable. |
1e95f60dbab4
(calc-given-value, calc-store-opers): Declare them.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
541 (defvar calc-pv-pos) |
1e95f60dbab4
(calc-given-value, calc-store-opers): Declare them.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
542 |
40785 | 543 (defun calc-permanent-variable (&optional var) |
544 (interactive) | |
545 (calc-wrapper | |
546 (or var (setq var (calc-read-var-name "Save variable (default=all): "))) | |
58547
1e95f60dbab4
(calc-given-value, calc-store-opers): Declare them.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
547 (let (calc-pv-pos) |
40785 | 548 (and var (or (and (boundp var) (symbol-value var)) |
549 (error "No such variable"))) | |
550 (set-buffer (find-file-noselect (substitute-in-file-name | |
551 calc-settings-file))) | |
552 (if var | |
553 (calc-insert-permanent-variable var) | |
554 (mapatoms (function | |
555 (lambda (x) | |
556 (and (string-match "\\`var-" (symbol-name x)) | |
557 (not (memq x calc-dont-insert-variables)) | |
558 (calc-var-value x) | |
559 (not (eq (car-safe (symbol-value x)) 'special-const)) | |
560 (calc-insert-permanent-variable x)))))) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
561 (save-buffer)))) |
41271
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
562 |
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
563 |
40785 | 564 |
565 (defun calc-insert-permanent-variable (var) | |
566 (goto-char (point-min)) | |
567 (if (search-forward (concat "(setq " (symbol-name var) " '") nil t) | |
568 (progn | |
58547
1e95f60dbab4
(calc-given-value, calc-store-opers): Declare them.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
569 (setq calc-pv-pos (point-marker)) |
40785 | 570 (forward-line -1) |
571 (if (looking-at ";;; Variable .* stored by Calc on ") | |
572 (progn | |
573 (delete-region (match-end 0) (progn (end-of-line) (point))) | |
574 (insert (current-time-string)))) | |
58547
1e95f60dbab4
(calc-given-value, calc-store-opers): Declare them.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
575 (goto-char (- calc-pv-pos 8 (length (symbol-name var)))) |
40785 | 576 (forward-sexp 1) |
577 (backward-char 1) | |
58547
1e95f60dbab4
(calc-given-value, calc-store-opers): Declare them.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
578 (delete-region calc-pv-pos (point))) |
40785 | 579 (goto-char (point-max)) |
580 (insert "\n;;; Variable \"" | |
581 (symbol-name var) | |
582 "\" stored by Calc on " | |
583 (current-time-string) | |
584 "\n(setq " | |
585 (symbol-name var) | |
586 " ')\n") | |
587 (backward-char 2)) | |
588 (insert (prin1-to-string (calc-var-value var))) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
589 (forward-line 1)) |
40785 | 590 |
591 (defun calc-insert-variables (buf) | |
592 (interactive "bBuffer in which to save variable values: ") | |
593 (save-excursion | |
594 (set-buffer buf) | |
595 (mapatoms (function | |
596 (lambda (x) | |
597 (and (string-match "\\`var-" (symbol-name x)) | |
598 (not (memq x calc-dont-insert-variables)) | |
599 (calc-var-value x) | |
600 (not (eq (car-safe (symbol-value x)) 'special-const)) | |
601 (or (not (eq x 'var-Decls)) | |
602 (not (equal var-Decls '(vec)))) | |
603 (or (not (eq x 'var-Holidays)) | |
604 (not (equal var-Holidays '(vec (var sat var-sat) | |
605 (var sun var-sun))))) | |
606 (insert "(setq " | |
607 (symbol-name x) | |
608 " " | |
609 (prin1-to-string | |
610 (let ((calc-language | |
611 (if (memq calc-language '(nil big)) | |
612 'flat | |
613 calc-language))) | |
614 (math-format-value (symbol-value x) 100000))) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
615 ")\n"))))))) |
40785 | 616 |
617 (defun calc-assign (arg) | |
618 (interactive "P") | |
619 (calc-slow-wrapper | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
620 (calc-binary-op ":=" 'calcFunc-assign arg))) |
40785 | 621 |
622 (defun calc-evalto (arg) | |
623 (interactive "P") | |
624 (calc-slow-wrapper | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
625 (calc-unary-op "=>" 'calcFunc-evalto arg))) |
40785 | 626 |
627 (defun calc-subscript (arg) | |
628 (interactive "P") | |
629 (calc-slow-wrapper | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
630 (calc-binary-op "sub" 'calcFunc-subscr arg))) |
40785 | 631 |
58673
202eaef4ca19
Add a provide statement.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58547
diff
changeset
|
632 (provide 'calc-store) |
202eaef4ca19
Add a provide statement.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58547
diff
changeset
|
633 |
52401 | 634 ;;; arch-tag: 2fbfec82-a521-42ca-bcd8-4f254ae6313e |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
635 ;;; calc-store.el ends here |