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