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