1 |
;; Calculator for GNU Emacs, part II [calc-store.el] |
;; Calculator for GNU Emacs, part II [calc-store.el] |
2 |
;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc. |
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. |
3 |
;; Written by Dave Gillespie, daveg@synaptics.com. |
;; Written by Dave Gillespie, daveg@synaptics.com. |
4 |
|
|
5 |
;; This file is part of GNU Emacs. |
;; This file is part of GNU Emacs. |
34 |
(defun calc-store (&optional var) |
(defun calc-store (&optional var) |
35 |
(interactive) |
(interactive) |
36 |
(let ((calc-store-keep t)) |
(let ((calc-store-keep t)) |
37 |
(calc-store-into var)) |
(calc-store-into var))) |
|
) |
|
38 |
(setq calc-store-keep nil) |
(setq calc-store-keep nil) |
39 |
|
|
40 |
(defun calc-store-into (&optional var) |
(defun calc-store-into (&optional var) |
61 |
(calc-store-value (car (car var)) (cdr (car var)) |
(calc-store-value (car (car var)) (cdr (car var)) |
62 |
(if (not (cdr var)) "") |
(if (not (cdr var)) "") |
63 |
(if (not (cdr var)) 1)) |
(if (not (cdr var)) 1)) |
64 |
(setq var (cdr var))))))) |
(setq var (cdr var)))))))) |
|
) |
|
65 |
|
|
66 |
(defun calc-store-plus (&optional var) |
(defun calc-store-plus (&optional var) |
67 |
(interactive) |
(interactive) |
68 |
(calc-store-binary var "+" '+) |
(calc-store-binary var "+" '+)) |
|
) |
|
69 |
|
|
70 |
(defun calc-store-minus (&optional var) |
(defun calc-store-minus (&optional var) |
71 |
(interactive) |
(interactive) |
72 |
(calc-store-binary var "-" '-) |
(calc-store-binary var "-" '-)) |
|
) |
|
73 |
|
|
74 |
(defun calc-store-times (&optional var) |
(defun calc-store-times (&optional var) |
75 |
(interactive) |
(interactive) |
76 |
(calc-store-binary var "*" '*) |
(calc-store-binary var "*" '*)) |
|
) |
|
77 |
|
|
78 |
(defun calc-store-div (&optional var) |
(defun calc-store-div (&optional var) |
79 |
(interactive) |
(interactive) |
80 |
(calc-store-binary var "/" '/) |
(calc-store-binary var "/" '/)) |
|
) |
|
81 |
|
|
82 |
(defun calc-store-power (&optional var) |
(defun calc-store-power (&optional var) |
83 |
(interactive) |
(interactive) |
84 |
(calc-store-binary var "^" '^) |
(calc-store-binary var "^" '^)) |
|
) |
|
85 |
|
|
86 |
(defun calc-store-concat (&optional var) |
(defun calc-store-concat (&optional var) |
87 |
(interactive) |
(interactive) |
88 |
(calc-store-binary var "|" '|) |
(calc-store-binary var "|" '|)) |
|
) |
|
89 |
|
|
90 |
(defun calc-store-neg (n &optional var) |
(defun calc-store-neg (n &optional var) |
91 |
(interactive "p") |
(interactive "p") |
92 |
(calc-store-binary var "n" '/ (- n)) |
(calc-store-binary var "n" '/ (- n))) |
|
) |
|
93 |
|
|
94 |
(defun calc-store-inv (n &optional var) |
(defun calc-store-inv (n &optional var) |
95 |
(interactive "p") |
(interactive "p") |
96 |
(calc-store-binary var "&" '^ (- n)) |
(calc-store-binary var "&" '^ (- n))) |
|
) |
|
97 |
|
|
98 |
(defun calc-store-incr (n &optional var) |
(defun calc-store-incr (n &optional var) |
99 |
(interactive "p") |
(interactive "p") |
100 |
(calc-store-binary var "n" '- (- n)) |
(calc-store-binary var "n" '- (- n))) |
|
) |
|
101 |
|
|
102 |
(defun calc-store-decr (n &optional var) |
(defun calc-store-decr (n &optional var) |
103 |
(interactive "p") |
(interactive "p") |
104 |
(calc-store-binary var "n" '- n) |
(calc-store-binary var "n" '- n)) |
|
) |
|
105 |
|
|
106 |
(defun calc-store-value (var value tag &optional pop) |
(defun calc-store-value (var value tag &optional pop) |
107 |
(if var |
(if var |
119 |
(null old) |
(null old) |
120 |
(message "(Note: %s has built-in meanings which may interfere)" |
(message "(Note: %s has built-in meanings which may interfere)" |
121 |
var)) |
var)) |
122 |
(calc-refresh-evaltos var))) |
(calc-refresh-evaltos var)))) |
|
) |
|
123 |
|
|
124 |
(defun calc-var-name (var) |
(defun calc-var-name (var) |
125 |
(if (symbolp var) (setq var (symbol-name var))) |
(if (symbolp var) (setq var (symbol-name var))) |
126 |
(if (string-match "\\`var-." var) |
(if (string-match "\\`var-." var) |
127 |
(substring var 4) |
(substring var 4) |
128 |
var) |
var)) |
|
) |
|
129 |
|
|
130 |
(defun calc-store-binary (var tag func &optional val) |
(defun calc-store-binary (var tag func &optional val) |
131 |
(calc-wrapper |
(calc-wrapper |
146 |
(list func value old) |
(list func value old) |
147 |
(list func old value))) |
(list func old value))) |
148 |
tag (and (not val) 1)) |
tag (and (not val) 1)) |
149 |
(message "Stored to variable \"%s\"" (calc-var-name var)))))) |
(message "Stored to variable \"%s\"" (calc-var-name var))))))) |
|
) |
|
150 |
|
|
151 |
(defun calc-read-var-name (prompt &optional calc-store-opers) |
(defun calc-read-var-name (prompt &optional calc-store-opers) |
152 |
(setq calc-given-value nil |
(setq calc-given-value nil |
169 |
(error "Bad format: %s" (nth 2 calc-given-value))) |
(error "Bad format: %s" (nth 2 calc-given-value))) |
170 |
(setq calc-given-value (math-evaluate-expr calc-given-value)) |
(setq calc-given-value (math-evaluate-expr calc-given-value)) |
171 |
svar)) |
svar)) |
172 |
(intern var)))) |
(intern var))))) |
|
) |
|
173 |
(setq calc-given-value-flag nil) |
(setq calc-given-value-flag nil) |
174 |
|
|
175 |
(defvar calc-var-name-map nil "Keymap for reading Calc variable names.") |
(defvar calc-var-name-map nil "Keymap for reading Calc variable names.") |
186 |
(lambda (x) |
(lambda (x) |
187 |
(define-key calc-var-name-map (char-to-string x) |
(define-key calc-var-name-map (char-to-string x) |
188 |
'calcVar-oper))) |
'calcVar-oper))) |
189 |
"+-*/^|") |
"+-*/^|")) |
|
) |
|
190 |
|
|
191 |
(defun calcVar-digit () |
(defun calcVar-digit () |
192 |
(interactive) |
(interactive) |
195 |
(beep) |
(beep) |
196 |
(insert "q") |
(insert "q") |
197 |
(self-insert-and-exit)) |
(self-insert-and-exit)) |
198 |
(self-insert-command 1)) |
(self-insert-command 1))) |
|
) |
|
199 |
|
|
200 |
(defun calcVar-oper () |
(defun calcVar-oper () |
201 |
(interactive) |
(interactive) |
204 |
(progn |
(progn |
205 |
(erase-buffer) |
(erase-buffer) |
206 |
(self-insert-and-exit)) |
(self-insert-and-exit)) |
207 |
(self-insert-command 1)) |
(self-insert-command 1))) |
|
) |
|
208 |
|
|
209 |
(defun calc-store-map (&optional oper var) |
(defun calc-store-map (&optional oper var) |
210 |
(interactive) |
(interactive) |
237 |
(calc-store-value var |
(calc-store-value var |
238 |
(calc-normalize (cons (nth 1 oper) values)) |
(calc-normalize (cons (nth 1 oper) values)) |
239 |
(nth 2 oper) |
(nth 2 oper) |
240 |
(+ calc-dollar-used (1- nargs))))))) |
(+ calc-dollar-used (1- nargs)))))))) |
|
) |
|
241 |
|
|
242 |
(defun calc-store-exchange (&optional var) |
(defun calc-store-exchange (&optional var) |
243 |
(interactive) |
(interactive) |
255 |
(setq top (or calc-given-value (calc-top 1))) |
(setq top (or calc-given-value (calc-top 1))) |
256 |
(calc-store-value var top nil) |
(calc-store-value var top nil) |
257 |
(calc-pop-push-record calc-given-value-flag |
(calc-pop-push-record calc-given-value-flag |
258 |
(concat "<>" (calc-var-name var)) value))))) |
(concat "<>" (calc-var-name var)) value)))))) |
|
) |
|
259 |
|
|
260 |
(defun calc-unstore (&optional var) |
(defun calc-unstore (&optional var) |
261 |
(interactive) |
(interactive) |
270 |
(message "Unstored variable \"%s\"" (calc-var-name var)) |
(message "Unstored variable \"%s\"" (calc-var-name var)) |
271 |
(message "Variable \"%s\" remains unstored" (calc-var-name var))) |
(message "Variable \"%s\" remains unstored" (calc-var-name var))) |
272 |
(makunbound var) |
(makunbound var) |
273 |
(calc-refresh-evaltos var)))) |
(calc-refresh-evaltos var))))) |
|
) |
|
274 |
|
|
275 |
(defun calc-let (&optional var) |
(defun calc-let (&optional var) |
276 |
(interactive) |
(interactive) |
309 |
(makunbound (car (car var)))) |
(makunbound (car (car var)))) |
310 |
(setq saved-val (cdr saved-val) |
(setq saved-val (cdr saved-val) |
311 |
var (cdr var))) |
var (cdr var))) |
312 |
(calc-handle-whys))))))) |
(calc-handle-whys)))))))) |
|
) |
|
313 |
|
|
314 |
(defun calc-is-assignments (value) |
(defun calc-is-assignments (value) |
315 |
(if (memq (car-safe value) '(calcFunc-eq calcFunc-assign)) |
(if (memq (car-safe value) '(calcFunc-eq calcFunc-assign)) |
325 |
(nth 2 (car value))) |
(nth 2 (car value))) |
326 |
vv))) |
vv))) |
327 |
(and (not value) |
(and (not value) |
328 |
vv)))) |
vv))))) |
|
) |
|
329 |
|
|
330 |
(defun calc-recall (&optional var) |
(defun calc-recall (&optional var) |
331 |
(interactive) |
(interactive) |
342 |
(setq value (calc-normalize value)) |
(setq value (calc-normalize value)) |
343 |
(let ((calc-full-trail-vectors nil)) |
(let ((calc-full-trail-vectors nil)) |
344 |
(calc-record value (concat "<" (calc-var-name var)))) |
(calc-record value (concat "<" (calc-var-name var)))) |
345 |
(calc-push value)))) |
(calc-push value))))) |
|
) |
|
346 |
|
|
347 |
(defun calc-store-quick () |
(defun calc-store-quick () |
348 |
(interactive) |
(interactive) |
349 |
(calc-store (intern (format "var-q%c" last-command-char))) |
(calc-store (intern (format "var-q%c" last-command-char)))) |
|
) |
|
350 |
|
|
351 |
(defun calc-store-into-quick () |
(defun calc-store-into-quick () |
352 |
(interactive) |
(interactive) |
353 |
(calc-store-into (intern (format "var-q%c" last-command-char))) |
(calc-store-into (intern (format "var-q%c" last-command-char)))) |
|
) |
|
354 |
|
|
355 |
(defun calc-recall-quick () |
(defun calc-recall-quick () |
356 |
(interactive) |
(interactive) |
357 |
(calc-recall (intern (format "var-q%c" last-command-char))) |
(calc-recall (intern (format "var-q%c" last-command-char)))) |
|
) |
|
358 |
|
|
359 |
(defun calc-copy-variable (&optional var1 var2) |
(defun calc-copy-variable (&optional var1 var2) |
360 |
(interactive) |
(interactive) |
367 |
(or var2 (setq var2 (calc-read-var-name |
(or var2 (setq var2 (calc-read-var-name |
368 |
(format "Copy variable: %s, to: " var1)))) |
(format "Copy variable: %s, to: " var1)))) |
369 |
(if var2 |
(if var2 |
370 |
(calc-store-value var2 value ""))))) |
(calc-store-value var2 value "")))))) |
|
) |
|
371 |
|
|
372 |
(defun calc-edit-variable (&optional var) |
(defun calc-edit-variable (&optional var) |
373 |
(interactive) |
(interactive) |
387 |
t |
t |
388 |
(concat "Editing " (calc-var-name var))) |
(concat "Editing " (calc-var-name var))) |
389 |
(and value |
(and value |
390 |
(insert (math-format-nice-expr value (screen-width)) "\n"))))) |
(insert (math-format-nice-expr value (frame-width)) "\n"))))) |
391 |
(calc-show-edit-buffer) |
(calc-show-edit-buffer)) |
|
) |
|
392 |
(setq calc-last-edited-variable nil) |
(setq calc-last-edited-variable nil) |
393 |
|
|
394 |
(defun calc-edit-Decls () |
(defun calc-edit-Decls () |
395 |
(interactive) |
(interactive) |
396 |
(calc-edit-variable 'var-Decls) |
(calc-edit-variable 'var-Decls)) |
|
) |
|
397 |
|
|
398 |
(defun calc-edit-EvalRules () |
(defun calc-edit-EvalRules () |
399 |
(interactive) |
(interactive) |
400 |
(calc-edit-variable 'var-EvalRules) |
(calc-edit-variable 'var-EvalRules)) |
|
) |
|
401 |
|
|
402 |
(defun calc-edit-FitRules () |
(defun calc-edit-FitRules () |
403 |
(interactive) |
(interactive) |
404 |
(calc-edit-variable 'var-FitRules) |
(calc-edit-variable 'var-FitRules)) |
|
) |
|
405 |
|
|
406 |
(defun calc-edit-GenCount () |
(defun calc-edit-GenCount () |
407 |
(interactive) |
(interactive) |
408 |
(calc-edit-variable 'var-GenCount) |
(calc-edit-variable 'var-GenCount)) |
|
) |
|
409 |
|
|
410 |
(defun calc-edit-Holidays () |
(defun calc-edit-Holidays () |
411 |
(interactive) |
(interactive) |
412 |
(calc-edit-variable 'var-Holidays) |
(calc-edit-variable 'var-Holidays)) |
|
) |
|
413 |
|
|
414 |
(defun calc-edit-IntegLimit () |
(defun calc-edit-IntegLimit () |
415 |
(interactive) |
(interactive) |
416 |
(calc-edit-variable 'var-IntegLimit) |
(calc-edit-variable 'var-IntegLimit)) |
|
) |
|
417 |
|
|
418 |
(defun calc-edit-LineStyles () |
(defun calc-edit-LineStyles () |
419 |
(interactive) |
(interactive) |
420 |
(calc-edit-variable 'var-LineStyles) |
(calc-edit-variable 'var-LineStyles)) |
|
) |
|
421 |
|
|
422 |
(defun calc-edit-PointStyles () |
(defun calc-edit-PointStyles () |
423 |
(interactive) |
(interactive) |
424 |
(calc-edit-variable 'var-PointStyles) |
(calc-edit-variable 'var-PointStyles)) |
|
) |
|
425 |
|
|
426 |
(defun calc-edit-PlotRejects () |
(defun calc-edit-PlotRejects () |
427 |
(interactive) |
(interactive) |
428 |
(calc-edit-variable 'var-PlotRejects) |
(calc-edit-variable 'var-PlotRejects)) |
|
) |
|
429 |
|
|
430 |
(defun calc-edit-AlgSimpRules () |
(defun calc-edit-AlgSimpRules () |
431 |
(interactive) |
(interactive) |
432 |
(calc-edit-variable 'var-AlgSimpRules) |
(calc-edit-variable 'var-AlgSimpRules)) |
|
) |
|
433 |
|
|
434 |
(defun calc-edit-TimeZone () |
(defun calc-edit-TimeZone () |
435 |
(interactive) |
(interactive) |
436 |
(calc-edit-variable 'var-TimeZone) |
(calc-edit-variable 'var-TimeZone)) |
|
) |
|
437 |
|
|
438 |
(defun calc-edit-Units () |
(defun calc-edit-Units () |
439 |
(interactive) |
(interactive) |
440 |
(calc-edit-variable 'var-Units) |
(calc-edit-variable 'var-Units)) |
|
) |
|
441 |
|
|
442 |
(defun calc-edit-ExtSimpRules () |
(defun calc-edit-ExtSimpRules () |
443 |
(interactive) |
(interactive) |
444 |
(calc-edit-variable 'var-ExtSimpRules) |
(calc-edit-variable 'var-ExtSimpRules)) |
|
) |
|
445 |
|
|
446 |
(defun calc-declare-variable (&optional var) |
(defun calc-declare-variable (&optional var) |
447 |
(interactive) |
(interactive) |
511 |
(list (list 'vec |
(list (list 'vec |
512 |
(math-build-var-name var) |
(math-build-var-name var) |
513 |
decl))))))) |
decl))))))) |
514 |
(calc-refresh-evaltos 'var-Decls))) |
(calc-refresh-evaltos 'var-Decls)))) |
|
) |
|
515 |
|
|
516 |
(defun calc-permanent-variable (&optional var) |
(defun calc-permanent-variable (&optional var) |
517 |
(interactive) |
(interactive) |
531 |
(calc-var-value x) |
(calc-var-value x) |
532 |
(not (eq (car-safe (symbol-value x)) 'special-const)) |
(not (eq (car-safe (symbol-value x)) 'special-const)) |
533 |
(calc-insert-permanent-variable x)))))) |
(calc-insert-permanent-variable x)))))) |
534 |
(save-buffer))) |
(save-buffer)))) |
|
) |
|
535 |
(defvar calc-dont-insert-variables '(var-FitRules var-FactorRules |
(defvar calc-dont-insert-variables '(var-FitRules var-FactorRules |
536 |
var-CommuteRules var-JumpRules |
var-CommuteRules var-JumpRules |
537 |
var-DistribRules var-MergeRules |
var-DistribRules var-MergeRules |
568 |
" ')\n") |
" ')\n") |
569 |
(backward-char 2)) |
(backward-char 2)) |
570 |
(insert (prin1-to-string (calc-var-value var))) |
(insert (prin1-to-string (calc-var-value var))) |
571 |
(forward-line 1) |
(forward-line 1)) |
|
) |
|
572 |
|
|
573 |
(defun calc-insert-variables (buf) |
(defun calc-insert-variables (buf) |
574 |
(interactive "bBuffer in which to save variable values: ") |
(interactive "bBuffer in which to save variable values: ") |
594 |
'flat |
'flat |
595 |
calc-language))) |
calc-language))) |
596 |
(math-format-value (symbol-value x) 100000))) |
(math-format-value (symbol-value x) 100000))) |
597 |
")\n")))))) |
")\n"))))))) |
|
) |
|
598 |
|
|
599 |
(defun calc-assign (arg) |
(defun calc-assign (arg) |
600 |
(interactive "P") |
(interactive "P") |
601 |
(calc-slow-wrapper |
(calc-slow-wrapper |
602 |
(calc-binary-op ":=" 'calcFunc-assign arg)) |
(calc-binary-op ":=" 'calcFunc-assign arg))) |
|
) |
|
603 |
|
|
604 |
(defun calc-evalto (arg) |
(defun calc-evalto (arg) |
605 |
(interactive "P") |
(interactive "P") |
606 |
(calc-slow-wrapper |
(calc-slow-wrapper |
607 |
(calc-unary-op "=>" 'calcFunc-evalto arg)) |
(calc-unary-op "=>" 'calcFunc-evalto arg))) |
|
) |
|
608 |
|
|
609 |
(defun calc-subscript (arg) |
(defun calc-subscript (arg) |
610 |
(interactive "P") |
(interactive "P") |
611 |
(calc-slow-wrapper |
(calc-slow-wrapper |
612 |
(calc-binary-op "sub" 'calcFunc-subscr arg)) |
(calc-binary-op "sub" 'calcFunc-subscr arg))) |
|
) |
|
613 |
|
|
614 |
|
;;; calc-store.el ends here |