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