]> code.delx.au - gnu-emacs/blob - lisp/calc/calc-embed.el
calc-embed.el
[gnu-emacs] / lisp / calc / calc-embed.el
1 ;;; calc-embed.el --- embed Calc in a buffer
2
3 ;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2005 Free Software Foundation, Inc.
4
5 ;; Author: David Gillespie <daveg@synaptics.com>
6 ;; Maintainer: Jay Belanger <belanger@truman.edu>
7
8 ;; This file is part of GNU Emacs.
9
10 ;; GNU Emacs is distributed in the hope that it will be useful,
11 ;; but WITHOUT ANY WARRANTY. No author or distributor
12 ;; accepts responsibility to anyone for the consequences of using it
13 ;; or for whether it serves any particular purpose or works at all,
14 ;; unless he says so in writing. Refer to the GNU Emacs General Public
15 ;; License for full details.
16
17 ;; Everyone is granted permission to copy, modify and redistribute
18 ;; GNU Emacs, but only under the conditions described in the
19 ;; GNU Emacs General Public License. A copy of this license is
20 ;; supposed to have been given to you along with GNU Emacs so you
21 ;; can know your rights and responsibilities. It should be in a
22 ;; file named COPYING. Among other things, the copyright notice
23 ;; and this notice must be preserved on all copies.
24
25 ;;; Commentary:
26
27 ;;; Code:
28
29 ;; This file is autoloaded from calc-ext.el.
30
31 (require 'calc-ext)
32 (require 'calc-macs)
33
34 (defun calc-show-plain (n)
35 (interactive "P")
36 (calc-wrapper
37 (calc-set-command-flag 'renum-stack)
38 (message (if (calc-change-mode 'calc-show-plain n nil t)
39 "Including \"plain\" formulas in Calc Embedded mode"
40 "Omitting \"plain\" formulas in Calc Embedded mode"))))
41
42
43 (defvar calc-embedded-modes nil)
44 (defvar calc-embedded-globals nil)
45 (defvar calc-embedded-active nil)
46 (defvar calc-embedded-all-active nil)
47 (make-variable-buffer-local 'calc-embedded-all-active)
48 (defvar calc-embedded-some-active nil)
49 (make-variable-buffer-local 'calc-embedded-some-active)
50
51 ;; The following variables are customizable and defined in calc.el.
52 (defvar calc-embedded-announce-formula)
53 (defvar calc-embedded-open-formula)
54 (defvar calc-embedded-close-formula)
55 (defvar calc-embedded-open-word)
56 (defvar calc-embedded-close-word)
57 (defvar calc-embedded-open-plain)
58 (defvar calc-embedded-close-plain)
59 (defvar calc-embedded-open-new-formula)
60 (defvar calc-embedded-close-new-formula)
61 (defvar calc-embedded-open-mode)
62 (defvar calc-embedded-close-mode)
63
64 (defconst calc-embedded-mode-vars '(("precision" . calc-internal-prec)
65 ("word-size" . calc-word-size)
66 ("angles" . calc-angle-mode)
67 ("symbolic" . calc-symbolic-mode)
68 ("matrix" . calc-matrix-mode)
69 ("fractions" . calc-prefer-frac)
70 ("complex" . calc-complex-mode)
71 ("simplify" . calc-simplify-mode)
72 ("language" . the-language)
73 ("plain" . calc-show-plain)
74 ("break" . calc-line-breaking)
75 ("justify" . the-display-just)
76 ("left-label" . calc-left-label)
77 ("right-label" . calc-right-label)
78 ("radix" . calc-number-radix)
79 ("leading-zeros" . calc-leading-zeros)
80 ("grouping" . calc-group-digits)
81 ("group-char" . calc-group-char)
82 ("point-char" . calc-point-char)
83 ("frac-format" . calc-frac-format)
84 ("float-format" . calc-float-format)
85 ("complex-format" . calc-complex-format)
86 ("hms-format" . calc-hms-format)
87 ("date-format" . calc-date-format)
88 ("matrix-justify" . calc-matrix-just)
89 ("full-vectors" . calc-full-vectors)
90 ("break-vectors" . calc-break-vectors)
91 ("vector-commas" . calc-vector-commas)
92 ("vector-brackets" . calc-vector-brackets)
93 ("matrix-brackets" . calc-matrix-brackets)
94 ("strings" . calc-display-strings)
95 ))
96
97
98 ;;; Format of calc-embedded-info vector:
99 ;;; 0 Editing buffer.
100 ;;; 1 Calculator buffer.
101 ;;; 2 Top of current formula (marker).
102 ;;; 3 Bottom of current formula (marker).
103 ;;; 4 Top of current formula's delimiters (marker).
104 ;;; 5 Bottom of current formula's delimiters (marker).
105 ;;; 6 String representation of current formula.
106 ;;; 7 Non-nil if formula is embedded within a single line.
107 ;;; 8 Internal representation of current formula.
108 ;;; 9 Variable assigned by this formula, or nil.
109 ;;; 10 List of variables upon which this formula depends.
110 ;;; 11 Evaluated value of the formula, or nil.
111 ;;; 12 Mode settings for current formula.
112 ;;; 13 Local mode settings for current formula.
113 ;;; 14 Permanent mode settings for current formula.
114 ;;; 15 Global mode settings for editing buffer.
115
116
117 ;;; calc-embedded-active is an a-list keyed on buffers; each cdr is a
118 ;;; sorted list of calc-embedded-infos in that buffer. We do this
119 ;;; rather than using buffer-local variables because the latter are
120 ;;; thrown away when a buffer changes major modes.
121
122 (defvar calc-embedded-original-modes nil
123 "The mode settings for Calc buffer when put in embedded mode.")
124
125 (defun calc-embedded-save-original-modes ()
126 "Save the current Calc modes when entereding embedded mode."
127 (let ((calcbuf (save-excursion
128 (calc-create-buffer)
129 (current-buffer)))
130 lang modes)
131 (if calcbuf
132 (with-current-buffer calcbuf
133 (setq lang
134 (cons calc-language calc-language-option))
135 (setq modes
136 (list (cons 'calc-display-just
137 calc-display-just)
138 (cons 'calc-display-origin
139 calc-display-origin)))
140 (let ((v calc-embedded-mode-vars))
141 (while v
142 (let ((var (cdr (car v))))
143 (unless (memq var '(the-language the-display-just))
144 (setq modes
145 (cons (cons var (symbol-value var))
146 modes))))
147 (setq v (cdr v))))
148 (setq calc-embedded-original-modes (cons lang modes)))
149 (setq calc-embedded-original-modes nil))))
150
151 (defun calc-embedded-restore-original-modes ()
152 "Restore the original Calc modes when leaving embedded mode."
153 (let ((calcbuf (get-buffer "*Calculator*"))
154 (changed nil)
155 (lang (car calc-embedded-original-modes))
156 (modes (cdr calc-embedded-original-modes)))
157 (if (and calcbuf calc-embedded-original-modes)
158 (with-current-buffer calcbuf
159 (unless (and
160 (equal calc-language (car lang))
161 (equal calc-language-option (cdr lang)))
162 (calc-set-language (car lang) (cdr lang))
163 (setq changed t))
164 (while modes
165 (let ((mode (car modes)))
166 (unless (equal (symbol-value (car mode)) (cdr mode))
167 (set (car mode) (cdr mode))
168 (setq changed t)))
169 (setq modes (cdr modes)))
170 (when changed
171 (calc-refresh)
172 (calc-set-mode-line))))
173 (setq calc-embedded-original-modes nil)))
174
175 ;; The variables calc-embed-outer-top, calc-embed-outer-bot,
176 ;; calc-embed-top and calc-embed-bot are
177 ;; local to calc-do-embedded, calc-embedded-mark-formula,
178 ;; calc-embedded-duplicate, calc-embedded-new-formula and
179 ;; calc-embedded-make-info, but are used by calc-embedded-find-bounds,
180 ;; which is called (directly or indirectly) by the above functions.
181 (defvar calc-embed-outer-top)
182 (defvar calc-embed-outer-bot)
183 (defvar calc-embed-top)
184 (defvar calc-embed-bot)
185
186 (defvar calc-embedded-quiet nil)
187 (defun calc-do-embedded (arg end obeg oend)
188 (if calc-embedded-info
189
190 ;; Turn embedded mode off or switch to a new buffer.
191 (cond ((eq (current-buffer) (aref calc-embedded-info 1))
192 (let ((calcbuf (current-buffer))
193 (buf (aref calc-embedded-info 0)))
194 (calc-embedded-original-buffer t)
195 (calc-embedded nil)
196 (switch-to-buffer calcbuf)))
197
198 ((eq (current-buffer) (aref calc-embedded-info 0))
199 (let* ((info calc-embedded-info)
200 (mode calc-embedded-modes))
201 (save-excursion
202 (set-buffer (aref info 1))
203 (if (and (> (calc-stack-size) 0)
204 (equal (calc-top 1 'full) (aref info 8)))
205 (let ((calc-no-refresh-evaltos t))
206 (if (calc-top 1 'sel)
207 (calc-unselect 1))
208 (calc-embedded-set-modes
209 (aref info 15) (aref info 12) (aref info 14))
210 (let ((calc-embedded-info nil))
211 (calc-wrapper (calc-pop-stack))))
212 (calc-set-mode-line)))
213 (setq calc-embedded-info nil
214 mode-line-buffer-identification (car mode)
215 truncate-lines (nth 2 mode)
216 buffer-read-only nil)
217 (use-local-map (nth 1 mode))
218 (set-buffer-modified-p (buffer-modified-p))
219 (calc-embedded-restore-original-modes)
220 (or calc-embedded-quiet
221 (message "Back to %s mode" mode-name))))
222
223 (t
224 (if (buffer-name (aref calc-embedded-info 0))
225 (save-excursion
226 (set-buffer (aref calc-embedded-info 0))
227 (or (y-or-n-p (format "Cancel Calc Embedded mode in buffer %s? "
228 (buffer-name)))
229 (keyboard-quit))
230 (calc-embedded nil)))
231 (calc-embedded arg end obeg oend)))
232
233 ;; Turn embedded mode on.
234 (calc-plain-buffer-only)
235 (let ((modes (list mode-line-buffer-identification
236 (current-local-map)
237 truncate-lines))
238 calc-embed-top calc-embed-bot calc-embed-outer-top calc-embed-outer-bot
239 info chg ident)
240 (barf-if-buffer-read-only)
241 (calc-embedded-save-original-modes)
242 (or calc-embedded-globals
243 (calc-find-globals))
244 (setq info (calc-embedded-make-info (point) nil t arg end obeg oend))
245 (if (eq (car-safe (aref info 8)) 'error)
246 (progn
247 (setq calc-embedded-original-modes nil)
248 (goto-char (nth 1 (aref info 8)))
249 (error (nth 2 (aref info 8)))))
250 (let ((mode-line-buffer-identification mode-line-buffer-identification)
251 (calc-embedded-info info)
252 (calc-embedded-no-reselect t))
253 (calc-wrapper
254 (let* ((okay nil)
255 (calc-no-refresh-evaltos t))
256 (if (aref info 8)
257 (progn
258 (calc-push (calc-normalize (aref info 8)))
259 (setq chg (calc-embedded-set-modes
260 (aref info 15) (aref info 12) (aref info 13))))
261 (setq chg (calc-embedded-set-modes
262 (aref info 15) (aref info 12) (aref info 13)))
263 (calc-alg-entry)))
264 (setq calc-undo-list nil
265 calc-redo-list nil
266 ident mode-line-buffer-identification)))
267 (setq calc-embedded-info info
268 calc-embedded-modes modes
269 mode-line-buffer-identification ident
270 truncate-lines t
271 buffer-read-only t)
272 (set-buffer-modified-p (buffer-modified-p))
273 (use-local-map calc-mode-map)
274 (setq calc-no-refresh-evaltos nil)
275 (and chg calc-any-evaltos (calc-wrapper (calc-refresh-evaltos)))
276 (let (str)
277 (save-excursion
278 (calc-select-buffer)
279 (setq str mode-line-buffer-identification))
280 (unless (equal str mode-line-buffer-identification)
281 (setq mode-line-buffer-identification str)
282 (set-buffer-modified-p (buffer-modified-p))))
283 (or (eq calc-embedded-quiet t)
284 (message "Embedded Calc mode enabled; %s to return to normal"
285 (if calc-embedded-quiet
286 "Type `M-# x'"
287 "Give this command again")))))
288 (scroll-down 0)) ; fix a bug which occurs when truncate-lines is changed.
289
290
291 (defun calc-embedded-select (arg)
292 (interactive "P")
293 (calc-embedded arg)
294 (and calc-embedded-info
295 (eq (car-safe (aref calc-embedded-info 8)) 'calcFunc-evalto)
296 (calc-select-part 1))
297 (and calc-embedded-info
298 (or (eq (car-safe (aref calc-embedded-info 8)) 'calcFunc-assign)
299 (and (eq (car-safe (aref calc-embedded-info 8)) 'calcFunc-evalto)
300 (eq (car-safe (nth 1 (aref calc-embedded-info 8)))
301 'calcFunc-assign)))
302 (calc-select-part 2)))
303
304
305 (defun calc-embedded-update-formula (arg)
306 (interactive "P")
307 (if arg
308 (let ((entry (assq (current-buffer) calc-embedded-active)))
309 (while (setq entry (cdr entry))
310 (and (eq (car-safe (aref (car entry) 8)) 'calcFunc-evalto)
311 (or (not (consp arg))
312 (and (<= (aref (car entry) 2) (region-beginning))
313 (>= (aref (car entry) 3) (region-end))))
314 (save-excursion
315 (calc-embedded-update (car entry) 14 t t)))))
316 (if (and calc-embedded-info
317 (eq (current-buffer) (aref calc-embedded-info 0))
318 (>= (point) (aref calc-embedded-info 4))
319 (<= (point) (aref calc-embedded-info 5)))
320 (calc-evaluate 1)
321 (let* ((opt (point))
322 (info (calc-embedded-make-info (point) nil t))
323 (pt (- opt (aref info 4))))
324 (or (eq (car-safe (aref info 8)) 'error)
325 (progn
326 (save-excursion
327 (calc-embedded-update info 14 'eval t))
328 (goto-char (+ (aref info 4) pt))))))))
329
330
331 (defun calc-embedded-edit (arg)
332 (interactive "P")
333 (let ((info (calc-embedded-make-info (point) nil t arg))
334 str)
335 (if (eq (car-safe (aref info 8)) 'error)
336 (progn
337 (goto-char (nth 1 (aref info 8)))
338 (error (nth 2 (aref info 8)))))
339 (calc-wrapper
340 (setq str (math-showing-full-precision
341 (math-format-nice-expr (aref info 8) (frame-width))))
342 (calc-edit-mode (list 'calc-embedded-finish-edit info))
343 (insert str "\n")))
344 (calc-show-edit-buffer))
345
346 (defvar calc-original-buffer)
347 (defvar calc-edit-top)
348 (defun calc-embedded-finish-edit (info)
349 (let ((buf (current-buffer))
350 (str (buffer-substring calc-edit-top (point-max)))
351 (start (point))
352 pos)
353 (switch-to-buffer calc-original-buffer)
354 (let ((val (save-excursion
355 (set-buffer (aref info 1))
356 (let ((calc-language nil)
357 (math-expr-opers math-standard-opers))
358 (math-read-expr str)))))
359 (if (eq (car-safe val) 'error)
360 (progn
361 (switch-to-buffer buf)
362 (goto-char (+ start (nth 1 val)))
363 (error (nth 2 val))))
364 (calc-embedded-original-buffer t info)
365 (aset info 8 val)
366 (calc-embedded-update info 14 t t))))
367
368 (defun calc-do-embedded-activate (arg cbuf)
369 (calc-plain-buffer-only)
370 (if arg
371 (calc-embedded-forget))
372 (calc-find-globals)
373 (if (< (prefix-numeric-value arg) 0)
374 (message "Deactivating %s for Calc Embedded mode" (buffer-name))
375 (message "Activating %s for Calc Embedded mode..." (buffer-name))
376 (save-excursion
377 (let* ((active (assq (current-buffer) calc-embedded-active))
378 (info active)
379 (pat " := \\| \\\\gets \\| => \\| \\\\evalto "))
380 (if calc-embedded-announce-formula
381 (setq pat (format "%s\\|\\(%s\\)"
382 pat calc-embedded-announce-formula)))
383 (while (setq info (cdr info))
384 (or (equal (buffer-substring (aref (car info) 2) (aref (car info) 3))
385 (aref (car info) 6))
386 (setcdr active (delq (car info) (cdr active)))))
387 (goto-char (point-min))
388 (while (re-search-forward pat nil t)
389 ;;; (if (looking-at calc-embedded-open-formula)
390 ;;; (goto-char (match-end 1)))
391 (setq info (calc-embedded-make-info (point) cbuf nil))
392 (or (eq (car-safe (aref info 8)) 'error)
393 (goto-char (aref info 5))))))
394 (message "Activating %s for Calc Embedded mode...done" (buffer-name)))
395 (calc-embedded-active-state t))
396
397 (defun calc-plain-buffer-only ()
398 (if (memq major-mode '(calc-mode calc-trail-mode calc-edit-mode))
399 (error "This command should be used in a normal editing buffer")))
400
401 (defun calc-embedded-active-state (state)
402 (or (assq 'calc-embedded-all-active minor-mode-alist)
403 (setq minor-mode-alist
404 (cons '(calc-embedded-all-active " Active")
405 (cons '(calc-embedded-some-active " ~Active")
406 minor-mode-alist))))
407 (let ((active (assq (current-buffer) calc-embedded-active)))
408 (or (cdr active)
409 (setq state nil)))
410 (and (eq state 'more) calc-embedded-all-active (setq state t))
411 (setq calc-embedded-all-active (eq state t)
412 calc-embedded-some-active (not (memq state '(nil t))))
413 (set-buffer-modified-p (buffer-modified-p)))
414
415
416 (defun calc-embedded-original-buffer (switch &optional info)
417 (or info (setq info calc-embedded-info))
418 (or (buffer-name (aref info 0))
419 (progn
420 (error "Calc embedded mode: Original buffer has been killed")))
421 (if switch
422 (set-buffer (aref info 0))))
423
424 (defun calc-embedded-word ()
425 (interactive)
426 (calc-embedded '(4)))
427
428 (defun calc-embedded-mark-formula (&optional body-only)
429 "Put point at the beginning of this Calc formula, mark at the end.
430 This normally marks the whole formula, including surrounding delimiters.
431 With any prefix argument, marks only the formula itself."
432 (interactive "P")
433 (and (eq major-mode 'calc-mode)
434 (error "This command should be used in a normal editing buffer"))
435 (let (calc-embed-top calc-embed-bot calc-embed-outer-top calc-embed-outer-bot)
436 (save-excursion
437 (calc-embedded-find-bounds body-only))
438 (push-mark (if body-only calc-embed-bot calc-embed-outer-bot) t)
439 (goto-char (if body-only calc-embed-top calc-embed-outer-top))))
440
441 (defun calc-embedded-find-bounds (&optional plain)
442 ;; (while (and (bolp) (eq (following-char) ?\n))
443 ;; (forward-char 1))
444 (and (eolp) (bolp) (not (eq (char-after (- (point) 2)) ?\n))
445 (forward-char -1))
446 (let ((home (point)))
447 (or (and (looking-at calc-embedded-open-formula)
448 (not (looking-at calc-embedded-close-formula)))
449 (re-search-backward calc-embedded-open-formula nil t)
450 (error "Can't find start of formula"))
451 (and (eq (preceding-char) ?\$) ; backward search for \$\$? won't back
452 (eq (following-char) ?\$) ; up over a second $, so do it by hand.
453 (forward-char -1))
454 (setq calc-embed-outer-top (point))
455 (goto-char (match-end 0))
456 (if (looking-at "[ \t]*$")
457 (end-of-line))
458 (if (eq (following-char) ?\n)
459 (forward-char 1))
460 (or (bolp)
461 (while (eq (following-char) ?\ )
462 (forward-char 1)))
463 (or (eq plain 'plain)
464 (if (looking-at (regexp-quote calc-embedded-open-plain))
465 (progn
466 (goto-char (match-end 0))
467 (search-forward calc-embedded-close-plain))))
468 (setq calc-embed-top (point))
469 (or (re-search-forward calc-embedded-close-formula nil t)
470 (error "Can't find end of formula"))
471 (if (< (point) home)
472 (error "Not inside a formula"))
473 (and (eq (following-char) ?\n) (not (bolp))
474 (forward-char 1))
475 (setq calc-embed-outer-bot (point))
476 (goto-char (match-beginning 0))
477 (if (eq (preceding-char) ?\n)
478 (backward-char 1))
479 (or (eolp)
480 (while (eq (preceding-char) ?\ )
481 (backward-char 1)))
482 (setq calc-embed-bot (point))))
483
484 (defun calc-embedded-kill-formula ()
485 "Kill the formula surrounding point.
486 If Calc Embedded mode was active, this deactivates it.
487 The formula (including its surrounding delimiters) is saved in the kill ring.
488 The command \\[yank] can retrieve it from there."
489 (interactive)
490 (and calc-embedded-info
491 (calc-embedded nil))
492 (calc-embedded-mark-formula)
493 (kill-region (point) (mark))
494 (pop-mark))
495
496 (defun calc-embedded-copy-formula-as-kill ()
497 "Save the formula surrounding point as if killed, but don't kill it."
498 (interactive)
499 (save-excursion
500 (calc-embedded-mark-formula)
501 (copy-region-as-kill (point) (mark))
502 (pop-mark)))
503
504 (defun calc-embedded-duplicate ()
505 (interactive)
506 (let ((already calc-embedded-info)
507 calc-embed-top calc-embed-bot calc-embed-outer-top calc-embed-outer-bot new-top)
508 (if calc-embedded-info
509 (progn
510 (setq calc-embed-top (+ (aref calc-embedded-info 2))
511 calc-embed-bot (+ (aref calc-embedded-info 3))
512 calc-embed-outer-top (+ (aref calc-embedded-info 4))
513 calc-embed-outer-bot (+ (aref calc-embedded-info 5)))
514 (calc-embedded nil))
515 (calc-embedded-find-bounds))
516 (goto-char calc-embed-outer-bot)
517 (insert "\n")
518 (setq new-top (point))
519 (insert-buffer-substring (current-buffer)
520 calc-embed-outer-top calc-embed-outer-bot)
521 (goto-char (+ new-top (- calc-embed-top calc-embed-outer-top)))
522 (let ((calc-embedded-quiet (if already t 'x)))
523 (calc-embedded (+ new-top (- calc-embed-top calc-embed-outer-top))
524 (+ new-top (- calc-embed-bot calc-embed-outer-top))
525 new-top
526 (+ new-top (- calc-embed-outer-bot calc-embed-outer-top))))))
527
528 (defun calc-embedded-next (arg)
529 (interactive "P")
530 (setq arg (prefix-numeric-value arg))
531 (let* ((active (cdr (assq (current-buffer) calc-embedded-active)))
532 (p active)
533 (num (length active)))
534 (or active
535 (error "No active formulas in buffer"))
536 (cond ((= arg 0))
537 ((= arg -1)
538 (if (<= (point) (aref (car active) 3))
539 (goto-char (aref (nth (1- num) active) 2))
540 (while (and (cdr p)
541 (> (point) (aref (nth 1 p) 3)))
542 (setq p (cdr p)))
543 (goto-char (aref (car p) 2))))
544 ((< arg -1)
545 (calc-embedded-next -1)
546 (calc-embedded-next (+ (* num 1000) arg 1)))
547 (t
548 (setq arg (1+ (% (1- arg) num)))
549 (while (and p (>= (point) (aref (car p) 2)))
550 (setq p (cdr p)))
551 (while (> (setq arg (1- arg)) 0)
552 (setq p (if p (cdr p) (cdr active))))
553 (goto-char (aref (car (or p active)) 2))))))
554
555 (defun calc-embedded-previous (arg)
556 (interactive "p")
557 (calc-embedded-next (- (prefix-numeric-value arg))))
558
559 (defun calc-embedded-new-formula ()
560 (interactive)
561 (and (eq major-mode 'calc-mode)
562 (error "This command should be used in a normal editing buffer"))
563 (if calc-embedded-info
564 (calc-embedded nil))
565 (let (calc-embed-top calc-embed-bot calc-embed-outer-top calc-embed-outer-bot)
566 (if (and (eq (preceding-char) ?\n)
567 (string-match "\\`\n" calc-embedded-open-new-formula))
568 (progn
569 (setq calc-embed-outer-top (1- (point)))
570 (forward-char -1)
571 (insert (substring calc-embedded-open-new-formula 1)))
572 (setq calc-embed-outer-top (point))
573 (insert calc-embedded-open-new-formula))
574 (setq calc-embed-top (point))
575 (insert " ")
576 (setq calc-embed-bot (point))
577 (insert calc-embedded-close-new-formula)
578 (if (and (eq (following-char) ?\n)
579 (string-match "\n\\'" calc-embedded-close-new-formula))
580 (delete-char 1))
581 (setq calc-embed-outer-bot (point))
582 (goto-char calc-embed-top)
583 (let ((calc-embedded-quiet 'x))
584 (calc-embedded calc-embed-top calc-embed-bot calc-embed-outer-top calc-embed-outer-bot))))
585
586 (defun calc-embedded-forget ()
587 (interactive)
588 (setq calc-embedded-active (delq (assq (current-buffer) calc-embedded-active)
589 calc-embedded-active))
590 (calc-embedded-active-state nil))
591
592 ;; The variables calc-embed-prev-modes is local to calc-embedded-update,
593 ;; but is used by calc-embedded-set-modes.
594 (defvar calc-embed-prev-modes)
595
596 (defun calc-embedded-set-modes (gmodes modes local-modes &optional temp)
597 (let ((the-language (calc-embedded-language))
598 (the-display-just (calc-embedded-justify))
599 (v gmodes)
600 (changed nil)
601 found value)
602 (while v
603 (or (symbolp (car v))
604 (and (setq found (assq (car (car v)) modes))
605 (not (eq (cdr found) 'default)))
606 (and (setq found (assq (car (car v)) local-modes))
607 (not (eq (cdr found) 'default)))
608 (progn
609 (if (eq (setq value (cdr (car v))) 'default)
610 (setq value (list (nth 1 (assq (car (car v)) calc-mode-var-list)))))
611 (equal (symbol-value (car (car v))) value))
612 (progn
613 (setq changed t)
614 (if temp (setq calc-embed-prev-modes
615 (cons (cons (car (car v))
616 (symbol-value (car (car v))))
617 calc-embed-prev-modes)))
618 (set (car (car v)) value)))
619 (setq v (cdr v)))
620 (setq v modes)
621 (while v
622 (or (and (setq found (assq (car (car v)) local-modes))
623 (not (eq (cdr found) 'default)))
624 (eq (setq value (cdr (car v))) 'default)
625 (equal (symbol-value (car (car v))) value)
626 (progn
627 (setq changed t)
628 (if temp (setq calc-embed-prev-modes (cons (cons (car (car v))
629 (symbol-value (car (car v))))
630 calc-embed-prev-modes)))
631 (set (car (car v)) value)))
632 (setq v (cdr v)))
633 (setq v local-modes)
634 (while v
635 (or (eq (setq value (cdr (car v))) 'default)
636 (equal (symbol-value (car (car v))) value)
637 (progn
638 (setq changed t)
639 (if temp (setq calc-embed-prev-modes (cons (cons (car (car v))
640 (symbol-value (car (car v))))
641 calc-embed-prev-modes)))
642 (set (car (car v)) value)))
643 (setq v (cdr v)))
644 (and changed (not (eq temp t))
645 (progn
646 (calc-embedded-set-justify the-display-just)
647 (calc-embedded-set-language the-language)))
648 (and changed (not temp)
649 (progn
650 (setq calc-full-float-format (list (if (eq (car calc-float-format)
651 'fix)
652 'float
653 (car calc-float-format))
654 0))
655 (calc-refresh)))
656 changed))
657
658 (defun calc-embedded-language ()
659 (if calc-language-option
660 (list calc-language calc-language-option)
661 calc-language))
662
663 (defun calc-embedded-set-language (lang)
664 (let ((option nil))
665 (if (consp lang)
666 (setq option (nth 1 lang)
667 lang (car lang)))
668 (or (and (eq lang calc-language)
669 (equal option calc-language-option))
670 (calc-set-language lang option t))))
671
672 (defun calc-embedded-justify ()
673 (if calc-display-origin
674 (list calc-display-just calc-display-origin)
675 calc-display-just))
676
677 (defun calc-embedded-set-justify (just)
678 (if (consp just)
679 (setq calc-display-origin (nth 1 just)
680 calc-display-just (car just))
681 (setq calc-display-just just
682 calc-display-origin nil)))
683
684
685 (defun calc-find-globals ()
686 (interactive)
687 (and (eq major-mode 'calc-mode)
688 (error "This command should be used in a normal editing buffer"))
689 (make-local-variable 'calc-embedded-globals)
690 (let ((case-fold-search nil)
691 (modes nil)
692 (save-pt (point))
693 found value)
694 (goto-char (point-min))
695 (while (re-search-forward "\\[calc-global-mode: *\\([-a-z]+\\): *\\(\"\\([^\"\n\\]\\|\\\\.\\)*\"\\|[- ()a-zA-Z0-9]+\\)\\]" nil t)
696 (and (setq found (assoc (buffer-substring (match-beginning 1)
697 (match-end 1))
698 calc-embedded-mode-vars))
699 (or (assq (cdr found) modes)
700 (setq modes (cons (cons (cdr found)
701 (car (read-from-string
702 (buffer-substring
703 (match-beginning 2)
704 (match-end 2)))))
705 modes)))))
706 (setq calc-embedded-globals (cons t modes))
707 (goto-char save-pt)))
708
709 (defun calc-embedded-find-modes ()
710 (let ((case-fold-search nil)
711 (save-pt (point))
712 (no-defaults t)
713 (modes nil)
714 (emodes nil)
715 (pmodes nil)
716 found value)
717 (while (and no-defaults (search-backward "[calc-" nil t))
718 (forward-char 6)
719 (or (and (looking-at "mode: *\\([-a-z]+\\): *\\(\"\\([^\"\n\\]\\|\\\\.\\)*\"\\|[- ()a-zA-Z0-9]+\\)]")
720 (setq found (assoc (buffer-substring (match-beginning 1)
721 (match-end 1))
722 calc-embedded-mode-vars))
723 (or (assq (cdr found) modes)
724 (setq modes (cons (cons (cdr found)
725 (car (read-from-string
726 (buffer-substring
727 (match-beginning 2)
728 (match-end 2)))))
729 modes))))
730 (and (looking-at "perm-mode: *\\([-a-z]+\\): *\\(\"\\([^\"\n\\]\\|\\\\.\\)*\"\\|[- ()a-zA-Z0-9]+\\)]")
731 (setq found (assoc (buffer-substring (match-beginning 1)
732 (match-end 1))
733 calc-embedded-mode-vars))
734 (or (assq (cdr found) pmodes)
735 (setq pmodes (cons (cons (cdr found)
736 (car (read-from-string
737 (buffer-substring
738 (match-beginning 2)
739 (match-end 2)))))
740 pmodes))))
741 (and (looking-at "edit-mode: *\\([-a-z]+\\): *\\(\"\\([^\"\n\\]\\|\\\\.\\)*\"\\|[- ()a-zA-Z0-9]+\\)]")
742 (setq found (assoc (buffer-substring (match-beginning 1)
743 (match-end 1))
744 calc-embedded-mode-vars))
745 (or (assq (cdr found) emodes)
746 (setq emodes (cons (cons (cdr found)
747 (car (read-from-string
748 (buffer-substring
749 (match-beginning 2)
750 (match-end 2)))))
751 emodes))))
752 (and (looking-at "defaults]")
753 (setq no-defaults nil)))
754 (backward-char 6))
755 (goto-char save-pt)
756 (unless (assq 'the-language modes)
757 (let ((lang (assoc major-mode calc-language-alist)))
758 (if lang
759 (setq modes (cons (cons 'the-language (cdr lang))
760 modes)))))
761 (list modes emodes pmodes)))
762
763 ;; The variable calc-embed-vars-used is local to calc-embedded-make-info,
764 ;; calc-embedded-evaluate-expr and calc-embedded-update, but is
765 ;; used by calc-embedded-find-vars, which is called by the above functions.
766 (defvar calc-embed-vars-used)
767
768 (defun calc-embedded-make-info (point cbuf fresh &optional
769 calc-embed-top calc-embed-bot
770 calc-embed-outer-top calc-embed-outer-bot)
771 (let* ((bufentry (assq (current-buffer) calc-embedded-active))
772 (found bufentry)
773 (force (and fresh calc-embed-top))
774 (fixed calc-embed-top)
775 (new-info nil)
776 info str)
777 (or found
778 (setq found (list (current-buffer))
779 calc-embedded-active (cons found calc-embedded-active)))
780 (while (and (cdr found)
781 (> point (aref (car (cdr found)) 3)))
782 (setq found (cdr found)))
783 (if (and (cdr found)
784 (>= point (aref (nth 1 found) 2)))
785 (setq info (nth 1 found))
786 (setq info (make-vector 16 nil)
787 new-info t
788 fresh t)
789 (aset info 0 (current-buffer))
790 (aset info 1 (or cbuf (save-excursion
791 (calc-create-buffer)
792 (current-buffer)))))
793 (if (and (integerp calc-embed-top) (not calc-embed-bot))
794 ; started with a user-supplied argument
795 (progn
796 (if (= (setq arg (prefix-numeric-value arg)) 0)
797 (progn
798 (aset info 2 (copy-marker (region-beginning)))
799 (aset info 3 (copy-marker (region-end))))
800 (aset info (if (> arg 0) 2 3) (point-marker))
801 (forward-line arg)
802 (aset info (if (> arg 0) 3 2) (point-marker)))
803 (aset info 4 (copy-marker (aref info 2)))
804 (aset info 5 (copy-marker (aref info 3))))
805 (if (aref info 4)
806 (setq calc-embed-top (aref info 2)
807 fixed calc-embed-top)
808 (if (consp calc-embed-top)
809 (let ((calc-embedded-open-formula calc-embedded-open-word)
810 (calc-embedded-close-formula calc-embedded-close-word))
811 (calc-embedded-find-bounds 'plain))
812 (or calc-embed-top
813 (calc-embedded-find-bounds 'plain)))
814 (aset info 2 (copy-marker (min calc-embed-top calc-embed-bot)))
815 (aset info 3 (copy-marker (max calc-embed-top calc-embed-bot)))
816 (aset info 4 (copy-marker (or calc-embed-outer-top (aref info 2))))
817 (aset info 5 (copy-marker (or calc-embed-outer-bot (aref info 3))))))
818 (goto-char (aref info 2))
819 (if new-info
820 (progn
821 (or (bolp) (aset info 7 t))
822 (goto-char (aref info 3))
823 (or (bolp) (eolp) (aset info 7 t))))
824 (if fresh
825 (let ((modes (calc-embedded-find-modes)))
826 (aset info 12 (car modes))
827 (aset info 13 (nth 1 modes))
828 (aset info 14 (nth 2 modes))))
829 (aset info 15 calc-embedded-globals)
830 (setq str (buffer-substring (aref info 2) (aref info 3)))
831 (if (or force
832 (not (equal str (aref info 6))))
833 (if (and fixed (aref info 6))
834 (progn
835 (aset info 4 nil)
836 (calc-embedded-make-info point cbuf nil)
837 (setq new-info nil))
838 (let* ((open-plain calc-embedded-open-plain)
839 (close-plain calc-embedded-close-plain)
840 (pref-len (length open-plain))
841 (calc-embed-vars-used nil)
842 suff-pos val temp)
843 (save-excursion
844 (set-buffer (aref info 1))
845 (calc-embedded-set-modes (aref info 15)
846 (aref info 12) (aref info 14))
847 (if (and (> (length str) pref-len)
848 (equal (substring str 0 pref-len) open-plain)
849 (setq suff-pos (string-match (regexp-quote close-plain)
850 str pref-len)))
851 (setq val (math-read-plain-expr
852 (substring str pref-len suff-pos)))
853 (if (string-match "[^ \t\n]" str)
854 (setq pref-len 0
855 val (math-read-big-expr str))
856 (setq val nil))))
857 (if (eq (car-safe val) 'error)
858 (setq val (list 'error
859 (+ (aref info 2) pref-len (nth 1 val))
860 (nth 2 val))))
861 (aset info 6 str)
862 (aset info 8 val)
863 (setq temp val)
864 (if (eq (car-safe temp) 'calcFunc-evalto)
865 (setq temp (nth 1 temp))
866 (if (eq (car-safe temp) 'error)
867 (if new-info
868 (setq new-info nil)
869 (setcdr found (delq info (cdr found)))
870 (calc-embedded-active-state 'less))))
871 (aset info 9 (and (eq (car-safe temp) 'calcFunc-assign)
872 (nth 1 temp)))
873 (if (memq (car-safe val) '(calcFunc-evalto calcFunc-assign))
874 (calc-embedded-find-vars val))
875 (aset info 10 calc-embed-vars-used)
876 (aset info 11 nil))))
877 (if new-info
878 (progn
879 (setcdr found (cons info (cdr found)))
880 (calc-embedded-active-state 'more)))
881 info))
882
883 (defun calc-embedded-find-vars (x)
884 (cond ((Math-primp x)
885 (and (eq (car-safe x) 'var)
886 (not (assoc x calc-embed-vars-used))
887 (setq calc-embed-vars-used (cons (list x) calc-embed-vars-used))))
888 ((eq (car x) 'calcFunc-evalto)
889 (calc-embedded-find-vars (nth 1 x)))
890 ((eq (car x) 'calcFunc-assign)
891 (calc-embedded-find-vars (nth 2 x)))
892 (t
893 (and (eq (car x) 'calcFunc-subscr)
894 (eq (car-safe (nth 1 x)) 'var)
895 (Math-primp (nth 2 x))
896 (not (assoc x calc-embed-vars-used))
897 (setq calc-embed-vars-used (cons (list x) calc-embed-vars-used)))
898 (while (setq x (cdr x))
899 (calc-embedded-find-vars (car x))))))
900
901 (defvar math-ms-args)
902 (defun calc-embedded-evaluate-expr (x)
903 (let ((calc-embed-vars-used (aref calc-embedded-info 10)))
904 (or calc-embed-vars-used (calc-embedded-find-vars x))
905 (if calc-embed-vars-used
906 (let ((active (assq (aref calc-embedded-info 0) calc-embedded-active))
907 (math-ms-args nil))
908 (save-excursion
909 (calc-embedded-original-buffer t)
910 (or active
911 (progn
912 (calc-embedded-activate)
913 (setq active (assq (aref calc-embedded-info 0)
914 calc-embedded-active))))
915 (while calc-embed-vars-used
916 (calc-embedded-eval-get-var (car (car calc-embed-vars-used)) active)
917 (setq calc-embed-vars-used (cdr calc-embed-vars-used))))
918 (calc-embedded-subst x))
919 (calc-normalize (math-evaluate-expr-rec x)))))
920
921 (defun calc-embedded-subst (x)
922 (if (and (eq (car-safe x) 'calcFunc-evalto) (cdr x))
923 (let ((rhs (calc-embedded-subst (nth 1 x))))
924 (list 'calcFunc-evalto
925 (nth 1 x)
926 (if (eq (car-safe rhs) 'calcFunc-assign) (nth 2 rhs) rhs)))
927 (if (and (eq (car-safe x) 'calcFunc-assign) (= (length x) 3))
928 (list 'calcFunc-assign
929 (nth 1 x)
930 (calc-embedded-subst (nth 2 x)))
931 (calc-normalize (math-evaluate-expr-rec (math-multi-subst-rec x))))))
932
933 (defun calc-embedded-eval-get-var (var base)
934 (let ((entry base)
935 (point (aref calc-embedded-info 2))
936 (last nil)
937 val)
938 (while (and (setq entry (cdr entry))
939 (or (not (equal var (aref (car entry) 9)))
940 (and (> point (aref (car entry) 3))
941 (setq last entry)))))
942 (if last
943 (setq entry last))
944 (if entry
945 (progn
946 (setq entry (car entry))
947 (if (equal (buffer-substring (aref entry 2) (aref entry 3))
948 (aref entry 6))
949 (progn
950 (or (aref entry 11)
951 (save-excursion
952 (calc-embedded-update entry 14 t nil)))
953 (setq val (aref entry 11))
954 (if (eq (car-safe val) 'calcFunc-evalto)
955 (setq val (nth 2 val)))
956 (if (eq (car-safe val) 'calcFunc-assign)
957 (setq val (nth 2 val)))
958 (setq math-ms-args (cons (cons var val) math-ms-args)))
959 (calc-embedded-activate)
960 (calc-embedded-eval-get-var var base))))))
961
962
963 (defun calc-embedded-update (info which need-eval need-display
964 &optional str entry old-val)
965 (let* ((calc-embed-prev-modes nil)
966 (open-plain calc-embedded-open-plain)
967 (close-plain calc-embedded-close-plain)
968 (calc-embed-vars-used nil)
969 (evalled nil)
970 (val (aref info 8))
971 (old-eval (aref info 11)))
972 (or old-val (setq old-val val))
973 (if (eq (car-safe val) 'calcFunc-evalto)
974 (setq need-display t))
975 (unwind-protect
976 (progn
977 (set-buffer (aref info 1))
978 (and which
979 (calc-embedded-set-modes (aref info 15) (aref info 12)
980 (aref info which)
981 (if need-display 'full t)))
982 (if (memq (car-safe val) '(calcFunc-evalto calcFunc-assign))
983 (calc-embedded-find-vars val))
984 (if need-eval
985 (let ((calc-embedded-info info))
986 (setq val (math-evaluate-expr val)
987 evalled val)))
988 (if (or (eq need-eval 'eval) (eq (car-safe val) 'calcFunc-evalto))
989 (aset info 8 val))
990 (aset info 9 nil)
991 (aset info 10 calc-embed-vars-used)
992 (aset info 11 nil)
993 (if (or need-display (eq (car-safe val) 'calcFunc-evalto))
994 (let ((extra (if (eq calc-language 'big) 1 0)))
995 (or entry (setq entry (list val 1 nil)))
996 (or str (progn
997 (setq str (let ((calc-line-numbering nil))
998 (math-format-stack-value entry)))
999 (if (eq calc-language 'big)
1000 (setq str (substring str 0 -1)))))
1001 (and calc-show-plain
1002 (setq str (concat open-plain
1003 (math-showing-full-precision
1004 (math-format-flat-expr val 0))
1005 close-plain
1006 str)))
1007 (save-excursion
1008 (calc-embedded-original-buffer t info)
1009 (or (equal str (aref info 6))
1010 (let ((delta (- (aref info 5) (aref info 3)))
1011 (adjbot 0)
1012 (buffer-read-only nil))
1013 (goto-char (aref info 2))
1014 (delete-region (point) (aref info 3))
1015 (and (> (nth 1 entry) (1+ extra))
1016 (aref info 7)
1017 (progn
1018 (delete-horizontal-space)
1019 (if (looking-at "\n")
1020 ;; If there's a newline there, don't add one
1021 (insert "\n")
1022 (insert "\n\n")
1023 (delete-horizontal-space)
1024 (setq adjbot 1)
1025 ; (setq delta (1+ delta))
1026 (backward-char 1))))
1027 (insert str)
1028 (set-marker (aref info 3) (+ (point) adjbot))
1029 (set-marker (aref info 5) (+ (point) delta))
1030 (aset info 6 str))))))
1031 (if (eq (car-safe val) 'calcFunc-evalto)
1032 (progn
1033 (setq evalled (nth 2 val)
1034 val (nth 1 val))))
1035 (if (eq (car-safe val) 'calcFunc-assign)
1036 (progn
1037 (aset info 9 (nth 1 val))
1038 (aset info 11 (or evalled
1039 (let ((calc-embedded-info info))
1040 (math-evaluate-expr (nth 2 val)))))
1041 (or (equal old-eval (aref info 11))
1042 (calc-embedded-var-change (nth 1 val) (aref info 0))))
1043 (if (eq (car-safe old-val) 'calcFunc-evalto)
1044 (setq old-val (nth 1 old-val)))
1045 (if (eq (car-safe old-val) 'calcFunc-assign)
1046 (calc-embedded-var-change (nth 1 old-val) (aref info 0)))))
1047 (set-buffer (aref info 1))
1048 (while calc-embed-prev-modes
1049 (cond ((eq (car (car calc-embed-prev-modes)) 'the-language)
1050 (if need-display
1051 (calc-embedded-set-language (cdr (car calc-embed-prev-modes)))))
1052 ((eq (car (car calc-embed-prev-modes)) 'the-display-just)
1053 (if need-display
1054 (calc-embedded-set-justify (cdr (car calc-embed-prev-modes)))))
1055 (t
1056 (set (car (car calc-embed-prev-modes))
1057 (cdr (car calc-embed-prev-modes)))))
1058 (setq calc-embed-prev-modes (cdr calc-embed-prev-modes))))))
1059
1060
1061
1062
1063 ;;; These are hooks called by the main part of Calc.
1064
1065 (defvar calc-embedded-no-reselect nil)
1066 (defun calc-embedded-select-buffer ()
1067 (if (eq (current-buffer) (aref calc-embedded-info 0))
1068 (let ((info calc-embedded-info)
1069 horiz vert)
1070 (if (and (or (< (point) (aref info 4))
1071 (> (point) (aref info 5)))
1072 (not calc-embedded-no-reselect))
1073 (let ((calc-embedded-quiet t))
1074 (message "(Switching Calc Embedded mode to new formula.)")
1075 (calc-embedded nil)
1076 (calc-embedded nil)))
1077 (setq horiz (max (min (current-column) (- (point) (aref info 2))) 0)
1078 vert (if (<= (aref info 2) (point))
1079 (- (count-lines (aref info 2) (point))
1080 (if (bolp) 0 1))
1081 0))
1082 (set-buffer (aref info 1))
1083 (if calc-show-plain
1084 (if (= vert 0)
1085 (setq horiz 0)
1086 (setq vert (1- vert))))
1087 (calc-cursor-stack-index 1)
1088 (if calc-line-numbering
1089 (setq horiz (+ horiz 4)))
1090 (if (> vert 0)
1091 (forward-line vert))
1092 (forward-char (min horiz
1093 (- (point-max) (point)))))
1094 (calc-select-buffer)))
1095
1096 (defun calc-embedded-finish-command ()
1097 (let ((buf (current-buffer))
1098 horiz vert)
1099 (save-excursion
1100 (set-buffer (aref calc-embedded-info 1))
1101 (if (> (calc-stack-size) 0)
1102 (let ((pt (point))
1103 (col (current-column))
1104 (bol (bolp)))
1105 (calc-cursor-stack-index 0)
1106 (if (< pt (point))
1107 (progn
1108 (calc-cursor-stack-index 1)
1109 (if (>= pt (point))
1110 (progn
1111 (setq horiz (- col (if calc-line-numbering 4 0))
1112 vert (- (count-lines (point) pt)
1113 (if bol 0 1)))
1114 (if calc-show-plain
1115 (setq vert (max 1 (1+ vert))))))))
1116 (goto-char pt))))
1117 (if horiz
1118 (progn
1119 (set-buffer (aref calc-embedded-info 0))
1120 (goto-char (aref calc-embedded-info 2))
1121 (if (> vert 0)
1122 (forward-line vert))
1123 (forward-char (max horiz 0))
1124 (set-buffer buf)))))
1125
1126 (defun calc-embedded-stack-change ()
1127 (or calc-executing-macro
1128 (save-excursion
1129 (set-buffer (aref calc-embedded-info 1))
1130 (let* ((info calc-embedded-info)
1131 (extra-line (if (eq calc-language 'big) 1 0))
1132 (the-point (point))
1133 (empty (= (calc-stack-size) 0))
1134 (entry (if empty
1135 (list '(var empty var-empty) 1 nil)
1136 (calc-top 1 'entry)))
1137 (old-val (aref info 8))
1138 top bot str)
1139 (if empty
1140 (setq str "empty")
1141 (save-excursion
1142 (calc-cursor-stack-index 1)
1143 (setq top (point))
1144 (calc-cursor-stack-index 0)
1145 (setq bot (- (point) extra-line))
1146 (setq str (buffer-substring top (- bot 1))))
1147 (if calc-line-numbering
1148 (let ((pos 0))
1149 (setq str (substring str 4))
1150 (while (setq pos (string-match "\n...." str pos))
1151 (setq str (concat (substring str 0 (1+ pos))
1152 (substring str (+ pos 5)))
1153 pos (1+ pos))))))
1154 (calc-embedded-original-buffer t)
1155 (aset info 8 (car entry))
1156 (calc-embedded-update info 13 nil t str entry old-val)))))
1157
1158 (defun calc-embedded-mode-line-change ()
1159 (let ((str mode-line-buffer-identification))
1160 (save-excursion
1161 (calc-embedded-original-buffer t)
1162 (setq mode-line-buffer-identification str)
1163 (set-buffer-modified-p (buffer-modified-p)))))
1164
1165 (defun calc-embedded-modes-change (vars)
1166 (if (eq (car vars) 'calc-language) (setq vars '(the-language)))
1167 (if (eq (car vars) 'calc-display-just) (setq vars '(the-display-just)))
1168 (while (and vars
1169 (not (rassq (car vars) calc-embedded-mode-vars)))
1170 (setq vars (cdr vars)))
1171 (if (and vars calc-mode-save-mode (not (eq calc-mode-save-mode 'save)))
1172 (save-excursion
1173 (let* ((save-mode calc-mode-save-mode)
1174 (header (if (eq save-mode 'local)
1175 "calc-mode:"
1176 (format "calc-%s-mode:" save-mode)))
1177 (the-language (calc-embedded-language))
1178 (the-display-just (calc-embedded-justify))
1179 (values (mapcar 'symbol-value vars))
1180 (num (cond ((eq save-mode 'local) 12)
1181 ((eq save-mode 'edit) 13)
1182 ((eq save-mode 'perm) 14)
1183 (t nil)))
1184 base limit mname mlist)
1185 (calc-embedded-original-buffer t)
1186 (save-excursion
1187 (if (eq save-mode 'global)
1188 (setq base (point-max)
1189 limit (point-min)
1190 mlist calc-embedded-globals)
1191 (goto-char (aref calc-embedded-info 4))
1192 (beginning-of-line)
1193 (setq base (point)
1194 limit (max (- (point) 1000) (point-min))
1195 mlist (and num (aref calc-embedded-info num)))
1196 (and (re-search-backward
1197 (format "\\(%s\\)[^\001]*\\(%s\\)\\|\\[calc-defaults]"
1198 calc-embedded-open-formula
1199 calc-embedded-close-formula) limit t)
1200 (setq limit (point))))
1201 (while vars
1202 (goto-char base)
1203 (if (setq mname (car (rassq (car vars)
1204 calc-embedded-mode-vars)))
1205 (let ((buffer-read-only nil)
1206 (found (assq (car vars) mlist)))
1207 (if found
1208 (setcdr found (car values))
1209 (setq mlist (cons (cons (car vars) (car values)) mlist))
1210 (if num
1211 (aset calc-embedded-info num mlist)
1212 (if (eq save-mode 'global)
1213 (setq calc-embedded-globals mlist))))
1214 (if (re-search-backward
1215 (format "\\[%s *%s: *\\(\"\\([^\"\n\\]\\|\\\\.\\)*\"\\|[- ()a-zA-Z0-9]+\\)]"
1216 header mname)
1217 limit t)
1218 (progn
1219 (goto-char (match-beginning 1))
1220 (delete-region (point) (match-end 1))
1221 (insert (prin1-to-string (car values))))
1222 (goto-char base)
1223 (insert-before-markers
1224 calc-embedded-open-mode
1225 "[" header " " mname ": "
1226 (prin1-to-string (car values)) "]"
1227 calc-embedded-close-mode))))
1228 (setq vars (cdr vars)
1229 values (cdr values))))))
1230 (when (and vars (eq calc-mode-save-mode 'save))
1231 (calc-embedded-save-original-modes))))
1232
1233 (defun calc-embedded-var-change (var &optional buf)
1234 (if (symbolp var)
1235 (setq var (list 'var
1236 (if (string-match "\\`var-.+\\'"
1237 (symbol-name var))
1238 (intern (substring (symbol-name var) 4))
1239 var)
1240 var)))
1241 (save-excursion
1242 (let ((manual (not calc-auto-recompute))
1243 (bp calc-embedded-active)
1244 (first t))
1245 (if buf (setq bp (memq (assq buf bp) bp)))
1246 (while bp
1247 (let ((calc-embedded-no-reselect t)
1248 (p (and (buffer-name (car (car bp)))
1249 (cdr (car bp)))))
1250 (while p
1251 (if (assoc var (aref (car p) 10))
1252 (if manual
1253 (if (aref (car p) 11)
1254 (progn
1255 (aset (car p) 11 nil)
1256 (if (aref (car p) 9)
1257 (calc-embedded-var-change (aref (car p) 9)))))
1258 (set-buffer (aref (car p) 0))
1259 (if (equal (buffer-substring (aref (car p) 2)
1260 (aref (car p) 3))
1261 (aref (car p) 6))
1262 (let ((calc-embedded-info nil))
1263 (or calc-embedded-quiet
1264 (message "Recomputing..."))
1265 (setq first nil)
1266 (calc-wrapper
1267 (set-buffer (aref (car p) 0))
1268 (calc-embedded-update (car p) 14 t nil)))
1269 (setcdr (car bp) (delq (car p) (cdr (car bp))))
1270 (message
1271 "(Tried to recompute but formula was changed or missing)"))))
1272 (setq p (cdr p))))
1273 (setq bp (if buf nil (cdr bp))))
1274 (or first calc-embedded-quiet (message "")))))
1275
1276 (provide 'calc-embed)
1277
1278 ;;; arch-tag: 1b8f311e-fba1-40d3-b8c3-1d6f68fd26fc
1279 ;;; calc-embed.el ends here