]> code.delx.au - gnu-emacs/blob - lisp/calc/calc-embed.el
merging Emacs.app (NeXTstep port)
[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 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 (defun calc-show-plain (n)
34 (interactive "P")
35 (calc-wrapper
36 (calc-set-command-flag 'renum-stack)
37 (message (if (calc-change-mode 'calc-show-plain n nil t)
38 "Including \"plain\" formulas in Calc Embedded mode"
39 "Omitting \"plain\" formulas in Calc Embedded mode"))))
40
41
42 (defvar calc-embedded-modes nil)
43 (defvar calc-embedded-globals nil)
44 (defvar calc-embedded-active nil)
45 (defvar calc-embedded-all-active nil)
46 (make-variable-buffer-local 'calc-embedded-all-active)
47 (defvar calc-embedded-some-active nil)
48 (make-variable-buffer-local 'calc-embedded-some-active)
49
50 ;; The following variables are customizable and defined in calc.el.
51 (defvar calc-embedded-announce-formula)
52 (defvar calc-embedded-open-formula)
53 (defvar calc-embedded-close-formula)
54 (defvar calc-embedded-open-word)
55 (defvar calc-embedded-close-word)
56 (defvar calc-embedded-open-plain)
57 (defvar calc-embedded-close-plain)
58 (defvar calc-embedded-open-new-formula)
59 (defvar calc-embedded-close-new-formula)
60 (defvar calc-embedded-open-mode)
61 (defvar calc-embedded-close-mode)
62
63 (defconst calc-embedded-mode-vars '(("precision" . calc-internal-prec)
64 ("word-size" . calc-word-size)
65 ("angles" . calc-angle-mode)
66 ("symbolic" . calc-symbolic-mode)
67 ("matrix" . calc-matrix-mode)
68 ("fractions" . calc-prefer-frac)
69 ("complex" . calc-complex-mode)
70 ("simplify" . calc-simplify-mode)
71 ("language" . the-language)
72 ("plain" . calc-show-plain)
73 ("break" . calc-line-breaking)
74 ("justify" . the-display-just)
75 ("left-label" . calc-left-label)
76 ("right-label" . calc-right-label)
77 ("radix" . calc-number-radix)
78 ("leading-zeros" . calc-leading-zeros)
79 ("grouping" . calc-group-digits)
80 ("group-char" . calc-group-char)
81 ("point-char" . calc-point-char)
82 ("frac-format" . calc-frac-format)
83 ("float-format" . calc-float-format)
84 ("complex-format" . calc-complex-format)
85 ("hms-format" . calc-hms-format)
86 ("date-format" . calc-date-format)
87 ("matrix-justify" . calc-matrix-just)
88 ("full-vectors" . calc-full-vectors)
89 ("break-vectors" . calc-break-vectors)
90 ("vector-commas" . calc-vector-commas)
91 ("vector-brackets" . calc-vector-brackets)
92 ("matrix-brackets" . calc-matrix-brackets)
93 ("strings" . calc-display-strings)
94 ))
95
96
97 ;; Format of calc-embedded-info vector:
98 ;; 0 Editing buffer.
99 ;; 1 Calculator buffer.
100 ;; 2 Top of current formula (marker).
101 ;; 3 Bottom of current formula (marker).
102 ;; 4 Top of current formula's delimiters (marker).
103 ;; 5 Bottom of current formula's delimiters (marker).
104 ;; 6 String representation of current formula.
105 ;; 7 Non-nil if formula is embedded within a single line.
106 ;; 8 Internal representation of current formula.
107 ;; 9 Variable assigned by this formula, or nil.
108 ;; 10 List of variables upon which this formula depends.
109 ;; 11 Evaluated value of the formula, or nil.
110 ;; 12 Mode settings for current formula.
111 ;; 13 Local mode settings for current formula.
112 ;; 14 Permanent mode settings for current formula.
113 ;; 15 Global mode settings for editing buffer.
114
115
116 ;; calc-embedded-active is an a-list keyed on buffers; each cdr is a
117 ;; sorted list of calc-embedded-infos in that buffer. We do this
118 ;; rather than using buffer-local variables because the latter are
119 ;; thrown away when a buffer changes major modes.
120
121 (defvar calc-embedded-original-modes nil
122 "The mode settings for Calc buffer when put in embedded mode.")
123
124 (defun calc-embedded-save-original-modes ()
125 "Save the current Calc modes when entereding embedded mode."
126 (let ((calcbuf (save-excursion
127 (calc-create-buffer)
128 (current-buffer)))
129 lang modes)
130 (if calcbuf
131 (with-current-buffer calcbuf
132 (setq lang
133 (cons calc-language calc-language-option))
134 (setq modes
135 (list (cons 'calc-display-just
136 calc-display-just)
137 (cons 'calc-display-origin
138 calc-display-origin)))
139 (let ((v calc-embedded-mode-vars))
140 (while v
141 (let ((var (cdr (car v))))
142 (unless (memq var '(the-language the-display-just))
143 (setq modes
144 (cons (cons var (symbol-value var))
145 modes))))
146 (setq v (cdr v))))
147 (setq calc-embedded-original-modes (cons lang modes)))
148 (setq calc-embedded-original-modes nil))))
149
150 (defun calc-embedded-preserve-modes ()
151 "Preserve the current modes when leaving embedded mode."
152 (interactive)
153 (if calc-embedded-info
154 (progn
155 (calc-embedded-save-original-modes)
156 (message "Current modes will be preserved when leaving embedded mode."))
157 (message "Not in embedded mode.")))
158
159 (defun calc-embedded-restore-original-modes ()
160 "Restore the original Calc modes when leaving embedded mode."
161 (let ((calcbuf (get-buffer "*Calculator*"))
162 (changed nil)
163 (lang (car calc-embedded-original-modes))
164 (modes (cdr calc-embedded-original-modes)))
165 (if (and calcbuf calc-embedded-original-modes)
166 (with-current-buffer calcbuf
167 (unless (and
168 (equal calc-language (car lang))
169 (equal calc-language-option (cdr lang)))
170 (calc-set-language (car lang) (cdr lang))
171 (setq changed t))
172 (while modes
173 (let ((mode (car modes)))
174 (unless (equal (symbol-value (car mode)) (cdr mode))
175 (set (car mode) (cdr mode))
176 (setq changed t)))
177 (setq modes (cdr modes)))
178 (when changed
179 (calc-refresh)
180 (calc-set-mode-line))))
181 (setq calc-embedded-original-modes nil)))
182
183 ;; The variables calc-embed-outer-top, calc-embed-outer-bot,
184 ;; calc-embed-top and calc-embed-bot are
185 ;; local to calc-do-embedded, calc-embedded-mark-formula,
186 ;; calc-embedded-duplicate, calc-embedded-new-formula and
187 ;; calc-embedded-make-info, but are used by calc-embedded-find-bounds,
188 ;; which is called (directly or indirectly) by the above functions.
189 (defvar calc-embed-outer-top)
190 (defvar calc-embed-outer-bot)
191 (defvar calc-embed-top)
192 (defvar calc-embed-bot)
193
194 ;; The variable calc-embed-arg is local to calc-do-embedded,
195 ;; calc-embedded-update-formula, calc-embedded-edit and
196 ;; calc-do-embedded-activate, but is used by
197 ;; calc-embedded-make-info, which is called by the above
198 ;; functions.
199 (defvar calc-embed-arg)
200
201 (defvar calc-embedded-quiet nil)
202
203 (defvar calc-embedded-firsttime)
204 (defvar calc-embedded-firsttime-buf)
205 (defvar calc-embedded-firsttime-formula)
206
207 ;; The following is to take care of any minor modes which override
208 ;; a Calc command.
209 (defvar calc-override-minor-modes-map
210 (make-sparse-keymap)
211 "A list of keybindings that might be overwritten by minor modes.")
212
213 ;; Add any keys that might be overwritten here.
214 (define-key calc-override-minor-modes-map "`" 'calc-edit)
215
216 (defvar calc-override-minor-modes
217 (cons t calc-override-minor-modes-map))
218
219 (defun calc-do-embedded (calc-embed-arg end obeg oend)
220 (if calc-embedded-info
221
222 ;; Turn embedded mode off or switch to a new buffer.
223 (cond ((eq (current-buffer) (aref calc-embedded-info 1))
224 (let ((calcbuf (current-buffer))
225 (buf (aref calc-embedded-info 0)))
226 (calc-embedded-original-buffer t)
227 (calc-embedded nil)
228 (switch-to-buffer calcbuf)))
229
230 ((eq (current-buffer) (aref calc-embedded-info 0))
231 (let* ((info calc-embedded-info)
232 (mode calc-embedded-modes))
233 (save-excursion
234 (set-buffer (aref info 1))
235 (if (and (> (calc-stack-size) 0)
236 (equal (calc-top 1 'full) (aref info 8)))
237 (let ((calc-no-refresh-evaltos t))
238 (if (calc-top 1 'sel)
239 (calc-unselect 1))
240 (calc-embedded-set-modes
241 (aref info 15) (aref info 12) (aref info 14))
242 (let ((calc-embedded-info nil))
243 (calc-wrapper (calc-pop-stack))))
244 (calc-set-mode-line)))
245 (setq calc-embedded-info nil
246 mode-line-buffer-identification (car mode)
247 truncate-lines (nth 2 mode)
248 buffer-read-only nil)
249 (use-local-map (nth 1 mode))
250 (setq minor-mode-overriding-map-alist
251 (remq calc-override-minor-modes minor-mode-overriding-map-alist))
252 (set-buffer-modified-p (buffer-modified-p))
253 (calc-embedded-restore-original-modes)
254 (or calc-embedded-quiet
255 (message "Back to %s mode" (format-mode-line mode-name)))))
256
257 (t
258 (if (buffer-name (aref calc-embedded-info 0))
259 (save-excursion
260 (set-buffer (aref calc-embedded-info 0))
261 (or (y-or-n-p (format "Cancel Calc Embedded mode in buffer %s? "
262 (buffer-name)))
263 (keyboard-quit))
264 (calc-embedded nil)))
265 (calc-embedded calc-embed-arg end obeg oend)))
266
267 ;; Turn embedded mode on.
268 (calc-plain-buffer-only)
269 (let ((modes (list mode-line-buffer-identification
270 (current-local-map)
271 truncate-lines))
272 (calc-embedded-firsttime (not calc-embedded-active))
273 (calc-embedded-firsttime-buf nil)
274 (calc-embedded-firsttime-formula nil)
275 calc-embed-top calc-embed-bot calc-embed-outer-top calc-embed-outer-bot
276 info chg ident)
277 (barf-if-buffer-read-only)
278 (calc-embedded-save-original-modes)
279 (or calc-embedded-globals
280 (calc-find-globals))
281 (setq info
282 (calc-embedded-make-info (point) nil t calc-embed-arg end obeg oend))
283 (if (eq (car-safe (aref info 8)) 'error)
284 (progn
285 (setq calc-embedded-original-modes nil)
286 (goto-char (nth 1 (aref info 8)))
287 (error (nth 2 (aref info 8)))))
288 (let ((mode-line-buffer-identification mode-line-buffer-identification)
289 (calc-embedded-info info)
290 (calc-embedded-no-reselect t))
291 (calc-wrapper
292 (let* ((okay nil)
293 (calc-no-refresh-evaltos t))
294 (if (aref info 8)
295 (progn
296 (calc-push (calc-normalize (aref info 8)))
297 (setq chg (calc-embedded-set-modes
298 (aref info 15) (aref info 12) (aref info 13))))
299 (setq chg (calc-embedded-set-modes
300 (aref info 15) (aref info 12) (aref info 13)))
301 (calc-alg-entry)))
302 (setq calc-undo-list nil
303 calc-redo-list nil
304 ident mode-line-buffer-identification)))
305 (setq calc-embedded-info info
306 calc-embedded-modes modes
307 mode-line-buffer-identification ident
308 truncate-lines t
309 buffer-read-only t)
310 (set-buffer-modified-p (buffer-modified-p))
311 (use-local-map calc-mode-map)
312 (setq minor-mode-overriding-map-alist
313 (cons calc-override-minor-modes
314 minor-mode-overriding-map-alist))
315 (setq calc-no-refresh-evaltos nil)
316 (and chg calc-any-evaltos (calc-wrapper (calc-refresh-evaltos)))
317 (let (str)
318 (save-excursion
319 (calc-select-buffer)
320 (setq str mode-line-buffer-identification))
321 (unless (equal str mode-line-buffer-identification)
322 (setq mode-line-buffer-identification str)
323 (set-buffer-modified-p (buffer-modified-p))))
324 (if calc-embedded-firsttime
325 (run-hooks 'calc-embedded-mode-hook))
326 (if calc-embedded-firsttime-buf
327 (run-hooks 'calc-embedded-new-buffer-hook))
328 (if calc-embedded-firsttime-formula
329 (run-hooks 'calc-embedded-new-formula-hook))
330 (or (eq calc-embedded-quiet t)
331 (message "Embedded Calc mode enabled; %s to return to normal"
332 (if calc-embedded-quiet
333 "Type `C-x * x'"
334 "Give this command again")))))
335 (scroll-down 0)) ; fix a bug which occurs when truncate-lines is changed.
336
337
338 (defun calc-embedded-select (arg)
339 (interactive "P")
340 (calc-embedded arg)
341 (and calc-embedded-info
342 (eq (car-safe (aref calc-embedded-info 8)) 'calcFunc-evalto)
343 (calc-select-part 1))
344 (and calc-embedded-info
345 (or (eq (car-safe (aref calc-embedded-info 8)) 'calcFunc-assign)
346 (and (eq (car-safe (aref calc-embedded-info 8)) 'calcFunc-evalto)
347 (eq (car-safe (nth 1 (aref calc-embedded-info 8)))
348 'calcFunc-assign)))
349 (calc-select-part 2)))
350
351
352 (defun calc-embedded-update-formula (calc-embed-arg)
353 (interactive "P")
354 (if calc-embed-arg
355 (let ((entry (assq (current-buffer) calc-embedded-active)))
356 (while (setq entry (cdr entry))
357 (and (eq (car-safe (aref (car entry) 8)) 'calcFunc-evalto)
358 (or (not (consp calc-embed-arg))
359 (and (<= (aref (car entry) 2) (region-beginning))
360 (>= (aref (car entry) 3) (region-end))))
361 (save-excursion
362 (calc-embedded-update (car entry) 14 t t)))))
363 (if (and calc-embedded-info
364 (eq (current-buffer) (aref calc-embedded-info 0))
365 (>= (point) (aref calc-embedded-info 4))
366 (<= (point) (aref calc-embedded-info 5)))
367 (calc-evaluate 1)
368 (let* ((opt (point))
369 (info (calc-embedded-make-info (point) nil t))
370 (pt (- opt (aref info 4))))
371 (or (eq (car-safe (aref info 8)) 'error)
372 (progn
373 (save-excursion
374 (calc-embedded-update info 14 'eval t))
375 (goto-char (+ (aref info 4) pt))))))))
376
377
378 (defun calc-embedded-edit (calc-embed-arg)
379 (interactive "P")
380 (let ((info (calc-embedded-make-info (point) nil t calc-embed-arg))
381 str)
382 (if (eq (car-safe (aref info 8)) 'error)
383 (progn
384 (goto-char (nth 1 (aref info 8)))
385 (error (nth 2 (aref info 8)))))
386 (calc-wrapper
387 (setq str (math-showing-full-precision
388 (math-format-nice-expr (aref info 8) (frame-width))))
389 (calc-edit-mode (list 'calc-embedded-finish-edit info))
390 (insert str "\n")))
391 (calc-show-edit-buffer))
392
393 (defvar calc-original-buffer)
394 (defvar calc-edit-top)
395 (defun calc-embedded-finish-edit (info)
396 (let ((buf (current-buffer))
397 (str (buffer-substring calc-edit-top (point-max)))
398 (start (point))
399 pos)
400 (switch-to-buffer calc-original-buffer)
401 (let ((val (save-excursion
402 (set-buffer (aref info 1))
403 (let ((calc-language nil)
404 (math-expr-opers (math-standard-ops)))
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)
413 (calc-embedded-update info 14 t t))))
414
415 ;;;###autoload
416 (defun calc-do-embedded-activate (calc-embed-arg cbuf)
417 (calc-plain-buffer-only)
418 (if calc-embed-arg
419 (calc-embedded-forget))
420 (calc-find-globals)
421 (if (< (prefix-numeric-value calc-embed-arg) 0)
422 (message "Deactivating %s for Calc Embedded mode" (buffer-name))
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)
437 ;;; (if (looking-at calc-embedded-open-formula)
438 ;;; (goto-char (match-end 1)))
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)))
443 (calc-embedded-active-state t))
444
445 (defun calc-plain-buffer-only ()
446 (if (memq major-mode '(calc-mode calc-trail-mode calc-edit-mode))
447 (error "This command should be used in a normal editing buffer")))
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))))
461 (set-buffer-modified-p (buffer-modified-p)))
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
470 (set-buffer (aref info 0))))
471
472 (defun calc-embedded-word ()
473 (interactive)
474 (calc-embedded '(t)))
475
476 (defun calc-embedded-mark-formula (&optional body-only)
477 "Put point at the beginning of this Calc formula, mark at the end.
478 This normally marks the whole formula, including surrounding delimiters.
479 With 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"))
483 (let (calc-embed-top calc-embed-bot calc-embed-outer-top calc-embed-outer-bot)
484 (save-excursion
485 (calc-embedded-find-bounds body-only))
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))))
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))
502 (setq calc-embed-outer-top (point))
503 (goto-char (match-end 0))
504 (if (looking-at "[ \t]*$")
505 (end-of-line))
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))))
516 (setq calc-embed-top (point))
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))
523 (setq calc-embed-outer-bot (point))
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)))
530 (setq calc-embed-bot (point))))
531
532 (defun calc-embedded-kill-formula ()
533 "Kill the formula surrounding point.
534 If Calc Embedded mode was active, this deactivates it.
535 The formula (including its surrounding delimiters) is saved in the kill ring.
536 The 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))
542 (pop-mark))
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))
550 (pop-mark)))
551
552 (defun calc-embedded-duplicate ()
553 (interactive)
554 (let ((already calc-embedded-info)
555 calc-embed-top calc-embed-bot calc-embed-outer-top calc-embed-outer-bot new-top)
556 (if calc-embedded-info
557 (progn
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)))
562 (calc-embedded nil))
563 (calc-embedded-find-bounds))
564 (goto-char calc-embed-outer-bot)
565 (insert "\n")
566 (setq new-top (point))
567 (insert-buffer-substring (current-buffer)
568 calc-embed-outer-top calc-embed-outer-bot)
569 (goto-char (+ new-top (- calc-embed-top calc-embed-outer-top)))
570 (let ((calc-embedded-quiet (if already t 'x)))
571 (calc-embedded (+ new-top (- calc-embed-top calc-embed-outer-top))
572 (+ new-top (- calc-embed-bot calc-embed-outer-top))
573 new-top
574 (+ new-top (- calc-embed-outer-bot calc-embed-outer-top))))))
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))))
601 (goto-char (aref (car (or p active)) 2))))))
602
603 (defun calc-embedded-previous (arg)
604 (interactive "p")
605 (calc-embedded-next (- (prefix-numeric-value arg))))
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))
613 (let (calc-embed-top calc-embed-bot calc-embed-outer-top calc-embed-outer-bot)
614 (if (and (eq (preceding-char) ?\n)
615 (string-match "\\`\n" calc-embedded-open-new-formula))
616 (progn
617 (setq calc-embed-outer-top (1- (point)))
618 (forward-char -1)
619 (insert (substring calc-embedded-open-new-formula 1)))
620 (setq calc-embed-outer-top (point))
621 (insert calc-embedded-open-new-formula))
622 (setq calc-embed-top (point))
623 (insert " ")
624 (setq calc-embed-bot (point))
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))
629 (setq calc-embed-outer-bot (point))
630 (goto-char calc-embed-top)
631 (let ((calc-embedded-quiet 'x))
632 (calc-embedded calc-embed-top calc-embed-bot calc-embed-outer-top calc-embed-outer-bot))))
633
634 (defun calc-embedded-forget ()
635 (interactive)
636 (setq calc-embedded-active (delq (assq (current-buffer) calc-embedded-active)
637 calc-embedded-active))
638 (calc-embedded-active-state nil))
639
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)
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)
658 (setq value (list (nth 1 (assq (car (car v)) calc-mode-var-list)))))
659 (equal (symbol-value (car (car v))) value))
660 (progn
661 (setq changed t)
662 (if temp (setq calc-embed-prev-modes
663 (cons (cons (car (car v))
664 (symbol-value (car (car v))))
665 calc-embed-prev-modes)))
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)
676 (if temp (setq calc-embed-prev-modes (cons (cons (car (car v))
677 (symbol-value (car (car v))))
678 calc-embed-prev-modes)))
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)
687 (if temp (setq calc-embed-prev-modes (cons (cons (car (car v))
688 (symbol-value (car (car v))))
689 calc-embed-prev-modes)))
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)))
704 changed))
705
706 (defun calc-embedded-language ()
707 (if calc-language-option
708 (list calc-language calc-language-option)
709 calc-language))
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))
718 (calc-set-language lang option t))))
719
720 (defun calc-embedded-justify ()
721 (if calc-display-origin
722 (list calc-display-just calc-display-origin)
723 calc-display-just))
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
730 calc-display-origin nil)))
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))
755 (goto-char save-pt)))
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)
804 (unless (assq 'the-language modes)
805 (let ((lang (assoc major-mode calc-language-alist)))
806 (if lang
807 (setq modes (cons (cons 'the-language (cdr lang))
808 modes)))))
809 (list modes emodes pmodes)))
810
811 ;; The variable calc-embed-vars-used is local to calc-embedded-make-info,
812 ;; calc-embedded-evaluate-expr and calc-embedded-update, but is
813 ;; used by calc-embedded-find-vars, which is called by the above functions.
814 (defvar calc-embed-vars-used)
815
816 (defun calc-embedded-make-info (point cbuf fresh &optional
817 calc-embed-top calc-embed-bot
818 calc-embed-outer-top calc-embed-outer-bot)
819 (let* ((bufentry (assq (current-buffer) calc-embedded-active))
820 (found bufentry)
821 (force (and fresh calc-embed-top))
822 (fixed calc-embed-top)
823 (new-info nil)
824 info str)
825 (or found
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))
832 (newword (assoc major-mode calc-embedded-open-close-word-alist))
833 (newplain (assoc major-mode calc-embedded-open-close-plain-alist))
834 (newnewform
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
846 (make-local-variable 'calc-embedded-open-word)
847 (make-local-variable 'calc-embedded-close-word)
848 (setq calc-embedded-open-word (nth 0 (cdr newword)))
849 (setq calc-embedded-close-word (nth 1 (cdr newword))))
850 (when newplain
851 (make-local-variable 'calc-embedded-open-plain)
852 (make-local-variable 'calc-embedded-close-plain)
853 (setq calc-embedded-open-plain (nth 0 (cdr newplain)))
854 (setq calc-embedded-close-plain (nth 1 (cdr newplain))))
855 (when newnewform
856 (make-local-variable 'calc-embedded-open-new-formula)
857 (make-local-variable 'calc-embedded-close-new-formula)
858 (setq calc-embedded-open-new-formula (nth 0 (cdr newnewform)))
859 (setq calc-embedded-close-new-formula (nth 1 (cdr newnewform))))
860 (when newmode
861 (make-local-variable 'calc-embedded-open-mode)
862 (make-local-variable 'calc-embedded-close-mode)
863 (setq calc-embedded-open-mode (nth 0 (cdr newmode)))
864 (setq calc-embedded-close-mode (nth 1 (cdr newmode)))))))
865 (while (and (cdr found)
866 (> point (aref (car (cdr found)) 3)))
867 (setq found (cdr found)))
868 (if (and (cdr found)
869 (>= point (aref (nth 1 found) 2)))
870 (setq info (nth 1 found))
871 (setq calc-embedded-firsttime-formula t)
872 (setq info (make-vector 16 nil)
873 new-info t
874 fresh t)
875 (aset info 0 (current-buffer))
876 (aset info 1 (or cbuf (save-excursion
877 (calc-create-buffer)
878 (current-buffer)))))
879 (if (and
880 (or (integerp calc-embed-top) (equal calc-embed-top '(4)))
881 (not calc-embed-bot))
882 ; started with a user-supplied argument
883 (progn
884 (if (equal calc-embed-top '(4))
885 (progn
886 (aset info 2 (copy-marker (line-beginning-position)))
887 (aset info 3 (copy-marker (line-end-position))))
888 (if (= (setq calc-embed-arg (prefix-numeric-value calc-embed-arg)) 0)
889 (progn
890 (aset info 2 (copy-marker (region-beginning)))
891 (aset info 3 (copy-marker (region-end))))
892 (aset info (if (> calc-embed-arg 0) 2 3) (point-marker))
893 (if (> calc-embed-arg 0)
894 (progn
895 (forward-line (1- calc-embed-arg))
896 (end-of-line))
897 (forward-line (1+ calc-embed-arg)))
898 (aset info (if (> calc-embed-arg 0) 3 2) (point-marker))))
899 (aset info 4 (copy-marker (aref info 2)))
900 (aset info 5 (copy-marker (aref info 3))))
901 (if (aref info 4)
902 (setq calc-embed-top (aref info 2)
903 fixed calc-embed-top)
904 (if (consp calc-embed-top)
905 (let ((calc-embedded-open-formula calc-embedded-open-word)
906 (calc-embedded-close-formula calc-embedded-close-word))
907 (calc-embedded-find-bounds 'plain))
908 (or calc-embed-top
909 (calc-embedded-find-bounds 'plain)))
910 (aset info 2 (copy-marker (min calc-embed-top calc-embed-bot)))
911 (aset info 3 (copy-marker (max calc-embed-top calc-embed-bot)))
912 (aset info 4 (copy-marker (or calc-embed-outer-top (aref info 2))))
913 (aset info 5 (copy-marker (or calc-embed-outer-bot (aref info 3))))))
914 (goto-char (aref info 2))
915 (if new-info
916 (progn
917 (or (bolp) (aset info 7 t))
918 (goto-char (aref info 3))
919 (or (bolp) (eolp) (aset info 7 t))))
920 (if fresh
921 (let ((modes (calc-embedded-find-modes)))
922 (aset info 12 (car modes))
923 (aset info 13 (nth 1 modes))
924 (aset info 14 (nth 2 modes))))
925 (aset info 15 calc-embedded-globals)
926 (setq str (buffer-substring (aref info 2) (aref info 3)))
927 (if (or force
928 (not (equal str (aref info 6))))
929 (if (and fixed (aref info 6))
930 (progn
931 (aset info 4 nil)
932 (calc-embedded-make-info point cbuf nil)
933 (setq new-info nil))
934 (let* ((open-plain calc-embedded-open-plain)
935 (close-plain calc-embedded-close-plain)
936 (pref-len (length open-plain))
937 (calc-embed-vars-used nil)
938 suff-pos val temp)
939 (save-excursion
940 (set-buffer (aref info 1))
941 (calc-embedded-set-modes (aref info 15)
942 (aref info 12) (aref info 14))
943 (if (and (> (length str) pref-len)
944 (equal (substring str 0 pref-len) open-plain)
945 (setq suff-pos (string-match (regexp-quote close-plain)
946 str pref-len)))
947 (setq val (math-read-plain-expr
948 (substring str pref-len suff-pos)))
949 (if (string-match "[^ \t\n]" str)
950 (setq pref-len 0
951 val (condition-case nil
952 (math-read-big-expr str)
953 (error (math-read-expr str))))
954 (setq val nil))))
955 (if (eq (car-safe val) 'error)
956 (setq val (list 'error
957 (+ (aref info 2) pref-len (nth 1 val))
958 (nth 2 val))))
959 (aset info 6 str)
960 (aset info 8 val)
961 (setq temp val)
962 (if (eq (car-safe temp) 'calcFunc-evalto)
963 (setq temp (nth 1 temp))
964 (if (eq (car-safe temp) 'error)
965 (if new-info
966 (setq new-info nil)
967 (setcdr found (delq info (cdr found)))
968 (calc-embedded-active-state 'less))))
969 (aset info 9 (and (eq (car-safe temp) 'calcFunc-assign)
970 (nth 1 temp)))
971 (if (memq (car-safe val) '(calcFunc-evalto calcFunc-assign))
972 (calc-embedded-find-vars val))
973 (aset info 10 calc-embed-vars-used)
974 (aset info 11 nil))))
975 (if new-info
976 (progn
977 (setcdr found (cons info (cdr found)))
978 (calc-embedded-active-state 'more)))
979 info))
980
981 (defun calc-embedded-find-vars (x)
982 (cond ((Math-primp x)
983 (and (eq (car-safe x) 'var)
984 (not (assoc x calc-embed-vars-used))
985 (setq calc-embed-vars-used (cons (list x) calc-embed-vars-used))))
986 ((eq (car x) 'calcFunc-evalto)
987 (calc-embedded-find-vars (nth 1 x)))
988 ((eq (car x) 'calcFunc-assign)
989 (calc-embedded-find-vars (nth 2 x)))
990 (t
991 (and (eq (car x) 'calcFunc-subscr)
992 (eq (car-safe (nth 1 x)) 'var)
993 (Math-primp (nth 2 x))
994 (not (assoc x calc-embed-vars-used))
995 (setq calc-embed-vars-used (cons (list x) calc-embed-vars-used)))
996 (while (setq x (cdr x))
997 (calc-embedded-find-vars (car x))))))
998
999 (defvar math-ms-args)
1000 (defun calc-embedded-evaluate-expr (x)
1001 (let ((calc-embed-vars-used (aref calc-embedded-info 10)))
1002 (or calc-embed-vars-used (calc-embedded-find-vars x))
1003 (if calc-embed-vars-used
1004 (let ((active (assq (aref calc-embedded-info 0) calc-embedded-active))
1005 (math-ms-args nil))
1006 (save-excursion
1007 (calc-embedded-original-buffer t)
1008 (or active
1009 (progn
1010 (calc-embedded-activate)
1011 (setq active (assq (aref calc-embedded-info 0)
1012 calc-embedded-active))))
1013 (while calc-embed-vars-used
1014 (calc-embedded-eval-get-var (car (car calc-embed-vars-used)) active)
1015 (setq calc-embed-vars-used (cdr calc-embed-vars-used))))
1016 (calc-embedded-subst x))
1017 (calc-normalize (math-evaluate-expr-rec x)))))
1018
1019 (defun calc-embedded-subst (x)
1020 (if (and (eq (car-safe x) 'calcFunc-evalto) (cdr x))
1021 (let ((rhs (calc-embedded-subst (nth 1 x))))
1022 (list 'calcFunc-evalto
1023 (nth 1 x)
1024 (if (eq (car-safe rhs) 'calcFunc-assign) (nth 2 rhs) rhs)))
1025 (if (and (eq (car-safe x) 'calcFunc-assign) (= (length x) 3))
1026 (list 'calcFunc-assign
1027 (nth 1 x)
1028 (calc-embedded-subst (nth 2 x)))
1029 (calc-normalize (math-evaluate-expr-rec (math-multi-subst-rec x))))))
1030
1031 (defun calc-embedded-eval-get-var (var base)
1032 (let ((entry base)
1033 (point (aref calc-embedded-info 2))
1034 (last nil)
1035 val)
1036 (while (and (setq entry (cdr entry))
1037 (or (not (equal var (aref (car entry) 9)))
1038 (and (> point (aref (car entry) 3))
1039 (setq last entry)))))
1040 (if last
1041 (setq entry last))
1042 (if entry
1043 (progn
1044 (setq entry (car entry))
1045 (if (equal (buffer-substring (aref entry 2) (aref entry 3))
1046 (aref entry 6))
1047 (progn
1048 (or (aref entry 11)
1049 (save-excursion
1050 (calc-embedded-update entry 14 t nil)))
1051 (setq val (aref entry 11))
1052 (if (eq (car-safe val) 'calcFunc-evalto)
1053 (setq val (nth 2 val)))
1054 (if (eq (car-safe val) 'calcFunc-assign)
1055 (setq val (nth 2 val)))
1056 (setq math-ms-args (cons (cons var val) math-ms-args)))
1057 (calc-embedded-activate)
1058 (calc-embedded-eval-get-var var base))))))
1059
1060
1061 (defun calc-embedded-update (info which need-eval need-display
1062 &optional str entry old-val)
1063 (let* ((calc-embed-prev-modes nil)
1064 (open-plain calc-embedded-open-plain)
1065 (close-plain calc-embedded-close-plain)
1066 (calc-embed-vars-used nil)
1067 (evalled nil)
1068 (val (aref info 8))
1069 (old-eval (aref info 11)))
1070 (or old-val (setq old-val val))
1071 (if (eq (car-safe val) 'calcFunc-evalto)
1072 (setq need-display t))
1073 (unwind-protect
1074 (progn
1075 (set-buffer (aref info 1))
1076 (and which
1077 (calc-embedded-set-modes (aref info 15) (aref info 12)
1078 (aref info which)
1079 (if need-display 'full t)))
1080 (if (memq (car-safe val) '(calcFunc-evalto calcFunc-assign))
1081 (calc-embedded-find-vars val))
1082 (if need-eval
1083 (let ((calc-embedded-info info))
1084 (setq val (math-evaluate-expr val)
1085 evalled val)))
1086 (if (or (eq need-eval 'eval) (eq (car-safe val) 'calcFunc-evalto))
1087 (aset info 8 val))
1088 (aset info 9 nil)
1089 (aset info 10 calc-embed-vars-used)
1090 (aset info 11 nil)
1091 (if (or need-display (eq (car-safe val) 'calcFunc-evalto))
1092 (let ((extra (if (eq calc-language 'big) 1 0)))
1093 (or entry (setq entry (list val 1 nil)))
1094 (or str (progn
1095 (setq str (let ((calc-line-numbering nil))
1096 (math-format-stack-value entry)))
1097 (if (eq calc-language 'big)
1098 (setq str (substring str 0 -1)))))
1099 (and calc-show-plain
1100 (setq str (concat open-plain
1101 (math-showing-full-precision
1102 (math-format-flat-expr val 0))
1103 close-plain
1104 str)))
1105 (save-excursion
1106 (calc-embedded-original-buffer t info)
1107 (or (equal str (aref info 6))
1108 (let ((delta (- (aref info 5) (aref info 3)))
1109 (adjbot 0)
1110 (buffer-read-only nil))
1111 (goto-char (aref info 2))
1112 (delete-region (point) (aref info 3))
1113 (and (> (nth 1 entry) (1+ extra))
1114 (aref info 7)
1115 (progn
1116 (delete-horizontal-space)
1117 (if (looking-at "\n")
1118 ;; If there's a newline there, don't add one
1119 (insert "\n")
1120 (insert "\n\n")
1121 (delete-horizontal-space)
1122 (setq adjbot 1)
1123 ; (setq delta (1+ delta))
1124 (backward-char 1))))
1125 (insert str)
1126 (set-marker (aref info 3) (+ (point) adjbot))
1127 (set-marker (aref info 5) (+ (point) delta))
1128 (aset info 6 str))))))
1129 (if (eq (car-safe val) 'calcFunc-evalto)
1130 (progn
1131 (setq evalled (nth 2 val)
1132 val (nth 1 val))))
1133 (if (eq (car-safe val) 'calcFunc-assign)
1134 (progn
1135 (aset info 9 (nth 1 val))
1136 (aset info 11 (or evalled
1137 (let ((calc-embedded-info info))
1138 (math-evaluate-expr (nth 2 val)))))
1139 (or (equal old-eval (aref info 11))
1140 (calc-embedded-var-change (nth 1 val) (aref info 0))))
1141 (if (eq (car-safe old-val) 'calcFunc-evalto)
1142 (setq old-val (nth 1 old-val)))
1143 (if (eq (car-safe old-val) 'calcFunc-assign)
1144 (calc-embedded-var-change (nth 1 old-val) (aref info 0)))))
1145 (set-buffer (aref info 1))
1146 (while calc-embed-prev-modes
1147 (cond ((eq (car (car calc-embed-prev-modes)) 'the-language)
1148 (if need-display
1149 (calc-embedded-set-language (cdr (car calc-embed-prev-modes)))))
1150 ((eq (car (car calc-embed-prev-modes)) 'the-display-just)
1151 (if need-display
1152 (calc-embedded-set-justify (cdr (car calc-embed-prev-modes)))))
1153 (t
1154 (set (car (car calc-embed-prev-modes))
1155 (cdr (car calc-embed-prev-modes)))))
1156 (setq calc-embed-prev-modes (cdr calc-embed-prev-modes))))))
1157
1158
1159
1160
1161 ;;; These are hooks called by the main part of Calc.
1162
1163 (defvar calc-embedded-no-reselect nil)
1164 (defun calc-embedded-select-buffer ()
1165 (if (eq (current-buffer) (aref calc-embedded-info 0))
1166 (let ((info calc-embedded-info)
1167 horiz vert)
1168 (if (and (or (< (point) (aref info 4))
1169 (> (point) (aref info 5)))
1170 (not calc-embedded-no-reselect))
1171 (let ((calc-embedded-quiet t))
1172 (message "(Switching Calc Embedded mode to new formula.)")
1173 (calc-embedded nil)
1174 (calc-embedded nil)))
1175 (setq horiz (max (min (current-column) (- (point) (aref info 2))) 0)
1176 vert (if (<= (aref info 2) (point))
1177 (- (count-lines (aref info 2) (point))
1178 (if (bolp) 0 1))
1179 0))
1180 (set-buffer (aref info 1))
1181 (if calc-show-plain
1182 (if (= vert 0)
1183 (setq horiz 0)
1184 (setq vert (1- vert))))
1185 (calc-cursor-stack-index 1)
1186 (if calc-line-numbering
1187 (setq horiz (+ horiz 4)))
1188 (if (> vert 0)
1189 (forward-line vert))
1190 (forward-char (min horiz
1191 (- (point-max) (point)))))
1192 (calc-select-buffer)))
1193
1194 (defun calc-embedded-finish-command ()
1195 (let ((buf (current-buffer))
1196 horiz vert)
1197 (save-excursion
1198 (set-buffer (aref calc-embedded-info 1))
1199 (if (> (calc-stack-size) 0)
1200 (let ((pt (point))
1201 (col (current-column))
1202 (bol (bolp)))
1203 (calc-cursor-stack-index 0)
1204 (if (< pt (point))
1205 (progn
1206 (calc-cursor-stack-index 1)
1207 (if (>= pt (point))
1208 (progn
1209 (setq horiz (- col (if calc-line-numbering 4 0))
1210 vert (- (count-lines (point) pt)
1211 (if bol 0 1)))
1212 (if calc-show-plain
1213 (setq vert (max 1 (1+ vert))))))))
1214 (goto-char pt))))
1215 (if horiz
1216 (progn
1217 (set-buffer (aref calc-embedded-info 0))
1218 (goto-char (aref calc-embedded-info 2))
1219 (if (> vert 0)
1220 (forward-line vert))
1221 (forward-char (max horiz 0))
1222 (set-buffer buf)))))
1223
1224 (defun calc-embedded-stack-change ()
1225 (or calc-executing-macro
1226 (save-excursion
1227 (set-buffer (aref calc-embedded-info 1))
1228 (let* ((info calc-embedded-info)
1229 (extra-line (if (eq calc-language 'big) 1 0))
1230 (the-point (point))
1231 (empty (= (calc-stack-size) 0))
1232 (entry (if empty
1233 (list '(var empty var-empty) 1 nil)
1234 (calc-top 1 'entry)))
1235 (old-val (aref info 8))
1236 top bot str)
1237 (if empty
1238 (setq str "empty")
1239 (save-excursion
1240 (calc-cursor-stack-index 1)
1241 (setq top (point))
1242 (calc-cursor-stack-index 0)
1243 (setq bot (- (point) extra-line))
1244 (setq str (buffer-substring top (- bot 1))))
1245 (if calc-line-numbering
1246 (let ((pos 0))
1247 (setq str (substring str 4))
1248 (while (setq pos (string-match "\n...." str pos))
1249 (setq str (concat (substring str 0 (1+ pos))
1250 (substring str (+ pos 5)))
1251 pos (1+ pos))))))
1252 (calc-embedded-original-buffer t)
1253 (aset info 8 (car entry))
1254 (calc-embedded-update info 13 nil t str entry old-val)))))
1255
1256 (defun calc-embedded-mode-line-change ()
1257 (let ((str mode-line-buffer-identification))
1258 (save-excursion
1259 (calc-embedded-original-buffer t)
1260 (setq mode-line-buffer-identification str)
1261 (set-buffer-modified-p (buffer-modified-p)))))
1262
1263 (defun calc-embedded-modes-change (vars)
1264 (if (eq (car vars) 'calc-language) (setq vars '(the-language)))
1265 (if (eq (car vars) 'calc-display-just) (setq vars '(the-display-just)))
1266 (while (and vars
1267 (not (rassq (car vars) calc-embedded-mode-vars)))
1268 (setq vars (cdr vars)))
1269 (if (and vars calc-mode-save-mode (not (eq calc-mode-save-mode 'save)))
1270 (save-excursion
1271 (let* ((save-mode calc-mode-save-mode)
1272 (header (if (eq save-mode 'local)
1273 "calc-mode:"
1274 (format "calc-%s-mode:" save-mode)))
1275 (the-language (calc-embedded-language))
1276 (the-display-just (calc-embedded-justify))
1277 (values (mapcar 'symbol-value vars))
1278 (num (cond ((eq save-mode 'local) 12)
1279 ((eq save-mode 'edit) 13)
1280 ((eq save-mode 'perm) 14)
1281 (t nil)))
1282 base limit mname mlist)
1283 (calc-embedded-original-buffer t)
1284 (save-excursion
1285 (if (eq save-mode 'global)
1286 (setq base (point-max)
1287 limit (point-min)
1288 mlist calc-embedded-globals)
1289 (goto-char (aref calc-embedded-info 4))
1290 (beginning-of-line)
1291 (setq base (point)
1292 limit (max (- (point) 1000) (point-min))
1293 mlist (and num (aref calc-embedded-info num)))
1294 (and (re-search-backward
1295 (format "\\(%s\\)[^\001]*\\(%s\\)\\|\\[calc-defaults]"
1296 calc-embedded-open-formula
1297 calc-embedded-close-formula) limit t)
1298 (setq limit (point))))
1299 (while vars
1300 (goto-char base)
1301 (if (setq mname (car (rassq (car vars)
1302 calc-embedded-mode-vars)))
1303 (let ((buffer-read-only nil)
1304 (found (assq (car vars) mlist)))
1305 (if found
1306 (setcdr found (car values))
1307 (setq mlist (cons (cons (car vars) (car values)) mlist))
1308 (if num
1309 (aset calc-embedded-info num mlist)
1310 (if (eq save-mode 'global)
1311 (setq calc-embedded-globals mlist))))
1312 (if (re-search-backward
1313 (format "\\[%s *%s: *\\(\"\\([^\"\n\\]\\|\\\\.\\)*\"\\|[- ()a-zA-Z0-9]+\\)]"
1314 header mname)
1315 limit t)
1316 (progn
1317 (goto-char (match-beginning 1))
1318 (delete-region (point) (match-end 1))
1319 (insert (prin1-to-string (car values))))
1320 (goto-char base)
1321 (insert-before-markers
1322 calc-embedded-open-mode
1323 "[" header " " mname ": "
1324 (prin1-to-string (car values)) "]"
1325 calc-embedded-close-mode))))
1326 (setq vars (cdr vars)
1327 values (cdr values))))))
1328 (when (and vars (eq calc-mode-save-mode 'save))
1329 (calc-embedded-save-original-modes))))
1330
1331 (defun calc-embedded-var-change (var &optional buf)
1332 (if (symbolp var)
1333 (setq var (list 'var
1334 (if (string-match "\\`var-.+\\'"
1335 (symbol-name var))
1336 (intern (substring (symbol-name var) 4))
1337 var)
1338 var)))
1339 (save-excursion
1340 (let ((manual (not calc-auto-recompute))
1341 (bp calc-embedded-active)
1342 (first t))
1343 (if buf (setq bp (memq (assq buf bp) bp)))
1344 (while bp
1345 (let ((calc-embedded-no-reselect t)
1346 (p (and (buffer-name (car (car bp)))
1347 (cdr (car bp)))))
1348 (while p
1349 (if (assoc var (aref (car p) 10))
1350 (if manual
1351 (if (aref (car p) 11)
1352 (progn
1353 (aset (car p) 11 nil)
1354 (if (aref (car p) 9)
1355 (calc-embedded-var-change (aref (car p) 9)))))
1356 (set-buffer (aref (car p) 0))
1357 (if (equal (buffer-substring (aref (car p) 2)
1358 (aref (car p) 3))
1359 (aref (car p) 6))
1360 (let ((calc-embedded-info nil))
1361 (or calc-embedded-quiet
1362 (message "Recomputing..."))
1363 (setq first nil)
1364 (calc-wrapper
1365 (set-buffer (aref (car p) 0))
1366 (calc-embedded-update (car p) 14 t nil)))
1367 (setcdr (car bp) (delq (car p) (cdr (car bp))))
1368 (message
1369 "(Tried to recompute but formula was changed or missing)"))))
1370 (setq p (cdr p))))
1371 (setq bp (if buf nil (cdr bp))))
1372 (or first calc-embedded-quiet (message "")))))
1373
1374 (provide 'calc-embed)
1375
1376 ;; Local variables:
1377 ;; generated-autoload-file: "calc-loaddefs.el"
1378 ;; End:
1379
1380 ;; arch-tag: 1b8f311e-fba1-40d3-b8c3-1d6f68fd26fc
1381 ;;; calc-embed.el ends here