Commit | Line | Data |
---|---|---|
3132f345 CW |
1 | ;;; calc-store.el --- value storage functions for Calc |
2 | ||
58ba2f8f | 3 | ;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, |
114f9c96 | 4 | ;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. |
3132f345 CW |
5 | |
6 | ;; Author: David Gillespie <daveg@synaptics.com> | |
e8fff8ed | 7 | ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> |
136211a9 EZ |
8 | |
9 | ;; This file is part of GNU Emacs. | |
10 | ||
662c9c64 | 11 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
7c671b23 | 12 | ;; it under the terms of the GNU General Public License as published by |
662c9c64 GM |
13 | ;; the Free Software Foundation, either version 3 of the License, or |
14 | ;; (at your option) any later version. | |
7c671b23 | 15 | |
136211a9 | 16 | ;; GNU Emacs is distributed in the hope that it will be useful, |
7c671b23 GM |
17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 | ;; GNU General Public License for more details. | |
20 | ||
21 | ;; You should have received a copy of the GNU General Public License | |
662c9c64 | 22 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
136211a9 | 23 | |
3132f345 | 24 | ;;; Commentary: |
136211a9 | 25 | |
3132f345 | 26 | ;;; Code: |
136211a9 EZ |
27 | |
28 | ;; This file is autoloaded from calc-ext.el. | |
136211a9 | 29 | |
4b02a252 | 30 | (require 'calc-ext) |
136211a9 EZ |
31 | (require 'calc-macs) |
32 | ||
136211a9 EZ |
33 | ;;; Memory commands. |
34 | ||
3132f345 | 35 | (defvar calc-store-keep nil) |
136211a9 EZ |
36 | (defun calc-store (&optional var) |
37 | (interactive) | |
38 | (let ((calc-store-keep t)) | |
bf77c646 | 39 | (calc-store-into var))) |
136211a9 | 40 | |
3132f345 | 41 | (defvar calc-given-value-flag nil) |
3a7a4adb JB |
42 | (defvar calc-given-value) |
43 | ||
136211a9 EZ |
44 | (defun calc-store-into (&optional var) |
45 | (interactive) | |
46 | (calc-wrapper | |
47 | (let ((calc-given-value nil) | |
48 | (calc-given-value-flag 1)) | |
49 | (or var (setq var (calc-read-var-name "Store: " t))) | |
50 | (if var | |
51 | (let ((found (assq var '( ( + . calc-store-plus ) | |
52 | ( - . calc-store-minus ) | |
53 | ( * . calc-store-times ) | |
54 | ( / . calc-store-div ) | |
55 | ( ^ . calc-store-power ) | |
56 | ( | . calc-store-concat ) )))) | |
57 | (if found | |
58 | (funcall (cdr found)) | |
0dc72b8e JB |
59 | (let ((msg |
60 | (calc-store-value var (or calc-given-value (calc-top 1)) | |
61 | "" calc-given-value-flag))) | |
62 | (message (concat "Stored to variable \"%s\"" msg) | |
63 | (calc-var-name var))))) | |
136211a9 EZ |
64 | (setq var (calc-is-assignments (calc-top 1))) |
65 | (if var | |
66 | (while var | |
0dc72b8e JB |
67 | (let ((msg |
68 | (calc-store-value (car (car var)) (cdr (car var)) | |
69 | (if (not (cdr var)) "") | |
70 | (if (not (cdr var)) 1)))) | |
71 | (message (concat "Stored to variable \"%s\"" msg) | |
970dd012 | 72 | (calc-var-name (car (car var))))) |
bf77c646 | 73 | (setq var (cdr var)))))))) |
136211a9 EZ |
74 | |
75 | (defun calc-store-plus (&optional var) | |
76 | (interactive) | |
bf77c646 | 77 | (calc-store-binary var "+" '+)) |
136211a9 EZ |
78 | |
79 | (defun calc-store-minus (&optional var) | |
80 | (interactive) | |
bf77c646 | 81 | (calc-store-binary var "-" '-)) |
136211a9 EZ |
82 | |
83 | (defun calc-store-times (&optional var) | |
84 | (interactive) | |
bf77c646 | 85 | (calc-store-binary var "*" '*)) |
136211a9 EZ |
86 | |
87 | (defun calc-store-div (&optional var) | |
88 | (interactive) | |
bf77c646 | 89 | (calc-store-binary var "/" '/)) |
136211a9 EZ |
90 | |
91 | (defun calc-store-power (&optional var) | |
92 | (interactive) | |
bf77c646 | 93 | (calc-store-binary var "^" '^)) |
136211a9 EZ |
94 | |
95 | (defun calc-store-concat (&optional var) | |
96 | (interactive) | |
bf77c646 | 97 | (calc-store-binary var "|" '|)) |
136211a9 EZ |
98 | |
99 | (defun calc-store-neg (n &optional var) | |
100 | (interactive "p") | |
bf77c646 | 101 | (calc-store-binary var "n" '/ (- n))) |
136211a9 EZ |
102 | |
103 | (defun calc-store-inv (n &optional var) | |
104 | (interactive "p") | |
bf77c646 | 105 | (calc-store-binary var "&" '^ (- n))) |
136211a9 EZ |
106 | |
107 | (defun calc-store-incr (n &optional var) | |
108 | (interactive "p") | |
bf77c646 | 109 | (calc-store-binary var "n" '- (- n))) |
136211a9 EZ |
110 | |
111 | (defun calc-store-decr (n &optional var) | |
112 | (interactive "p") | |
bf77c646 | 113 | (calc-store-binary var "n" '- n)) |
136211a9 EZ |
114 | |
115 | (defun calc-store-value (var value tag &optional pop) | |
0dc72b8e JB |
116 | (let ((msg "")) |
117 | (if var | |
118 | (let ((old (calc-var-value var))) | |
119 | (set var value) | |
120 | (if pop (or calc-store-keep (calc-pop-stack pop))) | |
121 | (calc-record-undo (list 'store (symbol-name var) old)) | |
122 | (if tag | |
123 | (let ((calc-full-trail-vectors nil)) | |
124 | (calc-record value (format ">%s%s" tag (calc-var-name var))))) | |
125 | (cond | |
126 | ((and (memq var '(var-e var-i var-pi var-phi var-gamma)) | |
127 | (eq (car-safe old) 'special-const)) | |
19449d1d | 128 | (setq msg (format " (Note: Built-in definition of %s has been lost)" |
0dc72b8e JB |
129 | (calc-var-name var)))) |
130 | ((and (memq var '(var-inf var-uinf var-nan)) | |
131 | (null old)) | |
132 | (setq msg (format " (Note: %s has built-in meanings which may interfere)" | |
133 | (calc-var-name var))))) | |
134 | (calc-refresh-evaltos var))) | |
135 | msg)) | |
136211a9 EZ |
136 | |
137 | (defun calc-var-name (var) | |
138 | (if (symbolp var) (setq var (symbol-name var))) | |
139 | (if (string-match "\\`var-." var) | |
140 | (substring var 4) | |
bf77c646 | 141 | var)) |
136211a9 EZ |
142 | |
143 | (defun calc-store-binary (var tag func &optional val) | |
144 | (calc-wrapper | |
145 | (let ((calc-simplify-mode (if (eq calc-simplify-mode 'none) | |
146 | 'num calc-simplify-mode)) | |
147 | (value (or val (calc-top 1)))) | |
148 | (or var (setq var (calc-read-var-name (format "Store %s: " tag)))) | |
149 | (if var | |
150 | (let ((old (calc-var-value var))) | |
0dc72b8e JB |
151 | (if (eq (car-safe old) 'special-const) |
152 | (error "\"%s\" is a special constant" (calc-var-name var))) | |
153 | (if (not old) | |
154 | (if (memq var '(var-inf var-uinf var-nan)) | |
155 | (error "\"%s\" is a special variable" (calc-var-name var)) | |
156 | (error "No such variable: \"%s\"" (calc-var-name var)))) | |
136211a9 EZ |
157 | (if (stringp old) |
158 | (setq old (math-read-expr old))) | |
159 | (if (eq (car-safe old) 'error) | |
160 | (error "Bad format in variable contents: %s" (nth 2 old))) | |
161 | (calc-store-value var | |
162 | (calc-normalize (if (calc-is-inverse) | |
163 | (list func value old) | |
164 | (list func old value))) | |
165 | tag (and (not val) 1)) | |
0dc72b8e | 166 | (message "Variable \"%s\" changed" (calc-var-name var))))))) |
136211a9 | 167 | |
3a7a4adb JB |
168 | (defvar calc-var-name-map nil "Keymap for reading Calc variable names.") |
169 | (if calc-var-name-map | |
170 | () | |
171 | (setq calc-var-name-map (copy-keymap minibuffer-local-completion-map)) | |
172 | (define-key calc-var-name-map " " 'self-insert-command) | |
19449d1d JB |
173 | (mapc (function |
174 | (lambda (x) | |
175 | (define-key calc-var-name-map (char-to-string x) | |
176 | 'calcVar-digit))) | |
177 | "0123456789") | |
178 | (mapc (function | |
179 | (lambda (x) | |
180 | (define-key calc-var-name-map (char-to-string x) | |
181 | 'calcVar-oper))) | |
182 | "+-*/^|")) | |
3a7a4adb JB |
183 | |
184 | (defvar calc-store-opers) | |
185 | ||
6a1414ce JB |
186 | (defvar calc-read-var-name-history nil |
187 | "History for reading variable names.") | |
188 | ||
136211a9 EZ |
189 | (defun calc-read-var-name (prompt &optional calc-store-opers) |
190 | (setq calc-given-value nil | |
191 | calc-aborted-prefix nil) | |
19449d1d | 192 | (let ((var (concat |
8cdb7a17 JB |
193 | "var-" |
194 | (let ((minibuffer-completion-table | |
19449d1d | 195 | (mapcar (lambda (x) (substring x 4)) |
8cdb7a17 | 196 | (all-completions "var-" obarray))) |
19449d1d | 197 | (minibuffer-completion-predicate |
8cdb7a17 JB |
198 | (lambda (x) (boundp (intern (concat "var-" x))))) |
199 | (minibuffer-completion-confirm t)) | |
6a1414ce JB |
200 | (read-from-minibuffer |
201 | prompt nil calc-var-name-map nil | |
202 | 'calc-read-var-name-history))))) | |
136211a9 | 203 | (setq calc-aborted-prefix "") |
8cdb7a17 | 204 | (and (not (equal var "var-")) |
ae6bc504 | 205 | (if (string-match "\\`\\([-a-zA-Zα-ωΑ-Ω0-9]+\\) *:?=" var) |
136211a9 EZ |
206 | (if (null calc-given-value-flag) |
207 | (error "Assignment is not allowed in this command") | |
208 | (let ((svar (intern (substring var 0 (match-end 1))))) | |
209 | (setq calc-given-value-flag 0 | |
210 | calc-given-value (math-read-expr | |
211 | (substring var (match-end 0)))) | |
212 | (if (eq (car-safe calc-given-value) 'error) | |
213 | (error "Bad format: %s" (nth 2 calc-given-value))) | |
214 | (setq calc-given-value (math-evaluate-expr calc-given-value)) | |
215 | svar)) | |
bf77c646 | 216 | (intern var))))) |
136211a9 | 217 | |
136211a9 EZ |
218 | (defun calcVar-digit () |
219 | (interactive) | |
4a74dd94 | 220 | (if (calc-minibuffer-contains "\\'") |
136211a9 EZ |
221 | (if (eq calc-store-opers 0) |
222 | (beep) | |
223 | (insert "q") | |
224 | (self-insert-and-exit)) | |
bf77c646 | 225 | (self-insert-command 1))) |
136211a9 EZ |
226 | |
227 | (defun calcVar-oper () | |
228 | (interactive) | |
229 | (if (and (eq calc-store-opers t) | |
4a74dd94 | 230 | (calc-minibuffer-contains "\\'")) |
136211a9 EZ |
231 | (progn |
232 | (erase-buffer) | |
233 | (self-insert-and-exit)) | |
bf77c646 | 234 | (self-insert-command 1))) |
136211a9 EZ |
235 | |
236 | (defun calc-store-map (&optional oper var) | |
237 | (interactive) | |
238 | (calc-wrapper | |
239 | (let* ((sel-mode nil) | |
240 | (calc-dollar-values (mapcar 'calc-get-stack-element | |
241 | (nthcdr calc-stack-top calc-stack))) | |
242 | (calc-dollar-used 0) | |
243 | (oper (or oper (calc-get-operator "Store Mapping"))) | |
244 | (nargs (car oper))) | |
245 | (or var (setq var (calc-read-var-name (format "Store Mapping %s: " | |
246 | (nth 2 oper))))) | |
247 | (if var | |
0dc72b8e JB |
248 | (let ((old (calc-var-value var))) |
249 | (if (eq (car-safe old) 'special-const) | |
250 | (error "\"%s\" is a special constant" (calc-var-name var))) | |
251 | (if (not old) | |
252 | (if (memq var '(var-inf var-uinf var-nan)) | |
253 | (error "\"%s\" is a special variable" (calc-var-name var)) | |
254 | (error "No such variable: \"%s\"" (calc-var-name var)))) | |
255 | (let ((calc-simplify-mode (if (eq calc-simplify-mode 'none) | |
256 | 'num calc-simplify-mode)) | |
257 | (values (and (> nargs 1) | |
258 | (calc-top-list (1- nargs) (1+ calc-dollar-used))))) | |
259 | (message "Working...") | |
260 | (calc-set-command-flag 'clear-message) | |
261 | (if (stringp old) | |
262 | (setq old (math-read-expr old))) | |
263 | (if (eq (car-safe old) 'error) | |
264 | (error "Bad format in variable contents: %s" (nth 2 old))) | |
265 | (setq values (if (calc-is-inverse) | |
266 | (append values (list old)) | |
267 | (append (list old) values))) | |
268 | (calc-store-value var | |
269 | (calc-normalize (cons (nth 1 oper) values)) | |
270 | (nth 2 oper) | |
271 | (+ calc-dollar-used (1- nargs))) | |
272 | (message "Variable \"%s\" changed" (calc-var-name var)))))))) | |
273 | ||
136211a9 EZ |
274 | |
275 | (defun calc-store-exchange (&optional var) | |
276 | (interactive) | |
277 | (calc-wrapper | |
278 | (let ((calc-given-value nil) | |
279 | (calc-given-value-flag 1) | |
280 | top) | |
281 | (or var (setq var (calc-read-var-name "Exchange with: "))) | |
282 | (if var | |
283 | (let ((value (calc-var-value var))) | |
136211a9 | 284 | (if (eq (car-safe value) 'special-const) |
0dc72b8e JB |
285 | (error "\"%s\" is a special constant" (calc-var-name var))) |
286 | (if (not value) | |
287 | (if (memq var '(var-inf var-uinf var-nan)) | |
288 | (error "\"%s\" is a special variable" (calc-var-name var)) | |
289 | (error "No such variable: \"%s\"" (calc-var-name var)))) | |
136211a9 EZ |
290 | (setq top (or calc-given-value (calc-top 1))) |
291 | (calc-store-value var top nil) | |
292 | (calc-pop-push-record calc-given-value-flag | |
bf77c646 | 293 | (concat "<>" (calc-var-name var)) value)))))) |
136211a9 EZ |
294 | |
295 | (defun calc-unstore (&optional var) | |
296 | (interactive) | |
297 | (calc-wrapper | |
298 | (or var (setq var (calc-read-var-name "Unstore: "))) | |
299 | (if var | |
300 | (progn | |
301 | (and (memq var '(var-e var-i var-pi var-phi var-gamma)) | |
302 | (eq (car-safe (calc-var-value var)) 'special-const) | |
303 | (message "(Note: Built-in definition of %s has been lost)" var)) | |
304 | (if (and (boundp var) (symbol-value var)) | |
305 | (message "Unstored variable \"%s\"" (calc-var-name var)) | |
306 | (message "Variable \"%s\" remains unstored" (calc-var-name var))) | |
307 | (makunbound var) | |
bf77c646 | 308 | (calc-refresh-evaltos var))))) |
136211a9 EZ |
309 | |
310 | (defun calc-let (&optional var) | |
311 | (interactive) | |
312 | (calc-wrapper | |
313 | (let* ((calc-given-value nil) | |
314 | (calc-given-value-flag 1) | |
315 | thing value) | |
316 | (or var (setq var (calc-read-var-name "Let variable: "))) | |
317 | (if calc-given-value | |
318 | (setq value calc-given-value | |
319 | thing (calc-top 1)) | |
320 | (setq value (calc-top 1) | |
321 | thing (calc-top 2))) | |
322 | (setq var (if var | |
323 | (list (cons var value)) | |
324 | (calc-is-assignments value))) | |
325 | (if var | |
326 | (calc-pop-push-record | |
327 | (1+ calc-given-value-flag) | |
328 | (concat "=" (calc-var-name (car (car var)))) | |
329 | (let ((saved-val (mapcar (function | |
330 | (lambda (v) | |
331 | (and (boundp (car v)) | |
332 | (symbol-value (car v))))) | |
333 | var))) | |
334 | (unwind-protect | |
335 | (let ((vv var)) | |
336 | (while vv | |
337 | (set (car (car vv)) (calc-normalize (cdr (car vv)))) | |
338 | (calc-refresh-evaltos (car (car vv))) | |
339 | (setq vv (cdr vv))) | |
340 | (math-evaluate-expr thing)) | |
341 | (while saved-val | |
342 | (if (car saved-val) | |
343 | (set (car (car var)) (car saved-val)) | |
344 | (makunbound (car (car var)))) | |
345 | (setq saved-val (cdr saved-val) | |
346 | var (cdr var))) | |
bf77c646 | 347 | (calc-handle-whys)))))))) |
136211a9 EZ |
348 | |
349 | (defun calc-is-assignments (value) | |
350 | (if (memq (car-safe value) '(calcFunc-eq calcFunc-assign)) | |
351 | (and (eq (car-safe (nth 1 value)) 'var) | |
352 | (list (cons (nth 2 (nth 1 value)) (nth 2 value)))) | |
353 | (if (eq (car-safe value) 'vec) | |
354 | (let ((vv nil)) | |
355 | (while (and (setq value (cdr value)) | |
356 | (memq (car-safe (car value)) | |
357 | '(calcFunc-eq calcFunc-assign)) | |
358 | (eq (car-safe (nth 1 (car value))) 'var)) | |
359 | (setq vv (cons (cons (nth 2 (nth 1 (car value))) | |
360 | (nth 2 (car value))) | |
361 | vv))) | |
362 | (and (not value) | |
bf77c646 | 363 | vv))))) |
136211a9 EZ |
364 | |
365 | (defun calc-recall (&optional var) | |
366 | (interactive) | |
367 | (calc-wrapper | |
368 | (or var (setq var (calc-read-var-name "Recall: "))) | |
369 | (if var | |
370 | (let ((value (calc-var-value var))) | |
371 | (or value | |
372 | (error "No such variable: \"%s\"" (calc-var-name var))) | |
373 | (if (stringp value) | |
374 | (setq value (math-read-expr value))) | |
375 | (if (eq (car-safe value) 'error) | |
376 | (error "Bad format in variable contents: %s" (nth 2 value))) | |
377 | (setq value (calc-normalize value)) | |
378 | (let ((calc-full-trail-vectors nil)) | |
379 | (calc-record value (concat "<" (calc-var-name var)))) | |
bf77c646 | 380 | (calc-push value))))) |
136211a9 EZ |
381 | |
382 | (defun calc-store-quick () | |
383 | (interactive) | |
e93c003e | 384 | (calc-store (intern (format "var-q%c" last-command-event)))) |
136211a9 EZ |
385 | |
386 | (defun calc-store-into-quick () | |
387 | (interactive) | |
e93c003e | 388 | (calc-store-into (intern (format "var-q%c" last-command-event)))) |
136211a9 EZ |
389 | |
390 | (defun calc-recall-quick () | |
391 | (interactive) | |
e93c003e | 392 | (calc-recall (intern (format "var-q%c" last-command-event)))) |
136211a9 | 393 | |
04587c6e JB |
394 | (defun calc-copy-special-constant (&optional sconst var) |
395 | (interactive) | |
396 | (let ((sc '(("") | |
397 | ("e" . (special-const (math-e))) | |
398 | ("pi" . (special-const (math-pi))) | |
399 | ("i" . (special-const (math-imaginary 1))) | |
400 | ("phi" . (special-const (math-phi))) | |
401 | ("gamma" . (special-const (math-gamma-const)))))) | |
402 | (calc-wrapper | |
403 | (or sconst (setq sconst (completing-read "Special constant: " sc nil t))) | |
404 | (unless (string= sconst "") | |
405 | (let ((value (cdr (assoc sconst sc)))) | |
406 | (or var (setq var (calc-read-var-name | |
19449d1d | 407 | (format "Copy special constant %s, to: " |
04587c6e JB |
408 | sconst)))) |
409 | (if var | |
410 | (let ((msg (calc-store-value var value ""))) | |
411 | (message (concat "Special constant \"%s\" copied to \"%s\"" msg) | |
412 | sconst (calc-var-name var))))))))) | |
413 | ||
136211a9 EZ |
414 | (defun calc-copy-variable (&optional var1 var2) |
415 | (interactive) | |
416 | (calc-wrapper | |
417 | (or var1 (setq var1 (calc-read-var-name "Copy variable: "))) | |
418 | (if var1 | |
419 | (let ((value (calc-var-value var1))) | |
420 | (or value | |
922e9c18 | 421 | (error "No such variable: \"%s\"" (calc-var-name var1))) |
136211a9 | 422 | (or var2 (setq var2 (calc-read-var-name |
19449d1d | 423 | (format "Copy variable: %s, to: " |
922e9c18 | 424 | (calc-var-name var1))))) |
136211a9 | 425 | (if var2 |
0dc72b8e JB |
426 | (let ((msg (calc-store-value var2 value ""))) |
427 | (message (concat "Variable \"%s\" copied to \"%s\"" msg) | |
428 | (calc-var-name var1) (calc-var-name var2)))))))) | |
136211a9 | 429 | |
3132f345 | 430 | (defvar calc-last-edited-variable nil) |
136211a9 EZ |
431 | (defun calc-edit-variable (&optional var) |
432 | (interactive) | |
433 | (calc-wrapper | |
434 | (or var (setq var (calc-read-var-name | |
435 | (if calc-last-edited-variable | |
5b76833f | 436 | (format "Edit (default %s): " |
136211a9 EZ |
437 | (calc-var-name calc-last-edited-variable)) |
438 | "Edit: ")))) | |
439 | (or var (setq var calc-last-edited-variable)) | |
440 | (if var | |
441 | (let* ((value (calc-var-value var))) | |
442 | (if (eq (car-safe value) 'special-const) | |
443 | (error "%s is a special constant" var)) | |
444 | (setq calc-last-edited-variable var) | |
445 | (calc-edit-mode (list 'calc-finish-stack-edit (list 'quote var)) | |
446 | t | |
2fa78285 | 447 | (concat "Editing variable `" (calc-var-name var) "'. ")) |
136211a9 | 448 | (and value |
bf77c646 CW |
449 | (insert (math-format-nice-expr value (frame-width)) "\n"))))) |
450 | (calc-show-edit-buffer)) | |
136211a9 EZ |
451 | |
452 | (defun calc-edit-Decls () | |
453 | (interactive) | |
bf77c646 | 454 | (calc-edit-variable 'var-Decls)) |
136211a9 EZ |
455 | |
456 | (defun calc-edit-EvalRules () | |
457 | (interactive) | |
bf77c646 | 458 | (calc-edit-variable 'var-EvalRules)) |
136211a9 EZ |
459 | |
460 | (defun calc-edit-FitRules () | |
461 | (interactive) | |
bf77c646 | 462 | (calc-edit-variable 'var-FitRules)) |
136211a9 EZ |
463 | |
464 | (defun calc-edit-GenCount () | |
465 | (interactive) | |
bf77c646 | 466 | (calc-edit-variable 'var-GenCount)) |
136211a9 EZ |
467 | |
468 | (defun calc-edit-Holidays () | |
469 | (interactive) | |
bf77c646 | 470 | (calc-edit-variable 'var-Holidays)) |
136211a9 EZ |
471 | |
472 | (defun calc-edit-IntegLimit () | |
473 | (interactive) | |
bf77c646 | 474 | (calc-edit-variable 'var-IntegLimit)) |
136211a9 EZ |
475 | |
476 | (defun calc-edit-LineStyles () | |
477 | (interactive) | |
bf77c646 | 478 | (calc-edit-variable 'var-LineStyles)) |
136211a9 EZ |
479 | |
480 | (defun calc-edit-PointStyles () | |
481 | (interactive) | |
bf77c646 | 482 | (calc-edit-variable 'var-PointStyles)) |
136211a9 EZ |
483 | |
484 | (defun calc-edit-PlotRejects () | |
485 | (interactive) | |
bf77c646 | 486 | (calc-edit-variable 'var-PlotRejects)) |
136211a9 EZ |
487 | |
488 | (defun calc-edit-AlgSimpRules () | |
489 | (interactive) | |
bf77c646 | 490 | (calc-edit-variable 'var-AlgSimpRules)) |
136211a9 EZ |
491 | |
492 | (defun calc-edit-TimeZone () | |
493 | (interactive) | |
bf77c646 | 494 | (calc-edit-variable 'var-TimeZone)) |
136211a9 EZ |
495 | |
496 | (defun calc-edit-Units () | |
497 | (interactive) | |
bf77c646 | 498 | (calc-edit-variable 'var-Units)) |
136211a9 EZ |
499 | |
500 | (defun calc-edit-ExtSimpRules () | |
501 | (interactive) | |
bf77c646 | 502 | (calc-edit-variable 'var-ExtSimpRules)) |
136211a9 EZ |
503 | |
504 | (defun calc-declare-variable (&optional var) | |
505 | (interactive) | |
506 | (calc-wrapper | |
507 | (or var (setq var (calc-read-var-name "Declare: " 0))) | |
508 | (or var (setq var 'var-All)) | |
509 | (let* (dp decl def row rp) | |
510 | (or (and (calc-var-value 'var-Decls) | |
511 | (eq (car-safe var-Decls) 'vec)) | |
512 | (setq var-Decls (list 'vec))) | |
513 | (setq dp var-Decls) | |
514 | (while (and (setq dp (cdr dp)) | |
515 | (or (not (eq (car-safe (car dp)) 'vec)) | |
516 | (/= (length (car dp)) 3) | |
517 | (progn | |
518 | (setq row (nth 1 (car dp)) | |
519 | rp row) | |
520 | (if (eq (car-safe row) 'vec) | |
521 | (progn | |
522 | (while | |
523 | (and (setq rp (cdr rp)) | |
524 | (or (not (eq (car-safe (car rp)) 'var)) | |
525 | (not (eq (nth 2 (car rp)) var))))) | |
526 | (setq rp (car rp))) | |
527 | (if (or (not (eq (car-safe row) 'var)) | |
528 | (not (eq (nth 2 row) var))) | |
529 | (setq rp nil))) | |
530 | (not rp))))) | |
531 | (calc-unread-command ?\C-a) | |
dacb2f70 | 532 | (setq decl (read-string (format "Declare: %s to be: " (calc-var-name var)) |
136211a9 EZ |
533 | (and rp |
534 | (math-format-flat-expr (nth 2 (car dp)) 0)))) | |
535 | (setq decl (and (string-match "[^ \t]" decl) | |
536 | (math-read-exprs decl))) | |
537 | (if (eq (car-safe decl) 'error) | |
538 | (error "Bad format in declaration: %s" (nth 2 decl))) | |
539 | (if (cdr decl) | |
540 | (setq decl (cons 'vec decl)) | |
541 | (setq decl (car decl))) | |
542 | (and (eq (car-safe decl) 'vec) | |
543 | (= (length decl) 2) | |
544 | (setq decl (nth 1 decl))) | |
545 | (calc-record (append '(vec) (list (math-build-var-name var)) | |
546 | (and decl (list decl))) | |
547 | "decl") | |
548 | (setq var-Decls (copy-sequence var-Decls)) | |
549 | (if (eq (car-safe row) 'vec) | |
550 | (progn | |
551 | (setcdr row (delq rp (cdr row))) | |
552 | (or (cdr row) | |
553 | (setq var-Decls (delq (car dp) var-Decls)))) | |
554 | (setq var-Decls (delq (car dp) var-Decls))) | |
555 | (if decl | |
556 | (progn | |
557 | (setq dp (and (not (eq var 'var-All)) var-Decls)) | |
558 | (while (and (setq dp (cdr dp)) | |
559 | (or (not (eq (car-safe (car dp)) 'vec)) | |
560 | (/= (length (car dp)) 3) | |
561 | (not (equal (nth 2 (car dp)) decl))))) | |
562 | (if dp | |
563 | (setcar (cdr (car dp)) | |
564 | (append (if (eq (car-safe (nth 1 (car dp))) 'vec) | |
565 | (nth 1 (car dp)) | |
566 | (list 'vec (nth 1 (car dp)))) | |
567 | (list (math-build-var-name var)))) | |
568 | (setq var-Decls (append var-Decls | |
569 | (list (list 'vec | |
570 | (math-build-var-name var) | |
571 | decl))))))) | |
bf77c646 | 572 | (calc-refresh-evaltos 'var-Decls)))) |
136211a9 | 573 | |
3132f345 CW |
574 | (defvar calc-dont-insert-variables '(var-FitRules var-FactorRules |
575 | var-CommuteRules var-JumpRules | |
576 | var-DistribRules var-MergeRules | |
577 | var-NegateRules var-InvertRules | |
578 | var-IntegAfterRules | |
579 | var-TimeZone var-PlotRejects | |
580 | var-PlotData1 var-PlotData2 | |
581 | var-PlotData3 var-PlotData4 | |
582 | var-PlotData5 var-PlotData6 | |
583 | var-DUMMY)) | |
584 | ||
3a7a4adb JB |
585 | ;; The variable calc-pv-pos is local to calc-permanent-variable, but |
586 | ;; used by calc-insert-permanent-variable, which is called by | |
587 | ;; calc-permanent-variable. | |
588 | (defvar calc-pv-pos) | |
589 | ||
136211a9 EZ |
590 | (defun calc-permanent-variable (&optional var) |
591 | (interactive) | |
592 | (calc-wrapper | |
5b76833f | 593 | (or var (setq var (calc-read-var-name "Save variable (default all): "))) |
3a7a4adb | 594 | (let (calc-pv-pos) |
136211a9 EZ |
595 | (and var (or (and (boundp var) (symbol-value var)) |
596 | (error "No such variable"))) | |
597 | (set-buffer (find-file-noselect (substitute-in-file-name | |
598 | calc-settings-file))) | |
599 | (if var | |
600 | (calc-insert-permanent-variable var) | |
601 | (mapatoms (function | |
602 | (lambda (x) | |
603 | (and (string-match "\\`var-" (symbol-name x)) | |
604 | (not (memq x calc-dont-insert-variables)) | |
605 | (calc-var-value x) | |
606 | (not (eq (car-safe (symbol-value x)) 'special-const)) | |
607 | (calc-insert-permanent-variable x)))))) | |
bf77c646 | 608 | (save-buffer)))) |
3132f345 CW |
609 | |
610 | ||
136211a9 EZ |
611 | |
612 | (defun calc-insert-permanent-variable (var) | |
613 | (goto-char (point-min)) | |
614 | (if (search-forward (concat "(setq " (symbol-name var) " '") nil t) | |
615 | (progn | |
3a7a4adb | 616 | (setq calc-pv-pos (point-marker)) |
136211a9 EZ |
617 | (forward-line -1) |
618 | (if (looking-at ";;; Variable .* stored by Calc on ") | |
619 | (progn | |
620 | (delete-region (match-end 0) (progn (end-of-line) (point))) | |
621 | (insert (current-time-string)))) | |
3a7a4adb | 622 | (goto-char (- calc-pv-pos 8 (length (symbol-name var)))) |
136211a9 EZ |
623 | (forward-sexp 1) |
624 | (backward-char 1) | |
3a7a4adb | 625 | (delete-region calc-pv-pos (point))) |
136211a9 EZ |
626 | (goto-char (point-max)) |
627 | (insert "\n;;; Variable \"" | |
628 | (symbol-name var) | |
629 | "\" stored by Calc on " | |
630 | (current-time-string) | |
631 | "\n(setq " | |
632 | (symbol-name var) | |
633 | " ')\n") | |
634 | (backward-char 2)) | |
635 | (insert (prin1-to-string (calc-var-value var))) | |
bf77c646 | 636 | (forward-line 1)) |
136211a9 EZ |
637 | |
638 | (defun calc-insert-variables (buf) | |
639 | (interactive "bBuffer in which to save variable values: ") | |
6df9b6d7 | 640 | (with-current-buffer buf |
136211a9 EZ |
641 | (mapatoms (function |
642 | (lambda (x) | |
643 | (and (string-match "\\`var-" (symbol-name x)) | |
644 | (not (memq x calc-dont-insert-variables)) | |
645 | (calc-var-value x) | |
646 | (not (eq (car-safe (symbol-value x)) 'special-const)) | |
647 | (or (not (eq x 'var-Decls)) | |
648 | (not (equal var-Decls '(vec)))) | |
649 | (or (not (eq x 'var-Holidays)) | |
650 | (not (equal var-Holidays '(vec (var sat var-sat) | |
651 | (var sun var-sun))))) | |
652 | (insert "(setq " | |
653 | (symbol-name x) | |
654 | " " | |
655 | (prin1-to-string | |
656 | (let ((calc-language | |
657 | (if (memq calc-language '(nil big)) | |
658 | 'flat | |
659 | calc-language))) | |
660 | (math-format-value (symbol-value x) 100000))) | |
bf77c646 | 661 | ")\n"))))))) |
136211a9 EZ |
662 | |
663 | (defun calc-assign (arg) | |
664 | (interactive "P") | |
665 | (calc-slow-wrapper | |
bf77c646 | 666 | (calc-binary-op ":=" 'calcFunc-assign arg))) |
136211a9 EZ |
667 | |
668 | (defun calc-evalto (arg) | |
669 | (interactive "P") | |
670 | (calc-slow-wrapper | |
bf77c646 | 671 | (calc-unary-op "=>" 'calcFunc-evalto arg))) |
136211a9 EZ |
672 | |
673 | (defun calc-subscript (arg) | |
674 | (interactive "P") | |
675 | (calc-slow-wrapper | |
bf77c646 | 676 | (calc-binary-op "sub" 'calcFunc-subscr arg))) |
136211a9 | 677 | |
4b02a252 JB |
678 | (provide 'calc-store) |
679 | ||
cbee283d | 680 | ;; arch-tag: 2fbfec82-a521-42ca-bcd8-4f254ae6313e |
bf77c646 | 681 | ;;; calc-store.el ends here |