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