/[emacs]/emacs/lisp/calc/calc-store.el
ViewVC logotype

Diff of /emacs/lisp/calc/calc-store.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by eliz, Tue Nov 6 18:59:06 2001 UTC revision 1.2 by walters, Wed Nov 14 09:07:16 2001 UTC
# Line 1  Line 1 
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.
# Line 34  Line 34 
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)
# Line 62  Line 61 
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
# Line 131  Line 119 
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
# Line 160  Line 146 
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
# Line 184  Line 169 
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.")
# Line 202  Line 186 
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)
# Line 212  Line 195 
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)
# Line 222  Line 204 
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)
# Line 256  Line 237 
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)
# Line 275  Line 255 
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)
# Line 291  Line 270 
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)
# Line 331  Line 309 
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))
# Line 348  Line 325 
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)
# Line 366  Line 342 
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)
# Line 395  Line 367 
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)
# Line 416  Line 387 
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)
# Line 554  Line 511 
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)
# Line 575  Line 531 
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
# Line 613  Line 568 
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: ")
# Line 640  Line 594 
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

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26