1 ;;; calc-embed.el --- embed Calc in a buffer
3 ;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
5 ;; Author: David Gillespie <daveg@synaptics.com>
6 ;; Maintainer: Colin Walters <walters@debian.org>
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is distributed in the hope that it will be useful,
11 ;; but WITHOUT ANY WARRANTY. No author or distributor
12 ;; accepts responsibility to anyone for the consequences of using it
13 ;; or for whether it serves any particular purpose or works at all,
14 ;; unless he says so in writing. Refer to the GNU Emacs General Public
15 ;; License for full details.
17 ;; Everyone is granted permission to copy, modify and redistribute
18 ;; GNU Emacs, but only under the conditions described in the
19 ;; GNU Emacs General Public License. A copy of this license is
20 ;; supposed to have been given to you along with GNU Emacs so you
21 ;; can know your rights and responsibilities. It should be in a
22 ;; file named COPYING. Among other things, the copyright notice
23 ;; and this notice must be preserved on all copies.
29 ;; This file is autoloaded from calc-ext.el.
34 (defun calc-Need-calc-embed () nil
)
36 (defun calc-show-plain (n)
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"))))
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
)
53 (defvar calc-embedded-open-formula
"\\`\\|^\n\\|\\$\\$?\\|\\\\\\[\\|^\\\\begin.*\n\\|^@.*\n\\|^\\.EQ.*\n\\|\\\\(\\|^%\n\\|^\\.\\\\\"\n"
54 "*A regular expression for the opening delimiter of a formula used by
57 (defvar calc-embedded-close-formula
"\\'\\|\n$\\|\\$\\$?\\|\\\\]\\|^\\\\end.*\n\\|^@.*\n\\|^\\.EN.*\n\\|\\\\)\\|\n%\n\\|^\\.\\\\\"\n"
58 "*A regular expression for the closing delimiter of a formula used by
61 (defvar calc-embedded-open-word
"^\\|[^-+0-9.eE]"
62 "*A regular expression for the opening delimiter of a formula used by
65 (defvar calc-embedded-close-word
"$\\|[^-+0-9.eE]"
66 "*A regular expression for the closing delimiter of a formula used by
69 (defvar calc-embedded-open-plain
"%%% "
70 "*A string which is the opening delimiter for a \"plain\" formula.
71 If calc-show-plain mode is enabled, this is inserted at the front of
74 (defvar calc-embedded-close-plain
" %%%\n"
75 "*A string which is the closing delimiter for a \"plain\" formula.
76 See calc-embedded-open-plain.")
78 (defvar calc-embedded-open-new-formula
"\n\n"
79 "*A string which is inserted at front of formula by calc-embedded-new-formula.")
81 (defvar calc-embedded-close-new-formula
"\n\n"
82 "*A string which is inserted at end of formula by calc-embedded-new-formula.")
84 (defvar calc-embedded-announce-formula
"%Embed\n\\(% .*\n\\)*"
85 "*A regular expression which is sure to be followed by a calc-embedded formula." )
87 (defvar calc-embedded-open-mode
"% "
88 "*A string which should precede calc-embedded mode annotations.
89 This is not required to be present for user-written mode annotations.")
91 (defvar calc-embedded-close-mode
"\n"
92 "*A string which should follow calc-embedded mode annotations.
93 This is not required to be present for user-written mode annotations.")
96 (defconst calc-embedded-mode-vars
'(("precision" . calc-internal-prec
)
97 ("word-size" . calc-word-size
)
98 ("angles" . calc-angle-mode
)
99 ("symbolic" . calc-symbolic-mode
)
100 ("matrix" . calc-matrix-mode
)
101 ("fractions" . calc-prefer-frac
)
102 ("complex" . calc-complex-mode
)
103 ("simplify" . calc-simplify-mode
)
104 ("language" . the-language
)
105 ("plain" . calc-show-plain
)
106 ("break" . calc-line-breaking
)
107 ("justify" . the-display-just
)
108 ("left-label" . calc-left-label
)
109 ("right-label" . calc-right-label
)
110 ("radix" . calc-number-radix
)
111 ("leading-zeros" . calc-leading-zeros
)
112 ("grouping" . calc-group-digits
)
113 ("group-char" . calc-group-char
)
114 ("point-char" . calc-point-char
)
115 ("frac-format" . calc-frac-format
)
116 ("float-format" . calc-float-format
)
117 ("complex-format" . calc-complex-format
)
118 ("hms-format" . calc-hms-format
)
119 ("date-format" . calc-date-format
)
120 ("matrix-justify" . calc-matrix-just
)
121 ("full-vectors" . calc-full-vectors
)
122 ("break-vectors" . calc-break-vectors
)
123 ("vector-commas" . calc-vector-commas
)
124 ("vector-brackets" . calc-vector-brackets
)
125 ("matrix-brackets" . calc-matrix-brackets
)
126 ("strings" . calc-display-strings
)
130 ;;; Format of calc-embedded-info vector:
131 ;;; 0 Editing buffer.
132 ;;; 1 Calculator buffer.
133 ;;; 2 Top of current formula (marker).
134 ;;; 3 Bottom of current formula (marker).
135 ;;; 4 Top of current formula's delimiters (marker).
136 ;;; 5 Bottom of current formula's delimiters (marker).
137 ;;; 6 String representation of current formula.
138 ;;; 7 Non-nil if formula is embedded within a single line.
139 ;;; 8 Internal representation of current formula.
140 ;;; 9 Variable assigned by this formula, or nil.
141 ;;; 10 List of variables upon which this formula depends.
142 ;;; 11 Evaluated value of the formula, or nil.
143 ;;; 12 Mode settings for current formula.
144 ;;; 13 Local mode settings for current formula.
145 ;;; 14 Permanent mode settings for current formula.
146 ;;; 15 Global mode settings for editing buffer.
149 ;;; calc-embedded-active is an a-list keyed on buffers; each cdr is a
150 ;;; sorted list of calc-embedded-infos in that buffer. We do this
151 ;;; rather than using buffer-local variables because the latter are
152 ;;; thrown away when a buffer changes major modes.
155 (defvar calc-embedded-quiet nil
)
156 (defun calc-do-embedded (arg end obeg oend
)
157 (if calc-embedded-info
159 ;; Turn embedded mode off or switch to a new buffer.
160 (cond ((eq (current-buffer) (aref calc-embedded-info
1))
161 (let ((calcbuf (current-buffer))
162 (buf (aref calc-embedded-info
0)))
163 (calc-embedded-original-buffer t
)
165 (switch-to-buffer calcbuf
)))
167 ((eq (current-buffer) (aref calc-embedded-info
0))
168 (let* ((info calc-embedded-info
)
169 (mode calc-embedded-modes
))
171 (set-buffer (aref info
1))
172 (if (and (> (calc-stack-size) 0)
173 (equal (calc-top 1 'full
) (aref info
8)))
174 (let ((calc-no-refresh-evaltos t
))
175 (if (calc-top 1 'sel
)
177 (calc-embedded-set-modes
178 (aref info
15) (aref info
12) (aref info
14))
179 (let ((calc-embedded-info nil
))
180 (calc-wrapper (calc-pop-stack))))
181 (calc-set-mode-line)))
182 (setq calc-embedded-info nil
183 mode-line-buffer-identification
(car mode
)
184 truncate-lines
(nth 2 mode
)
185 buffer-read-only nil
)
186 (use-local-map (nth 1 mode
))
187 (set-buffer-modified-p (buffer-modified-p))
188 (or calc-embedded-quiet
189 (message "Back to %s mode" mode-name
))))
192 (if (buffer-name (aref calc-embedded-info
0))
194 (set-buffer (aref calc-embedded-info
0))
195 (or (y-or-n-p (format "Cancel Calc Embedded mode in buffer %s? "
198 (calc-embedded nil
)))
199 (calc-embedded arg end obeg oend
)))
201 ;; Turn embedded mode on.
202 (calc-plain-buffer-only)
203 (let ((modes (list mode-line-buffer-identification
206 top bot outer-top outer-bot
208 (barf-if-buffer-read-only)
209 (or calc-embedded-globals
211 (setq info
(calc-embedded-make-info (point) nil t arg end obeg oend
))
212 (if (eq (car-safe (aref info
8)) 'error
)
214 (goto-char (nth 1 (aref info
8)))
215 (error (nth 2 (aref info
8)))))
216 (let ((mode-line-buffer-identification mode-line-buffer-identification
)
217 (calc-embedded-info info
)
218 (calc-embedded-no-reselect t
))
221 (calc-no-refresh-evaltos t
))
222 (setq chg
(calc-embedded-set-modes
223 (aref info
15) (aref info
12) (aref info
13)))
225 (calc-push (calc-normalize (aref info
8)))
227 (setq calc-undo-list nil
229 ident mode-line-buffer-identification
)))
230 (setq calc-embedded-info info
231 calc-embedded-modes modes
232 mode-line-buffer-identification ident
235 (set-buffer-modified-p (buffer-modified-p))
236 (use-local-map calc-mode-map
)
237 (setq calc-no-refresh-evaltos nil
)
238 (and chg calc-any-evaltos
(calc-wrapper (calc-refresh-evaltos)))
239 (or (eq calc-embedded-quiet t
)
240 (message "Embedded Calc mode enabled; %s to return to normal"
241 (if calc-embedded-quiet
243 "Give this command again")))))
244 (scroll-down 0)) ; fix a bug which occurs when truncate-lines is changed.
247 (defun calc-embedded-select (arg)
250 (and calc-embedded-info
251 (eq (car-safe (aref calc-embedded-info
8)) 'calcFunc-evalto
)
252 (calc-select-part 1))
253 (and calc-embedded-info
254 (or (eq (car-safe (aref calc-embedded-info
8)) 'calcFunc-assign
)
255 (and (eq (car-safe (aref calc-embedded-info
8)) 'calcFunc-evalto
)
256 (eq (car-safe (nth 1 (aref calc-embedded-info
8)))
258 (calc-select-part 2)))
261 (defun calc-embedded-update-formula (arg)
264 (let ((entry (assq (current-buffer) calc-embedded-active
)))
265 (while (setq entry
(cdr entry
))
266 (and (eq (car-safe (aref (car entry
) 8)) 'calcFunc-evalto
)
267 (or (not (consp arg
))
268 (and (<= (aref (car entry
) 2) (region-beginning))
269 (>= (aref (car entry
) 3) (region-end))))
271 (calc-embedded-update (car entry
) 14 t t
)))))
272 (if (and calc-embedded-info
273 (eq (current-buffer) (aref calc-embedded-info
0))
274 (>= (point) (aref calc-embedded-info
4))
275 (<= (point) (aref calc-embedded-info
5)))
278 (info (calc-embedded-make-info (point) nil t
))
279 (pt (- opt
(aref info
4))))
280 (or (eq (car-safe (aref info
8)) 'error
)
283 (calc-embedded-update info
14 'eval t
))
284 (goto-char (+ (aref info
4) pt
))))))))
287 (defun calc-embedded-edit (arg)
289 (let ((info (calc-embedded-make-info (point) nil t arg
))
291 (if (eq (car-safe (aref info
8)) 'error
)
293 (goto-char (nth 1 (aref info
8)))
294 (error (nth 2 (aref info
8)))))
296 (setq str
(math-showing-full-precision
297 (math-format-nice-expr (aref info
8) (frame-width))))
298 (calc-edit-mode (list 'calc-embedded-finish-edit info
))
300 (calc-show-edit-buffer))
302 (defun calc-embedded-finish-edit (info)
303 (let ((buf (current-buffer))
304 (str (buffer-substring (point) (point-max)))
307 (switch-to-buffer calc-original-buffer
)
308 (let ((val (save-excursion
309 (set-buffer (aref info
1))
310 (let ((calc-language nil
)
311 (math-expr-opers math-standard-opers
))
312 (math-read-expr str
)))))
313 (if (eq (car-safe val
) 'error
)
315 (switch-to-buffer buf
)
316 (goto-char (+ start
(nth 1 val
)))
317 (error (nth 2 val
))))
318 (calc-embedded-original-buffer t info
)
320 (calc-embedded-update info
14 t t
))))
322 (defun calc-do-embedded-activate (arg cbuf
)
323 (calc-plain-buffer-only)
325 (calc-embedded-forget))
327 (if (< (prefix-numeric-value arg
) 0)
328 (message "Deactivating %s for Calc Embedded mode" (buffer-name))
329 (message "Activating %s for Calc Embedded mode..." (buffer-name))
331 (let* ((active (assq (current-buffer) calc-embedded-active
))
333 (pat " := \\| \\\\gets \\| => \\| \\\\evalto "))
334 (if calc-embedded-announce-formula
335 (setq pat
(format "%s\\|\\(%s\\)"
336 pat calc-embedded-announce-formula
)))
337 (while (setq info
(cdr info
))
338 (or (equal (buffer-substring (aref (car info
) 2) (aref (car info
) 3))
340 (setcdr active
(delq (car info
) (cdr active
)))))
341 (goto-char (point-min))
342 (while (re-search-forward pat nil t
)
343 (if (looking-at calc-embedded-open-formula
)
344 (goto-char (match-end 1)))
345 (setq info
(calc-embedded-make-info (point) cbuf nil
))
346 (or (eq (car-safe (aref info
8)) 'error
)
347 (goto-char (aref info
5))))))
348 (message "Activating %s for Calc Embedded mode...done" (buffer-name)))
349 (calc-embedded-active-state t
))
351 (defun calc-plain-buffer-only ()
352 (if (memq major-mode
'(calc-mode calc-trail-mode calc-edit-mode
))
353 (error "This command should be used in a normal editing buffer")))
355 (defun calc-embedded-active-state (state)
356 (or (assq 'calc-embedded-all-active minor-mode-alist
)
357 (setq minor-mode-alist
358 (cons '(calc-embedded-all-active " Active")
359 (cons '(calc-embedded-some-active " ~Active")
361 (let ((active (assq (current-buffer) calc-embedded-active
)))
364 (and (eq state
'more
) calc-embedded-all-active
(setq state t
))
365 (setq calc-embedded-all-active
(eq state t
)
366 calc-embedded-some-active
(not (memq state
'(nil t
))))
367 (set-buffer-modified-p (buffer-modified-p)))
370 (defun calc-embedded-original-buffer (switch &optional info
)
371 (or info
(setq info calc-embedded-info
))
372 (or (buffer-name (aref info
0))
374 (error "Calc embedded mode: Original buffer has been killed")))
376 (set-buffer (aref info
0))))
378 (defun calc-embedded-word ()
380 (calc-embedded '(4)))
382 (defun calc-embedded-mark-formula (&optional body-only
)
383 "Put point at the beginning of this Calc formula, mark at the end.
384 This normally marks the whole formula, including surrounding delimiters.
385 With any prefix argument, marks only the formula itself."
387 (and (eq major-mode
'calc-mode
)
388 (error "This command should be used in a normal editing buffer"))
389 (let (top bot outer-top outer-bot
)
391 (calc-embedded-find-bounds body-only
))
392 (push-mark (if body-only bot outer-bot
) t
)
393 (goto-char (if body-only top outer-top
))))
395 (defun calc-embedded-find-bounds (&optional plain
)
396 ;; (while (and (bolp) (eq (following-char) ?\n))
398 (and (eolp) (bolp) (not (eq (char-after (- (point) 2)) ?
\n))
400 (let ((home (point)))
401 (or (and (looking-at calc-embedded-open-formula
)
402 (not (looking-at calc-embedded-close-formula
)))
403 (re-search-backward calc-embedded-open-formula nil t
)
404 (error "Can't find start of formula"))
405 (and (eq (preceding-char) ?\$
) ; backward search for \$\$? won't back
406 (eq (following-char) ?\$
) ; up over a second $, so do it by hand.
408 (setq outer-top
(point))
409 (goto-char (match-end 0))
410 (if (eq (following-char) ?
\n)
413 (while (eq (following-char) ?\
)
415 (or (eq plain
'plain
)
416 (if (looking-at (regexp-quote calc-embedded-open-plain
))
418 (goto-char (match-end 0))
419 (search-forward calc-embedded-close-plain
))))
421 (or (re-search-forward calc-embedded-close-formula nil t
)
422 (error "Can't find end of formula"))
424 (error "Not inside a formula"))
425 (and (eq (following-char) ?
\n) (not (bolp))
427 (setq outer-bot
(point))
428 (goto-char (match-beginning 0))
429 (if (eq (preceding-char) ?
\n)
432 (while (eq (preceding-char) ?\
)
436 (defun calc-embedded-kill-formula ()
437 "Kill the formula surrounding point.
438 If Calc Embedded mode was active, this deactivates it.
439 The formula (including its surrounding delimiters) is saved in the kill ring.
440 The command \\[yank] can retrieve it from there."
442 (and calc-embedded-info
444 (calc-embedded-mark-formula)
445 (kill-region (point) (mark))
448 (defun calc-embedded-copy-formula-as-kill ()
449 "Save the formula surrounding point as if killed, but don't kill it."
452 (calc-embedded-mark-formula)
453 (copy-region-as-kill (point) (mark))
456 (defun calc-embedded-duplicate ()
458 (let ((already calc-embedded-info
)
459 top bot outer-top outer-bot new-top
)
460 (if calc-embedded-info
462 (setq top
(+ (aref calc-embedded-info
2))
463 bot
(+ (aref calc-embedded-info
3))
464 outer-top
(+ (aref calc-embedded-info
4))
465 outer-bot
(+ (aref calc-embedded-info
5)))
467 (calc-embedded-find-bounds))
468 (goto-char outer-bot
)
470 (setq new-top
(point))
471 (insert-buffer-substring (current-buffer) outer-top outer-bot
)
472 (goto-char (+ new-top
(- top outer-top
)))
473 (let ((calc-embedded-quiet (if already t
'x
)))
474 (calc-embedded (+ new-top
(- top outer-top
))
475 (+ new-top
(- bot outer-top
))
477 (+ new-top
(- outer-bot outer-top
))))))
479 (defun calc-embedded-next (arg)
481 (setq arg
(prefix-numeric-value arg
))
482 (let* ((active (cdr (assq (current-buffer) calc-embedded-active
)))
484 (num (length active
)))
486 (error "No active formulas in buffer"))
489 (if (<= (point) (aref (car active
) 3))
490 (goto-char (aref (nth (1- num
) active
) 2))
492 (> (point) (aref (nth 1 p
) 3)))
494 (goto-char (aref (car p
) 2))))
496 (calc-embedded-next -
1)
497 (calc-embedded-next (+ (* num
1000) arg
1)))
499 (setq arg
(1+ (%
(1- arg
) num
)))
500 (while (and p
(>= (point) (aref (car p
) 2)))
502 (while (> (setq arg
(1- arg
)) 0)
503 (setq p
(if p
(cdr p
) (cdr active
))))
504 (goto-char (aref (car (or p active
)) 2))))))
506 (defun calc-embedded-previous (arg)
508 (calc-embedded-next (- (prefix-numeric-value arg
))))
510 (defun calc-embedded-new-formula ()
512 (and (eq major-mode
'calc-mode
)
513 (error "This command should be used in a normal editing buffer"))
514 (if calc-embedded-info
516 (let (top bot outer-top outer-bot
)
517 (if (and (eq (preceding-char) ?
\n)
518 (string-match "\\`\n" calc-embedded-open-new-formula
))
520 (setq outer-top
(1- (point)))
522 (insert (substring calc-embedded-open-new-formula
1)))
523 (setq outer-top
(point))
524 (insert calc-embedded-open-new-formula
))
528 (insert calc-embedded-close-new-formula
)
529 (if (and (eq (following-char) ?
\n)
530 (string-match "\n\\'" calc-embedded-close-new-formula
))
532 (setq outer-bot
(point))
534 (let ((calc-embedded-quiet 'x
))
535 (calc-embedded top bot outer-top outer-bot
))))
537 (defun calc-embedded-forget ()
539 (setq calc-embedded-active
(delq (assq (current-buffer) calc-embedded-active
)
540 calc-embedded-active
))
541 (calc-embedded-active-state nil
))
544 (defun calc-embedded-set-modes (gmodes modes local-modes
&optional temp
)
545 (let ((the-language (calc-embedded-language))
546 (the-display-just (calc-embedded-justify))
551 (or (symbolp (car v
))
552 (and (setq found
(assq (car (car v
)) modes
))
553 (not (eq (cdr found
) 'default
)))
554 (and (setq found
(assq (car (car v
)) local-modes
))
555 (not (eq (cdr found
) 'default
)))
557 (if (eq (setq value
(cdr (car v
))) 'default
)
558 (setq value
(cdr (assq (car (car v
)) calc-mode-var-list
))))
559 (equal (symbol-value (car (car v
))) value
))
562 (if temp
(setq prev-modes
(cons (cons (car (car v
))
563 (symbol-value (car (car v
))))
565 (set (car (car v
)) value
)))
569 (or (and (setq found
(assq (car (car v
)) local-modes
))
570 (not (eq (cdr found
) 'default
)))
571 (eq (setq value
(cdr (car v
))) 'default
)
572 (equal (symbol-value (car (car v
))) value
)
575 (if temp
(setq prev-modes
(cons (cons (car (car v
))
576 (symbol-value (car (car v
))))
578 (set (car (car v
)) value
)))
582 (or (eq (setq value
(cdr (car v
))) 'default
)
583 (equal (symbol-value (car (car v
))) value
)
586 (if temp
(setq prev-modes
(cons (cons (car (car v
))
587 (symbol-value (car (car v
))))
589 (set (car (car v
)) value
)))
591 (and changed
(not (eq temp t
))
593 (calc-embedded-set-justify the-display-just
)
594 (calc-embedded-set-language the-language
)))
595 (and changed
(not temp
)
597 (setq calc-full-float-format
(list (if (eq (car calc-float-format
)
600 (car calc-float-format
))
605 (defun calc-embedded-language ()
606 (if calc-language-option
607 (list calc-language calc-language-option
)
610 (defun calc-embedded-set-language (lang)
613 (setq option
(nth 1 lang
)
615 (or (and (eq lang calc-language
)
616 (equal option calc-language-option
))
617 (calc-set-language lang option t
))))
619 (defun calc-embedded-justify ()
620 (if calc-display-origin
621 (list calc-display-just calc-display-origin
)
624 (defun calc-embedded-set-justify (just)
626 (setq calc-display-origin
(nth 1 just
)
627 calc-display-just
(car just
))
628 (setq calc-display-just just
629 calc-display-origin nil
)))
632 (defun calc-find-globals ()
634 (and (eq major-mode
'calc-mode
)
635 (error "This command should be used in a normal editing buffer"))
636 (make-local-variable 'calc-embedded-globals
)
637 (let ((case-fold-search nil
)
641 (goto-char (point-min))
642 (while (re-search-forward "\\[calc-global-mode: *\\([-a-z]+\\): *\\(\"\\([^\"\n\\]\\|\\\\.\\)*\"\\|[- ()a-zA-Z0-9]+\\)\\]" nil t
)
643 (and (setq found
(assoc (buffer-substring (match-beginning 1)
645 calc-embedded-mode-vars
))
646 (or (assq (cdr found
) modes
)
647 (setq modes
(cons (cons (cdr found
)
648 (car (read-from-string
653 (setq calc-embedded-globals
(cons t modes
))
654 (goto-char save-pt
)))
656 (defun calc-embedded-find-modes ()
657 (let ((case-fold-search nil
)
664 (while (and no-defaults
(search-backward "[calc-" nil t
))
666 (or (and (looking-at "mode: *\\([-a-z]+\\): *\\(\"\\([^\"\n\\]\\|\\\\.\\)*\"\\|[- ()a-zA-Z0-9]+\\)]")
667 (setq found
(assoc (buffer-substring (match-beginning 1)
669 calc-embedded-mode-vars
))
670 (or (assq (cdr found
) modes
)
671 (setq modes
(cons (cons (cdr found
)
672 (car (read-from-string
677 (and (looking-at "perm-mode: *\\([-a-z]+\\): *\\(\"\\([^\"\n\\]\\|\\\\.\\)*\"\\|[- ()a-zA-Z0-9]+\\)]")
678 (setq found
(assoc (buffer-substring (match-beginning 1)
680 calc-embedded-mode-vars
))
681 (or (assq (cdr found
) pmodes
)
682 (setq pmodes
(cons (cons (cdr found
)
683 (car (read-from-string
688 (and (looking-at "edit-mode: *\\([-a-z]+\\): *\\(\"\\([^\"\n\\]\\|\\\\.\\)*\"\\|[- ()a-zA-Z0-9]+\\)]")
689 (setq found
(assoc (buffer-substring (match-beginning 1)
691 calc-embedded-mode-vars
))
692 (or (assq (cdr found
) emodes
)
693 (setq emodes
(cons (cons (cdr found
)
694 (car (read-from-string
699 (and (looking-at "defaults]")
700 (setq no-defaults nil
)))
703 (list modes emodes pmodes
)))
706 (defun calc-embedded-make-info (point cbuf fresh
&optional
707 top bot outer-top outer-bot
)
708 (let* ((bufentry (assq (current-buffer) calc-embedded-active
))
710 (force (and fresh top
))
715 (setq found
(list (current-buffer))
716 calc-embedded-active
(cons found calc-embedded-active
)))
717 (while (and (cdr found
)
718 (> point
(aref (car (cdr found
)) 3)))
719 (setq found
(cdr found
)))
721 (>= point
(aref (nth 1 found
) 2)))
722 (setq info
(nth 1 found
))
723 (setq info
(make-vector 16 nil
)
726 (aset info
0 (current-buffer))
727 (aset info
1 (or cbuf
(save-excursion
730 (if (and (integerp top
) (not bot
)) ; started with a user-supplied argument
732 (if (= (setq arg
(prefix-numeric-value arg
)) 0)
734 (aset info
2 (copy-marker (region-beginning)))
735 (aset info
3 (copy-marker (region-end))))
736 (aset info
(if (> arg
0) 2 3) (point-marker))
738 (aset info
(if (> arg
0) 3 2) (point-marker)))
739 (aset info
4 (copy-marker (aref info
2)))
740 (aset info
5 (copy-marker (aref info
3))))
742 (setq top
(aref info
2)
745 (let ((calc-embedded-open-formula calc-embedded-open-word
)
746 (calc-embedded-close-formula calc-embedded-close-word
))
747 (calc-embedded-find-bounds 'plain
))
749 (calc-embedded-find-bounds 'plain
)))
750 (aset info
2 (copy-marker (min top bot
)))
751 (aset info
3 (copy-marker (max top bot
)))
752 (aset info
4 (copy-marker (or outer-top
(aref info
2))))
753 (aset info
5 (copy-marker (or outer-bot
(aref info
3))))))
754 (goto-char (aref info
2))
757 (or (bolp) (aset info
7 t
))
758 (goto-char (aref info
3))
759 (or (bolp) (eolp) (aset info
7 t
))))
761 (let ((modes (calc-embedded-find-modes)))
762 (aset info
12 (car modes
))
763 (aset info
13 (nth 1 modes
))
764 (aset info
14 (nth 2 modes
))))
765 (aset info
15 calc-embedded-globals
)
766 (setq str
(buffer-substring (aref info
2) (aref info
3)))
768 (not (equal str
(aref info
6))))
769 (if (and fixed
(aref info
6))
772 (calc-embedded-make-info point cbuf nil
)
774 (let* ((open-plain calc-embedded-open-plain
)
775 (close-plain calc-embedded-close-plain
)
776 (pref-len (length open-plain
))
780 (set-buffer (aref info
1))
781 (calc-embedded-set-modes (aref info
15)
782 (aref info
12) (aref info
14))
783 (if (and (> (length str
) pref-len
)
784 (equal (substring str
0 pref-len
) open-plain
)
785 (setq suff-pos
(string-match (regexp-quote close-plain
)
787 (setq val
(math-read-plain-expr
788 (substring str pref-len suff-pos
)))
789 (if (string-match "[^ \t\n]" str
)
791 val
(math-read-big-expr str
))
793 (if (eq (car-safe val
) 'error
)
794 (setq val
(list 'error
795 (+ (aref info
2) pref-len
(nth 1 val
))
800 (if (eq (car-safe temp
) 'calcFunc-evalto
)
801 (setq temp
(nth 1 temp
))
802 (if (eq (car-safe temp
) 'error
)
805 (setcdr found
(delq info
(cdr found
)))
806 (calc-embedded-active-state 'less
))))
807 (aset info
9 (and (eq (car-safe temp
) 'calcFunc-assign
)
809 (if (memq (car-safe val
) '(calcFunc-evalto calcFunc-assign
))
810 (calc-embedded-find-vars val
))
811 (aset info
10 vars-used
)
812 (aset info
11 nil
))))
815 (setcdr found
(cons info
(cdr found
)))
816 (calc-embedded-active-state 'more
)))
819 (defun calc-embedded-find-vars (x)
820 (cond ((Math-primp x
)
821 (and (eq (car-safe x
) 'var
)
822 (not (assoc x vars-used
))
823 (setq vars-used
(cons (list x
) vars-used
))))
824 ((eq (car x
) 'calcFunc-evalto
)
825 (calc-embedded-find-vars (nth 1 x
)))
826 ((eq (car x
) 'calcFunc-assign
)
827 (calc-embedded-find-vars (nth 2 x
)))
829 (and (eq (car x
) 'calcFunc-subscr
)
830 (eq (car-safe (nth 1 x
)) 'var
)
831 (Math-primp (nth 2 x
))
832 (not (assoc x vars-used
))
833 (setq vars-used
(cons (list x
) vars-used
)))
834 (while (setq x
(cdr x
))
835 (calc-embedded-find-vars (car x
))))))
838 (defun calc-embedded-evaluate-expr (x)
839 (let ((vars-used (aref calc-embedded-info
10)))
840 (or vars-used
(calc-embedded-find-vars x
))
842 (let ((active (assq (aref calc-embedded-info
0) calc-embedded-active
))
845 (calc-embedded-original-buffer t
)
848 (calc-embedded-activate)
849 (setq active
(assq (aref calc-embedded-info
0)
850 calc-embedded-active
))))
852 (calc-embedded-eval-get-var (car (car vars-used
)) active
)
853 (setq vars-used
(cdr vars-used
))))
854 (calc-embedded-subst x
))
855 (calc-normalize (math-evaluate-expr-rec x
)))))
857 (defun calc-embedded-subst (x)
858 (if (and (eq (car-safe x
) 'calcFunc-evalto
) (cdr x
))
859 (let ((rhs (calc-embedded-subst (nth 1 x
))))
860 (list 'calcFunc-evalto
862 (if (eq (car-safe rhs
) 'calcFunc-assign
) (nth 2 rhs
) rhs
)))
863 (if (and (eq (car-safe x
) 'calcFunc-assign
) (= (length x
) 3))
864 (list 'calcFunc-assign
866 (calc-embedded-subst (nth 2 x
)))
867 (calc-normalize (math-evaluate-expr-rec (math-multi-subst-rec x
))))))
869 (defun calc-embedded-eval-get-var (var base
)
871 (point (aref calc-embedded-info
2))
874 (while (and (setq entry
(cdr entry
))
875 (or (not (equal var
(aref (car entry
) 9)))
876 (and (> point
(aref (car entry
) 3))
877 (setq last entry
)))))
882 (setq entry
(car entry
))
883 (if (equal (buffer-substring (aref entry
2) (aref entry
3))
888 (calc-embedded-update entry
14 t nil
)))
889 (setq val
(aref entry
11))
890 (if (eq (car-safe val
) 'calcFunc-evalto
)
891 (setq val
(nth 2 val
)))
892 (if (eq (car-safe val
) 'calcFunc-assign
)
893 (setq val
(nth 2 val
)))
894 (setq args
(cons (cons var val
) args
)))
895 (calc-embedded-activate)
896 (calc-embedded-eval-get-var var base
))))))
899 (defun calc-embedded-update (info which need-eval need-display
900 &optional str entry old-val
)
901 (let* ((prev-modes nil
)
902 (open-plain calc-embedded-open-plain
)
903 (close-plain calc-embedded-close-plain
)
907 (old-eval (aref info
11)))
908 (or old-val
(setq old-val val
))
909 (if (eq (car-safe val
) 'calcFunc-evalto
)
910 (setq need-display t
))
913 (set-buffer (aref info
1))
915 (calc-embedded-set-modes (aref info
15) (aref info
12)
917 (if need-display
'full t
)))
918 (if (memq (car-safe val
) '(calcFunc-evalto calcFunc-assign
))
919 (calc-embedded-find-vars val
))
921 (let ((calc-embedded-info info
))
922 (setq val
(math-evaluate-expr val
)
924 (if (or (eq need-eval
'eval
) (eq (car-safe val
) 'calcFunc-evalto
))
927 (aset info
10 vars-used
)
929 (if (or need-display
(eq (car-safe val
) 'calcFunc-evalto
))
930 (let ((extra (if (eq calc-language
'big
) 1 0)))
931 (or entry
(setq entry
(list val
1 nil
)))
933 (setq str
(let ((calc-line-numbering nil
))
934 (math-format-stack-value entry
)))
935 (if (eq calc-language
'big
)
936 (setq str
(substring str
0 -
1)))))
938 (setq str
(concat open-plain
939 (math-showing-full-precision
940 (math-format-flat-expr val
0))
944 (calc-embedded-original-buffer t info
)
945 (or (equal str
(aref info
6))
946 (let ((delta (- (aref info
5) (aref info
3)))
947 (buffer-read-only nil
))
948 (goto-char (aref info
2))
949 (delete-region (point) (aref info
3))
950 (and (> (nth 1 entry
) (1+ extra
))
954 (delete-horizontal-space)
956 (delete-horizontal-space)
959 (set-marker (aref info
3) (point))
960 (set-marker (aref info
5) (+ (point) delta
))
961 (aset info
6 str
))))))
962 (if (eq (car-safe val
) 'calcFunc-evalto
)
964 (setq evalled
(nth 2 val
)
966 (if (eq (car-safe val
) 'calcFunc-assign
)
968 (aset info
9 (nth 1 val
))
969 (aset info
11 (or evalled
970 (let ((calc-embedded-info info
))
971 (math-evaluate-expr (nth 2 val
)))))
972 (or (equal old-eval
(aref info
11))
973 (calc-embedded-var-change (nth 1 val
) (aref info
0))))
974 (if (eq (car-safe old-val
) 'calcFunc-evalto
)
975 (setq old-val
(nth 1 old-val
)))
976 (if (eq (car-safe old-val
) 'calcFunc-assign
)
977 (calc-embedded-var-change (nth 1 old-val
) (aref info
0)))))
978 (set-buffer (aref info
1))
980 (cond ((eq (car (car prev-modes
)) 'the-language
)
982 (calc-embedded-set-language (cdr (car prev-modes
)))))
983 ((eq (car (car prev-modes
)) 'the-display-just
)
985 (calc-embedded-set-justify (cdr (car prev-modes
)))))
987 (set (car (car prev-modes
)) (cdr (car prev-modes
)))))
988 (setq prev-modes
(cdr prev-modes
))))))
993 ;;; These are hooks called by the main part of Calc.
995 (defvar calc-embedded-no-reselect nil
)
996 (defun calc-embedded-select-buffer ()
997 (if (eq (current-buffer) (aref calc-embedded-info
0))
998 (let ((info calc-embedded-info
)
1000 (if (and (or (< (point) (aref info
4))
1001 (> (point) (aref info
5)))
1002 (not calc-embedded-no-reselect
))
1003 (let ((calc-embedded-quiet t
))
1004 (message "(Switching Calc Embedded mode to new formula.)")
1006 (calc-embedded nil
)))
1007 (setq horiz
(max (min (current-column) (- (point) (aref info
2))) 0)
1008 vert
(if (<= (aref info
2) (point))
1009 (- (count-lines (aref info
2) (point))
1012 (set-buffer (aref info
1))
1016 (setq vert
(1- vert
))))
1017 (calc-cursor-stack-index 1)
1018 (if calc-line-numbering
1019 (setq horiz
(+ horiz
4)))
1021 (forward-line vert
))
1022 (forward-char (min horiz
1023 (- (point-max) (point)))))
1024 (calc-select-buffer)))
1026 (defun calc-embedded-finish-command ()
1027 (let ((buf (current-buffer))
1030 (set-buffer (aref calc-embedded-info
1))
1031 (if (> (calc-stack-size) 0)
1033 (col (current-column))
1035 (calc-cursor-stack-index 0)
1038 (calc-cursor-stack-index 1)
1041 (setq horiz
(- col
(if calc-line-numbering
4 0))
1042 vert
(- (count-lines (point) pt
)
1045 (setq vert
(max 1 (1+ vert
))))))))
1049 (set-buffer (aref calc-embedded-info
0))
1050 (goto-char (aref calc-embedded-info
2))
1052 (forward-line vert
))
1053 (forward-char (max horiz
0))
1054 (set-buffer buf
)))))
1056 (defun calc-embedded-stack-change ()
1057 (or calc-executing-macro
1059 (set-buffer (aref calc-embedded-info
1))
1060 (let* ((info calc-embedded-info
)
1061 (extra-line (if (eq calc-language
'big
) 1 0))
1063 (empty (= (calc-stack-size) 0))
1065 (list '(var empty var-empty
) 1 nil
)
1066 (calc-top 1 'entry
)))
1067 (old-val (aref info
8))
1072 (calc-cursor-stack-index 1)
1074 (calc-cursor-stack-index 0)
1075 (setq bot
(- (point) extra-line
))
1076 (setq str
(buffer-substring top
(- bot
1))))
1077 (if calc-line-numbering
1079 (setq str
(substring str
4))
1080 (while (setq pos
(string-match "\n...." str pos
))
1081 (setq str
(concat (substring str
0 (1+ pos
))
1082 (substring str
(+ pos
5)))
1084 (calc-embedded-original-buffer t
)
1085 (aset info
8 (car entry
))
1086 (calc-embedded-update info
13 nil t str entry old-val
)))))
1088 (defun calc-embedded-mode-line-change ()
1089 (let ((str mode-line-buffer-identification
))
1091 (calc-embedded-original-buffer t
)
1092 (setq mode-line-buffer-identification str
)
1093 (set-buffer-modified-p (buffer-modified-p)))))
1095 (defun calc-embedded-modes-change (vars)
1096 (if (eq (car vars
) 'calc-language
) (setq vars
'(the-language)))
1097 (if (eq (car vars
) 'calc-display-just
) (setq vars
'(the-display-just)))
1099 (not (rassq (car vars
) calc-embedded-mode-vars
)))
1100 (setq vars
(cdr vars
)))
1101 (if (and vars calc-mode-save-mode
(not (eq calc-mode-save-mode
'save
)))
1103 (let* ((save-mode calc-mode-save-mode
)
1104 (header (if (eq save-mode
'local
)
1106 (format "calc-%s-mode:" save-mode
)))
1107 (the-language (calc-embedded-language))
1108 (the-display-just (calc-embedded-justify))
1109 (values (mapcar 'symbol-value vars
))
1110 (num (cond ((eq save-mode
'local
) 12)
1111 ((eq save-mode
'edit
) 13)
1112 ((eq save-mode
'perm
) 14)
1114 base limit mname mlist
)
1115 (calc-embedded-original-buffer t
)
1117 (if (eq save-mode
'global
)
1118 (setq base
(point-max)
1120 mlist calc-embedded-globals
)
1121 (goto-char (aref calc-embedded-info
4))
1124 limit
(max (- (point) 1000) (point-min))
1125 mlist
(and num
(aref calc-embedded-info num
)))
1126 (and (re-search-backward
1127 (format "\\(%s\\)[^\001]*\\(%s\\)\\|\\[calc-defaults]"
1128 calc-embedded-open-formula
1129 calc-embedded-close-formula
) limit t
)
1130 (setq limit
(point))))
1133 (if (setq mname
(car (rassq (car vars
)
1134 calc-embedded-mode-vars
)))
1135 (let ((buffer-read-only nil
)
1136 (found (assq (car vars
) mlist
)))
1138 (setcdr found
(car values
))
1139 (setq mlist
(cons (cons (car vars
) (car values
)) mlist
))
1141 (aset calc-embedded-info num mlist
)
1142 (if (eq save-mode
'global
)
1143 (setq calc-embedded-globals mlist
))))
1144 (if (re-search-backward
1145 (format "\\[%s *%s: *\\(\"\\([^\"\n\\]\\|\\\\.\\)*\"\\|[- ()a-zA-Z0-9]+\\)]"
1149 (goto-char (match-beginning 1))
1150 (delete-region (point) (match-end 1))
1151 (insert (prin1-to-string (car values
))))
1153 (insert-before-markers
1154 calc-embedded-open-mode
1155 "[" header
" " mname
": "
1156 (prin1-to-string (car values
)) "]"
1157 calc-embedded-close-mode
))))
1158 (setq vars
(cdr vars
)
1159 values
(cdr values
))))))))
1161 (defun calc-embedded-var-change (var &optional buf
)
1163 (setq var
(list 'var
1164 (if (string-match "\\`var-.+\\'"
1166 (intern (substring (symbol-name var
) 4))
1170 (let ((manual (not calc-auto-recompute
))
1171 (bp calc-embedded-active
)
1173 (if buf
(setq bp
(memq (assq buf bp
) bp
)))
1175 (let ((calc-embedded-no-reselect t
)
1176 (p (and (buffer-name (car (car bp
)))
1179 (if (assoc var
(aref (car p
) 10))
1181 (if (aref (car p
) 11)
1183 (aset (car p
) 11 nil
)
1184 (if (aref (car p
) 9)
1185 (calc-embedded-var-change (aref (car p
) 9)))))
1186 (set-buffer (aref (car p
) 0))
1187 (if (equal (buffer-substring (aref (car p
) 2)
1190 (let ((calc-embedded-info nil
))
1191 (or calc-embedded-quiet
1192 (message "Recomputing..."))
1195 (set-buffer (aref (car p
) 0))
1196 (calc-embedded-update (car p
) 14 t nil
)))
1197 (setcdr (car bp
) (delq (car p
) (cdr (car bp
))))
1199 "(Tried to recompute but formula was changed or missing)"))))
1201 (setq bp
(if buf nil
(cdr bp
))))
1202 (or first calc-embedded-quiet
(message "")))))
1204 ;;; calc-embed.el ends here