/[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.14 by jpb, Sat May 7 21:21:01 2005 UTC revision 1.15 by jpb, Sun May 15 05:20:59 2005 UTC
# Line 57  Line 57 
57                                     ( | . calc-store-concat ) ))))                                     ( | . calc-store-concat ) ))))
58             (if found             (if found
59                 (funcall (cdr found))                 (funcall (cdr found))
60               (calc-store-value var (or calc-given-value (calc-top 1))               (let ((msg
61                                 "" calc-given-value-flag)                      (calc-store-value var (or calc-given-value (calc-top 1))
62               (message "Stored to variable \"%s\"" (calc-var-name var))))                                        "" calc-given-value-flag)))
63                   (message (concat "Stored to variable \"%s\"" msg)
64                            (calc-var-name var)))))
65         (setq var (calc-is-assignments (calc-top 1)))         (setq var (calc-is-assignments (calc-top 1)))
66         (if var         (if var
67             (while var             (while var
68               (calc-store-value (car (car var)) (cdr (car var))               (let ((msg
69                                 (if (not (cdr var)) "")                      (calc-store-value (car (car var)) (cdr (car var))
70                                 (if (not (cdr var)) 1))                                        (if (not (cdr var)) "")
71                                          (if (not (cdr var)) 1))))
72                   (message (concat "Stored to variable \"%s\"" msg)
73                            (calc-var-name var)))
74               (setq var (cdr var))))))))               (setq var (cdr var))))))))
75    
76  (defun calc-store-plus (&optional var)  (defun calc-store-plus (&optional var)
# Line 109  Line 114 
114    (calc-store-binary var "n" '- n))    (calc-store-binary var "n" '- n))
115    
116  (defun calc-store-value (var value tag &optional pop)  (defun calc-store-value (var value tag &optional pop)
117    (if var    (let ((msg ""))
118        (let ((old (calc-var-value var)))      (if var
119          (set var value)          (let ((old (calc-var-value var)))
120          (if pop (or calc-store-keep (calc-pop-stack pop)))            (set var value)
121          (calc-record-undo (list 'store (symbol-name var) old))            (if pop (or calc-store-keep (calc-pop-stack pop)))
122          (if tag            (calc-record-undo (list 'store (symbol-name var) old))
123              (let ((calc-full-trail-vectors nil))            (if tag
124                (calc-record value (format ">%s%s" tag (calc-var-name var)))))                (let ((calc-full-trail-vectors nil))
125          (and (memq var '(var-e var-i var-pi var-phi var-gamma))                  (calc-record value (format ">%s%s" tag (calc-var-name var)))))
126               (eq (car-safe old) 'special-const)            (cond
127               (message "(Note: Built-in definition of %s has been lost)" var))             ((and (memq var '(var-e var-i var-pi var-phi var-gamma))
128          (and (memq var '(var-inf var-uinf var-nan))                   (eq (car-safe old) 'special-const))
129               (null old)              (setq msg (format " (Note: Built-in definition of %s has been lost)"
130               (message "(Note: %s has built-in meanings which may interfere)"                                (calc-var-name var))))
131                        var))             ((and (memq var '(var-inf var-uinf var-nan))
132          (calc-refresh-evaltos var))))                   (null old))
133                (setq msg (format " (Note: %s has built-in meanings which may interfere)"
134                                  (calc-var-name var)))))
135              (calc-refresh-evaltos var)))
136        msg))
137    
138  (defun calc-var-name (var)  (defun calc-var-name (var)
139    (if (symbolp var) (setq var (symbol-name var)))    (if (symbolp var) (setq var (symbol-name var)))
# Line 140  Line 149 
149       (or var (setq var (calc-read-var-name (format "Store %s: " tag))))       (or var (setq var (calc-read-var-name (format "Store %s: " tag))))
150       (if var       (if var
151           (let ((old (calc-var-value var)))           (let ((old (calc-var-value var)))
152             (or old             (if (eq (car-safe old) 'special-const)
153                 (error "No such variable: \"%s\"" (calc-var-name var)))                 (error "\"%s\" is a special constant" (calc-var-name var)))
154               (if (not old)
155                   (if (memq var '(var-inf var-uinf var-nan))
156                       (error "\"%s\" is a special variable" (calc-var-name var))
157                     (error "No such variable: \"%s\"" (calc-var-name var))))
158             (if (stringp old)             (if (stringp old)
159                 (setq old (math-read-expr old)))                 (setq old (math-read-expr old)))
160             (if (eq (car-safe old) 'error)             (if (eq (car-safe old) 'error)
# Line 151  Line 164 
164                                                   (list func value old)                                                   (list func value old)
165                                                 (list func old value)))                                                 (list func old value)))
166                               tag (and (not val) 1))                               tag (and (not val) 1))
167             (message "Stored to variable \"%s\"" (calc-var-name var)))))))             (message "Variable \"%s\" changed" (calc-var-name var)))))))
168    
169  (defvar calc-var-name-map nil "Keymap for reading Calc variable names.")  (defvar calc-var-name-map nil "Keymap for reading Calc variable names.")
170  (if calc-var-name-map  (if calc-var-name-map
# Line 228  Line 241 
241       (or var (setq var (calc-read-var-name (format "Store Mapping %s: "       (or var (setq var (calc-read-var-name (format "Store Mapping %s: "
242                                                     (nth 2 oper)))))                                                     (nth 2 oper)))))
243       (if var       (if var
244           (let ((old (or (calc-var-value var)           (let ((old (calc-var-value var)))
245                          (error "No such variable: \"%s\""             (if (eq (car-safe old) 'special-const)
246                                 (calc-var-name var))))                 (error "\"%s\" is a special constant" (calc-var-name var)))
247                 (calc-simplify-mode (if (eq calc-simplify-mode 'none)             (if (not old)
248                                         'num calc-simplify-mode))                 (if (memq var '(var-inf var-uinf var-nan))
249                 (values (and (> nargs 1)                     (error "\"%s\" is a special variable" (calc-var-name var))
250                              (calc-top-list (1- nargs) (1+ calc-dollar-used)))))                   (error "No such variable: \"%s\"" (calc-var-name var))))
251             (message "Working...")             (let ((calc-simplify-mode (if (eq calc-simplify-mode 'none)
252             (calc-set-command-flag 'clear-message)                                           'num calc-simplify-mode))
253             (if (stringp old)                   (values (and (> nargs 1)
254                 (setq old (math-read-expr old)))                                (calc-top-list (1- nargs) (1+ calc-dollar-used)))))
255             (if (eq (car-safe old) 'error)               (message "Working...")
256                 (error "Bad format in variable contents: %s" (nth 2 old)))               (calc-set-command-flag 'clear-message)
257             (setq values (if (calc-is-inverse)               (if (stringp old)
258                              (append values (list old))                   (setq old (math-read-expr old)))
259                            (append (list old) values)))               (if (eq (car-safe old) 'error)
260             (calc-store-value var                   (error "Bad format in variable contents: %s" (nth 2 old)))
261                               (calc-normalize (cons (nth 1 oper) values))               (setq values (if (calc-is-inverse)
262                               (nth 2 oper)                                (append values (list old))
263                               (+ calc-dollar-used (1- nargs))))))))                              (append (list old) values)))
264                 (calc-store-value var
265                                   (calc-normalize (cons (nth 1 oper) values))
266                                   (nth 2 oper)
267                                   (+ calc-dollar-used (1- nargs)))
268                 (message "Variable \"%s\" changed" (calc-var-name var))))))))
269    
270    
271  (defun calc-store-exchange (&optional var)  (defun calc-store-exchange (&optional var)
272    (interactive)    (interactive)
# Line 258  Line 277 
277       (or var (setq var (calc-read-var-name "Exchange with: ")))       (or var (setq var (calc-read-var-name "Exchange with: ")))
278       (if var       (if var
279           (let ((value (calc-var-value var)))           (let ((value (calc-var-value var)))
            (or value  
                (error "No such variable: \"%s\"" (calc-var-name var)))  
280             (if (eq (car-safe value) 'special-const)             (if (eq (car-safe value) 'special-const)
281                 (error "%s is a special constant" var))                 (error "\"%s\" is a special constant" (calc-var-name var)))
282               (if (not value)
283                   (if (memq var '(var-inf var-uinf var-nan))
284                       (error "\"%s\" is a special variable" (calc-var-name var))
285                     (error "No such variable: \"%s\"" (calc-var-name var))))
286             (setq top (or calc-given-value (calc-top 1)))             (setq top (or calc-given-value (calc-top 1)))
287             (calc-store-value var top nil)             (calc-store-value var top nil)
288             (calc-pop-push-record calc-given-value-flag             (calc-pop-push-record calc-given-value-flag
# Line 378  Line 399 
399                                (format "Copy variable: %s, to: "                                (format "Copy variable: %s, to: "
400                                        (calc-var-name var1)))))                                        (calc-var-name var1)))))
401           (if var2           (if var2
402               (calc-store-value var2 value ""))))))               (let ((msg (calc-store-value var2 value "")))
403                   (message (concat "Variable \"%s\" copied to \"%s\"" msg)
404                            (calc-var-name var1) (calc-var-name var2))))))))
405    
406  (defvar calc-last-edited-variable nil)  (defvar calc-last-edited-variable nil)
407  (defun calc-edit-variable (&optional var)  (defun calc-edit-variable (&optional var)

Legend:
Removed from v.1.14  
changed lines
  Added in v.1.15

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