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