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