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