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