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