cgit.sxemacs.org Git - packages/blob - xemacs-packages/calc/calc-embed.el

   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
 206                         (format "Cancel Calc Embedded mode in buffer %s? "
 207                                 (buffer-name)))
 208                        (keyboard-quit))
 209                    (calc-embedded nil)))
 210              (calc-embedded arg end obeg oend)))
 211
 212     ;; Turn embedded mode on.
 213     (calc-plain-buffer-only)
 214     (let ((modes (list mode-line-buffer-identification
 215                        (current-local-map)
 216                        truncate-lines))
 217           top bot outer-top outer-bot
 218           info chg ident)
 219       (barf-if-buffer-read-only)
 220       (or calc-embedded-globals
 221           (calc-find-globals))
 222       (setq info (calc-embedded-make-info (point) nil t arg end obeg oend))
 223       (if (eq (car-safe (aref info 8)) 'error)
 224           (progn
 225             (goto-char (nth 1 (aref info 8)))
 226             (error (nth 2 (aref info 8)))))
 227       (let ((mode-line-buffer-identification mode-line-buffer-identification)
 228             (calc-embedded-info info)
 229             (calc-embedded-no-reselect t))
 230         (calc-wrapper
 231          (let* ((okay nil)
 232                 (calc-no-refresh-evaltos t))
 233            (setq chg (calc-embedded-set-modes
 234                       (aref info 15) (aref info 12) (aref info 13)))
 235            (if (aref info 8)
 236                (calc-push (calc-normalize (aref info 8)))
 237              (calc-alg-entry)))
 238          (setq calc-undo-list nil
 239                calc-redo-list nil
 240                ident mode-line-buffer-identification)))
 241       (setq calc-embedded-info info
 242             calc-embedded-modes modes
 243             mode-line-buffer-identification ident
 244             truncate-lines t
 245             buffer-read-only t)
 246       (set-buffer-modified-p (buffer-modified-p))
 247       (use-local-map calc-mode-map)
 248       (setq calc-no-refresh-evaltos nil)
 249       (and chg calc-any-evaltos (calc-wrapper (calc-refresh-evaltos)))
 250       (or (eq calc-embedded-quiet t)
 251           (message "Embedded Calc mode enabled.  %s to return to normal."
 252                    (if calc-embedded-quiet
 253                        "Type `M-# x'"
 254                      "Give this command again")))))
 255   (scroll-down 0)    ; fix a bug which occurs when truncate-lines is changed.
 256 )
 257 (setq calc-embedded-quiet nil)
 258
 259
 260 (defun calc-embedded-select (arg)
 261   (interactive "P")
 262   (calc-embedded arg)
 263   (and calc-embedded-info
 264        (eq (car-safe (aref calc-embedded-info 8)) 'calcFunc-evalto)
 265        (calc-select-part 1))
 266   (and calc-embedded-info
 267        (or (eq (car-safe (aref calc-embedded-info 8)) 'calcFunc-assign)
 268            (and (eq (car-safe (aref calc-embedded-info 8)) 'calcFunc-evalto)
 269                 (eq (car-safe (nth 1 (aref calc-embedded-info 8)))
 270                     'calcFunc-assign)))
 271        (calc-select-part 2))
 272 )
 273
 274
 275 (defun calc-embedded-update-formula (arg)
 276   (interactive "P")
 277   (if arg
 278       (let ((entry (assq (current-buffer) calc-embedded-active)))
 279         (while (setq entry (cdr entry))
 280           (and (eq (car-safe (aref (car entry) 8)) 'calcFunc-evalto)
 281                (or (not (consp arg))
 282                    (and (<= (aref (car entry) 2) (region-beginning))
 283                         (>= (aref (car entry) 3) (region-end))))
 284                (save-excursion
 285                  (calc-embedded-update (car entry) 14 t t)))))
 286     (if (and calc-embedded-info
 287              (eq (current-buffer) (aref calc-embedded-info 0))
 288              (>= (point) (aref calc-embedded-info 4))
 289              (<= (point) (aref calc-embedded-info 5)))
 290         (calc-evaluate 1)
 291       (let* ((opt (point))
 292              (info (calc-embedded-make-info (point) nil t))
 293              (pt (- opt (aref info 4))))
 294         (or (eq (car-safe (aref info 8)) 'error)
 295             (progn
 296               (save-excursion
 297                 (calc-embedded-update info 14 'eval t))
 298               (goto-char (+ (aref info 4) pt)))))))
 299 )
 300
 301
 302 (defun calc-embedded-edit (arg)
 303   (interactive "P")
 304   (let ((info (calc-embedded-make-info (point) nil t arg))
 305         str)
 306     (if (eq (car-safe (aref info 8)) 'error)
 307         (progn
 308           (goto-char (nth 1 (aref info 8)))
 309           (error (nth 2 (aref info 8)))))
 310     (calc-wrapper
 311      (setq str (math-showing-full-precision
 312                 (math-format-nice-expr (aref info 8) (frame-width))))
 313      (calc-edit-mode (list 'calc-embedded-finish-edit info))
 314      (insert str "\n")))
 315   (calc-show-edit-buffer)
 316 )
 317
 318 (defun calc-embedded-finish-edit (info)
 319   (let ((buf (current-buffer))
 320         (str (buffer-substring (point) (point-max)))
 321         (start (point))
 322         pos)
 323     (switch-to-buffer calc-original-buffer)
 324     (let ((val (save-excursion
 325                  (set-buffer (aref info 1))
 326                  (let ((calc-language nil)
 327                        (math-expr-opers math-standard-opers))
 328                    (math-read-expr str)))))
 329       (if (eq (car-safe val) 'error)
 330           (progn
 331             (switch-to-buffer buf)
 332             (goto-char (+ start (nth 1 val)))
 333             (error (nth 2 val))))
 334       (calc-embedded-original-buffer t info)
 335       (aset info 8 val)
 336       (calc-embedded-update info 14 t t)))
 337 )
 338
 339 (defun calc-do-embedded-activate (arg cbuf)
 340   (calc-plain-buffer-only)
 341   (if arg
 342       (calc-embedded-forget))
 343   (calc-find-globals)
 344   (if (< (prefix-numeric-value arg) 0)
 345       (message "Deactivating %s for Calc Embedded mode." (buffer-name))
 346     (message "Activating %s for Calc Embedded mode..." (buffer-name))
 347     (save-excursion
 348       (let* ((active (assq (current-buffer) calc-embedded-active))
 349              (info active)
 350              (pat " := \\| \\\\gets \\| => \\| \\\\evalto "))
 351         (if calc-embedded-announce-formula
 352             (setq pat (format "%s\\|\\(%s\\)"
 353                               pat calc-embedded-announce-formula)))
 354         (while (setq info (cdr info))
 355           (or (equal (buffer-substring (aref (car info) 2) (aref (car info) 3))
 356                      (aref (car info) 6))
 357               (setcdr active (delq (car info) (cdr active)))))
 358         (goto-char (point-min))
 359         (while (re-search-forward pat nil t)
 360           (if (looking-at calc-embedded-open-formula)
 361               (goto-char (match-end 1)))
 362           (setq info (calc-embedded-make-info (point) cbuf nil))
 363           (or (eq (car-safe (aref info 8)) 'error)
 364               (goto-char (aref info 5))))))
 365     (message "Activating %s for Calc Embedded mode...done" (buffer-name)))
 366   (calc-embedded-active-state t)
 367 )
 368
 369 (defun calc-plain-buffer-only ()
 370   (if (memq major-mode '(calc-mode calc-trail-mode calc-edit-mode))
 371       (error "This command should be used in a normal editing buffer"))
 372 )
 373
 374 (defun calc-embedded-active-state (state)
 375   (defvar calc-embedded-all-active nil)
 376   (or (assq 'calc-embedded-all-active minor-mode-alist)
 377       (setq minor-mode-alist
 378             (cons '(calc-embedded-all-active " Active")
 379                   (cons '(calc-embedded-some-active " ~Active")
 380                         minor-mode-alist))))
 381   (let ((active (assq (current-buffer) calc-embedded-active)))
 382     (or (cdr active)
 383         (setq state nil)))
 384   (and (eq state 'more) calc-embedded-all-active (setq state t))
 385   (setq calc-embedded-all-active (eq state t)
 386         calc-embedded-some-active (not (memq state '(nil t))))
 387   (set-buffer-modified-p (buffer-modified-p))
 388 )
 389
 390
 391 (defun calc-embedded-original-buffer (switch &optional info)
 392   (or info (setq info calc-embedded-info))
 393   (or (buffer-name (aref info 0))
 394       (progn
 395         (error "Calc embedded mode: Original buffer has been killed")))
 396   (if switch
 397       (set-buffer (aref info 0)))
 398 )
 399
 400 (defun calc-embedded-word ()
 401   (interactive)
 402   (calc-embedded '(4))
 403 )
 404
 405 (defun calc-embedded-mark-formula (&optional body-only)
 406   "Put point at the beginning of this Calc formula, mark at the end.
 407 This normally marks the whole formula, including surrounding delimiters.
 408 With any prefix argument, marks only the formula itself."
 409   (interactive "P")
 410   (and (eq major-mode 'calc-mode)
 411        (error "This command should be used in a normal editing buffer"))
 412   (let (top bot outer-top outer-bot)
 413     (save-excursion
 414       (calc-embedded-find-bounds body-only))
 415     (push-mark (if body-only bot outer-bot) t)
 416     (goto-char (if body-only top outer-top)))
 417 )
 418
 419 (defun calc-embedded-find-bounds (&optional plain)
 420   ;; (while (and (bolp) (eq (following-char) ?\n))
 421   ;;  (forward-char 1))
 422   (and (eolp) (bolp) (not (eq (char-after (- (point) 2)) ?\n))
 423        (forward-char -1))
 424   (let ((home (point)))
 425     (or (and (looking-at calc-embedded-open-formula)
 426              (not (looking-at calc-embedded-close-formula)))
 427         (re-search-backward calc-embedded-open-formula nil t)
 428         (error "Can't find start of formula"))
 429     (and (eq (preceding-char) ?\$)  ; backward search for \$\$? won't back
 430          (eq (following-char) ?\$)  ; up over a second $, so do it by hand.
 431          (forward-char -1))
 432     (setq outer-top (point))
 433     (goto-char (match-end 0))
 434     (if (eq (following-char) ?\n)
 435         (forward-char 1))
 436     (or (bolp)
 437         (while (eq (following-char) ?\ )
 438           (forward-char 1)))
 439     (or (eq plain 'plain)
 440         (if (looking-at (regexp-quote calc-embedded-open-plain))
 441             (progn
 442               (goto-char (match-end 0))
 443               (search-forward calc-embedded-close-plain))))
 444     (setq top (point))
 445     (or (re-search-forward calc-embedded-close-formula nil t)
 446         (error "Can't find end of formula"))
 447     (if (< (point) home)
 448         (error "Not inside a formula"))
 449     (and (eq (following-char) ?\n) (not (bolp))
 450          (forward-char 1))
 451     (setq outer-bot (point))
 452     (goto-char (match-beginning 0))
 453     (if (eq (preceding-char) ?\n)
 454         (backward-char 1))
 455     (or (eolp)
 456         (while (eq (preceding-char) ?\ )
 457           (backward-char 1)))
 458     (setq bot (point)))
 459 )
 460
 461 (defun calc-embedded-kill-formula ()
 462   "Kill the formula surrounding point.
 463 If Calc Embedded mode was active, this deactivates it.
 464 The formula (including its surrounding delimiters) is saved in the kill ring.
 465 The command \\[yank] can retrieve it from there."
 466   (interactive)
 467   (and calc-embedded-info
 468        (calc-embedded nil))
 469   (calc-embedded-mark-formula)
 470   (kill-region (point) (mark))
 471   (pop-mark)
 472 )
 473
 474 (defun calc-embedded-copy-formula-as-kill ()
 475   "Save the formula surrounding point as if killed, but don't kill it."
 476   (interactive)
 477   (save-excursion
 478     (calc-embedded-mark-formula)
 479     (copy-region-as-kill (point) (mark))
 480     (pop-mark))
 481 )
 482
 483 (defun calc-embedded-duplicate ()
 484   (interactive)
 485   (let ((already calc-embedded-info)
 486         top bot outer-top outer-bot new-top)
 487     (if calc-embedded-info
 488         (progn
 489           (setq top (+ (aref calc-embedded-info 2))
 490                 bot (+ (aref calc-embedded-info 3))
 491                 outer-top (+ (aref calc-embedded-info 4))
 492                 outer-bot (+ (aref calc-embedded-info 5)))
 493           (calc-embedded nil))
 494       (calc-embedded-find-bounds))
 495     (goto-char outer-bot)
 496     (insert "\n")
 497     (setq new-top (point))
 498     (insert-buffer-substring (current-buffer) outer-top outer-bot)
 499     (goto-char (+ new-top (- top outer-top)))
 500     (let ((calc-embedded-quiet (if already t 'x)))
 501       (calc-embedded (+ new-top (- top outer-top))
 502                      (+ new-top (- bot outer-top))
 503                      new-top
 504                      (+ new-top (- outer-bot outer-top)))))
 505 )
 506
 507 (defun calc-embedded-next (arg)
 508   (interactive "P")
 509   (setq arg (prefix-numeric-value arg))
 510   (let* ((active (cdr (assq (current-buffer) calc-embedded-active)))
 511          (p active)
 512          (num (length active)))
 513     (or active
 514         (error "No active formulas in buffer"))
 515     (cond ((= arg 0))
 516           ((= arg -1)
 517            (if (<= (point) (aref (car active) 3))
 518                (goto-char (aref (nth (1- num) active) 2))
 519              (while (and (cdr p)
 520                          (> (point) (aref (nth 1 p) 3)))
 521                (setq p (cdr p)))
 522              (goto-char (aref (car p) 2))))
 523           ((< arg -1)
 524            (calc-embedded-next -1)
 525            (calc-embedded-next (+ (* num 1000) arg 1)))
 526           (t
 527            (setq arg (1+ (% (1- arg) num)))
 528            (while (and p (>= (point) (aref (car p) 2)))
 529              (setq p (cdr p)))
 530            (while (> (setq arg (1- arg)) 0)
 531              (setq p (if p (cdr p) (cdr active))))
 532            (goto-char (aref (car (or p active)) 2)))))
 533 )
 534
 535 (defun calc-embedded-previous (arg)
 536   (interactive "p")
 537   (calc-embedded-next (- (prefix-numeric-value arg)))
 538 )
 539
 540 (defun calc-embedded-new-formula ()
 541   (interactive)
 542   (and (eq major-mode 'calc-mode)
 543        (error "This command should be used in a normal editing buffer"))
 544   (if calc-embedded-info
 545       (calc-embedded nil))
 546   (let (top bot outer-top outer-bot)
 547     (if (and (eq (preceding-char) ?\n)
 548              (string-match "\\`\n" calc-embedded-open-new-formula))
 549         (progn
 550           (setq outer-top (1- (point)))
 551           (forward-char -1)
 552           (insert (substring calc-embedded-open-new-formula 1)))
 553       (setq outer-top (point))
 554       (insert calc-embedded-open-new-formula))
 555     (setq top (point))
 556     (insert " ")
 557     (setq bot (point))
 558     (insert calc-embedded-close-new-formula)
 559     (if (and (eq (following-char) ?\n)
 560              (string-match "\n\\'" calc-embedded-close-new-formula))
 561         (delete-char 1))
 562     (setq outer-bot (point))
 563     (goto-char top)
 564     (let ((calc-embedded-quiet 'x))
 565       (calc-embedded top bot outer-top outer-bot)))
 566 )
 567
 568 (defun calc-embedded-forget ()
 569   (interactive)
 570   (setq calc-embedded-active (delq (assq (current-buffer) calc-embedded-active)
 571                                    calc-embedded-active))
 572   (calc-embedded-active-state nil)
 573 )
 574
 575
 576 (defun calc-embedded-set-modes (gmodes modes local-modes &optional temp)
 577   (let ((the-language (calc-embedded-language))
 578         (the-display-just (calc-embedded-justify))
 579         (v gmodes)
 580         (changed nil)
 581         found value)
 582     (while v
 583       (or (symbolp (car v))
 584           (and (setq found (assq (car (car v)) modes))
 585                (not (eq (cdr found) 'default)))
 586           (and (setq found (assq (car (car v)) local-modes))
 587                (not (eq (cdr found) 'default)))
 588           (progn
 589             (if (eq (setq value (cdr (car v))) 'default)
 590                 (setq value (cdr (assq (car (car v)) calc-mode-var-list))))
 591             (equal (symbol-value (car (car v))) value))
 592           (progn
 593             (setq changed t)
 594             (if temp (setq prev-modes (cons (cons (car (car v))
 595                                                   (symbol-value (car (car v))))
 596                                             prev-modes)))
 597             (set (car (car v)) value)))
 598       (setq v (cdr v)))
 599     (setq v modes)
 600     (while v
 601       (or (and (setq found (assq (car (car v)) local-modes))
 602                (not (eq (cdr found) 'default)))
 603           (eq (setq value (cdr (car v))) 'default)
 604           (equal (symbol-value (car (car v))) value)
 605           (progn
 606             (setq changed t)
 607             (if temp (setq prev-modes (cons (cons (car (car v))
 608                                                   (symbol-value (car (car v))))
 609                                             prev-modes)))
 610             (set (car (car v)) value)))
 611       (setq v (cdr v)))
 612     (setq v local-modes)
 613     (while v
 614       (or (eq (setq value (cdr (car v))) 'default)
 615           (equal (symbol-value (car (car v))) value)
 616           (progn
 617             (setq changed t)
 618             (if temp (setq prev-modes (cons (cons (car (car v))
 619                                                   (symbol-value (car (car v))))
 620                                             prev-modes)))
 621             (set (car (car v)) value)))
 622       (setq v (cdr v)))
 623     (and changed (not (eq temp t))
 624          (progn
 625            (calc-embedded-set-justify the-display-just)
 626            (calc-embedded-set-language the-language)))
 627     (and changed (not temp)
 628          (progn
 629            (setq calc-full-float-format (list (if (eq (car calc-float-format)
 630                                                       'fix)
 631                                                   'float
 632                                                 (car calc-float-format))
 633                                               0))
 634            (calc-refresh)))
 635     changed)
 636 )
 637
 638 (defun calc-embedded-language ()
 639   (if calc-language-option
 640       (list calc-language calc-language-option)
 641     calc-language)
 642 )
 643
 644 (defun calc-embedded-set-language (lang)
 645   (let ((option nil))
 646     (if (consp lang)
 647         (setq option (nth 1 lang)
 648               lang (car lang)))
 649     (or (and (eq lang calc-language)
 650              (equal option calc-language-option))
 651         (calc-set-language lang option t)))
 652 )
 653
 654 (defun calc-embedded-justify ()
 655   (if calc-display-origin
 656       (list calc-display-just calc-display-origin)
 657     calc-display-just)
 658 )
 659
 660 (defun calc-embedded-set-justify (just)
 661   (if (consp just)
 662       (setq calc-display-origin (nth 1 just)
 663             calc-display-just (car just))
 664     (setq calc-display-just just
 665           calc-display-origin nil))
 666 )
 667
 668
 669 (defun calc-find-globals ()
 670   (interactive)
 671   (and (eq major-mode 'calc-mode)
 672        (error "This command should be used in a normal editing buffer"))
 673   (make-local-variable 'calc-embedded-globals)
 674   (let ((case-fold-search nil)
 675         (modes nil)
 676         (save-pt (point))
 677         found value)
 678     (goto-char (point-min))
 679     (while (re-search-forward "\\[calc-global-mode: *\\([-a-z]+\\): *\\(\"\\([^\"\n\\]\\|\\\\.\\)*\"\\|[- ()a-zA-Z0-9]+\\)\\]" nil t)
 680       (and (setq found (assoc (buffer-substring (match-beginning 1)
 681                                                 (match-end 1))
 682                               calc-embedded-mode-vars))
 683            (or (assq (cdr found) modes)
 684                (setq modes (cons (cons (cdr found)
 685                                        (car (read-from-string
 686                                              (buffer-substring
 687                                               (match-beginning 2)
 688                                               (match-end 2)))))
 689                                  modes)))))
 690     (setq calc-embedded-globals (cons t modes))
 691     (goto-char save-pt))
 692 )
 693
 694 (defun calc-embedded-find-modes ()
 695   (let ((case-fold-search nil)
 696         (save-pt (point))
 697         (no-defaults t)
 698         (modes nil)
 699         (emodes nil)
 700         (pmodes nil)
 701         found value)
 702     (while (and no-defaults (search-backward "[calc-" nil t))
 703       (forward-char 6)
 704       (or (and (looking-at "mode: *\\([-a-z]+\\): *\\(\"\\([^\"\n\\]\\|\\\\.\\)*\"\\|[- ()a-zA-Z0-9]+\\)]")
 705                (setq found (assoc (buffer-substring (match-beginning 1)
 706                                                     (match-end 1))
 707                                   calc-embedded-mode-vars))
 708                (or (assq (cdr found) modes)
 709                    (setq modes (cons (cons (cdr found)
 710                                            (car (read-from-string
 711                                                  (buffer-substring
 712                                                   (match-beginning 2)
 713                                                   (match-end 2)))))
 714                                      modes))))
 715           (and (looking-at "perm-mode: *\\([-a-z]+\\): *\\(\"\\([^\"\n\\]\\|\\\\.\\)*\"\\|[- ()a-zA-Z0-9]+\\)]")
 716                (setq found (assoc (buffer-substring (match-beginning 1)
 717                                                     (match-end 1))
 718                                   calc-embedded-mode-vars))
 719                (or (assq (cdr found) pmodes)
 720                    (setq pmodes (cons (cons (cdr found)
 721                                             (car (read-from-string
 722                                                   (buffer-substring
 723                                                    (match-beginning 2)
 724                                                    (match-end 2)))))
 725                                       pmodes))))
 726           (and (looking-at "edit-mode: *\\([-a-z]+\\): *\\(\"\\([^\"\n\\]\\|\\\\.\\)*\"\\|[- ()a-zA-Z0-9]+\\)]")
 727                (setq found (assoc (buffer-substring (match-beginning 1)
 728                                                     (match-end 1))
 729                                   calc-embedded-mode-vars))
 730                (or (assq (cdr found) emodes)
 731                    (setq emodes (cons (cons (cdr found)
 732                                             (car (read-from-string
 733                                                   (buffer-substring
 734                                                    (match-beginning 2)
 735                                                    (match-end 2)))))
 736                                       emodes))))
 737           (and (looking-at "defaults]")
 738                (setq no-defaults nil)))
 739       (backward-char 6))
 740     (goto-char save-pt)
 741     (list modes emodes pmodes))
 742 )
 743
 744
 745 (defun calc-embedded-make-info (point cbuf fresh &optional
 746                                       top bot outer-top outer-bot)
 747   (let* ((bufentry (assq (current-buffer) calc-embedded-active))
 748          (found bufentry)
 749          (force (and fresh top))
 750          (fixed top)
 751          (new-info nil)
 752          info str)
 753     (or found
 754         (setq found (list (current-buffer))
 755               calc-embedded-active (cons found calc-embedded-active)))
 756     (while (and (cdr found)
 757                 (> point (aref (car (cdr found)) 3)))
 758       (setq found (cdr found)))
 759     (if (and (cdr found)
 760              (>= point (aref (nth 1 found) 2)))
 761         (setq info (nth 1 found))
 762       (setq info (make-vector 16 nil)
 763             new-info t
 764             fresh t)
 765       (aset info 0 (current-buffer))
 766       (aset info 1 (or cbuf (save-excursion
 767                               (calc-create-buffer)
 768                               (current-buffer)))))
 769     (if (and (integerp top) (not bot))  ; started with a user-supplied argument
 770         (progn
 771           (if (= (setq arg (prefix-numeric-value arg)) 0)
 772               (progn
 773                 (aset info 2 (copy-marker (region-beginning)))
 774                 (aset info 3 (copy-marker (region-end))))
 775             (aset info (if (> arg 0) 2 3) (point-marker))
 776             (forward-line arg)
 777             (aset info (if (> arg 0) 3 2) (point-marker)))
 778           (aset info 4 (copy-marker (aref info 2)))
 779           (aset info 5 (copy-marker (aref info 3))))
 780       (if (aref info 4)
 781           (setq top (aref info 2)
 782                 fixed top)
 783         (if (consp top)
 784             (let ((calc-embedded-open-formula calc-embedded-open-word)
 785                   (calc-embedded-close-formula calc-embedded-close-word))
 786               (calc-embedded-find-bounds 'plain))
 787           (or top
 788               (calc-embedded-find-bounds 'plain)))
 789         (aset info 2 (copy-marker (min top bot)))
 790         (aset info 3 (copy-marker (max top bot)))
 791         (aset info 4 (copy-marker (or outer-top (aref info 2))))
 792         (aset info 5 (copy-marker (or outer-bot (aref info 3))))))
 793     (goto-char (aref info 2))
 794     (if new-info
 795         (progn
 796           (or (bolp) (aset info 7 t))
 797           (goto-char (aref info 3))
 798           (or (bolp) (eolp) (aset info 7 t))))
 799     (if fresh
 800         (let ((modes (calc-embedded-find-modes)))
 801           (aset info 12 (car modes))
 802           (aset info 13 (nth 1 modes))
 803           (aset info 14 (nth 2 modes))))
 804     (aset info 15 calc-embedded-globals)
 805     (setq str (buffer-substring (aref info 2) (aref info 3)))
 806     (if (or force
 807             (not (equal str (aref info 6))))
 808         (if (and fixed (aref info 6))
 809             (progn
 810               (aset info 4 nil)
 811               (calc-embedded-make-info point cbuf nil)
 812               (setq new-info nil))
 813           (let* ((open-plain calc-embedded-open-plain)
 814                  (close-plain calc-embedded-close-plain)
 815                  (pref-len (length open-plain))
 816                  (vars-used nil)
 817                  suff-pos val temp)
 818             (save-excursion
 819               (set-buffer (aref info 1))
 820               (calc-embedded-set-modes (aref info 15)
 821                                        (aref info 12) (aref info 14))
 822               (if (and (> (length str) pref-len)
 823                        (equal (substring str 0 pref-len) open-plain)
 824                        (setq suff-pos (string-match (regexp-quote close-plain)
 825                                                     str pref-len)))
 826                   (setq val (math-read-plain-expr
 827                              (substring str pref-len suff-pos)))
 828                 (if (string-match "[^ \t\n]" str)
 829                     (setq pref-len 0
 830                           val (math-read-big-expr str))
 831                   (setq val nil))))
 832             (if (eq (car-safe val) 'error)
 833                 (setq val (list 'error
 834                                 (+ (aref info 2) pref-len (nth 1 val))
 835                                 (nth 2 val))))
 836             (aset info 6 str)
 837             (aset info 8 val)
 838             (setq temp val)
 839             (if (eq (car-safe temp) 'calcFunc-evalto)
 840                 (setq temp (nth 1 temp))
 841               (if (eq (car-safe temp) 'error)
 842                   (if new-info
 843                       (setq new-info nil)
 844                     (setcdr found (delq info (cdr found)))
 845                     (calc-embedded-active-state 'less))))
 846             (aset info 9 (and (eq (car-safe temp) 'calcFunc-assign)
 847                               (nth 1 temp)))
 848             (if (memq (car-safe val) '(calcFunc-evalto calcFunc-assign))
 849                 (calc-embedded-find-vars val))
 850             (aset info 10 vars-used)
 851             (aset info 11 nil))))
 852     (if new-info
 853         (progn
 854           (setcdr found (cons info (cdr found)))
 855           (calc-embedded-active-state 'more)))
 856     info)
 857 )
 858
 859 (defun calc-embedded-find-vars (x)
 860   (cond ((Math-primp x)
 861          (and (eq (car-safe x) 'var)
 862               (not (assoc x vars-used))
 863               (setq vars-used (cons (list x) vars-used))))
 864         ((eq (car x) 'calcFunc-evalto)
 865          (calc-embedded-find-vars (nth 1 x)))
 866         ((eq (car x) 'calcFunc-assign)
 867          (calc-embedded-find-vars (nth 2 x)))
 868         (t
 869          (and (eq (car x) 'calcFunc-subscr)
 870               (eq (car-safe (nth 1 x)) 'var)
 871               (Math-primp (nth 2 x))
 872               (not (assoc x vars-used))
 873               (setq vars-used (cons (list x) vars-used)))
 874          (while (setq x (cdr x))
 875            (calc-embedded-find-vars (car x)))))
 876 )
 877
 878
 879 (defun calc-embedded-evaluate-expr (x)
 880   (let ((vars-used (aref calc-embedded-info 10)))
 881     (or vars-used (calc-embedded-find-vars x))
 882     (if vars-used
 883         (let ((active (assq (aref calc-embedded-info 0) calc-embedded-active))
 884               (args nil))
 885           (save-excursion
 886             (calc-embedded-original-buffer t)
 887             (or active
 888                 (progn
 889                   (calc-embedded-activate)
 890                   (setq active (assq (aref calc-embedded-info 0)
 891                                      calc-embedded-active))))
 892             (while vars-used
 893               (calc-embedded-eval-get-var (car (car vars-used)) active)
 894               (setq vars-used (cdr vars-used))))
 895           (calc-embedded-subst x))
 896       (calc-normalize (math-evaluate-expr-rec x))))
 897 )
 898
 899 (defun calc-embedded-subst (x)
 900   (if (and (eq (car-safe x) 'calcFunc-evalto) (cdr x))
 901       (let ((rhs (calc-embedded-subst (nth 1 x))))
 902         (list 'calcFunc-evalto
 903               (nth 1 x)
 904               (if (eq (car-safe rhs) 'calcFunc-assign) (nth 2 rhs) rhs)))
 905     (if (and (eq (car-safe x) 'calcFunc-assign) (= (length x) 3))
 906         (list 'calcFunc-assign
 907               (nth 1 x)
 908               (calc-embedded-subst (nth 2 x)))
 909       (calc-normalize (math-evaluate-expr-rec (math-multi-subst-rec x)))))
 910 )
 911
 912 (defun calc-embedded-eval-get-var (var base)
 913   (let ((entry base)
 914         (point (aref calc-embedded-info 2))
 915         (last nil)
 916         val)
 917     (while (and (setq entry (cdr entry))
 918                 (or (not (equal var (aref (car entry) 9)))
 919                     (and (> point (aref (car entry) 3))
 920                          (setq last entry)))))
 921     (if last
 922         (setq entry last))
 923     (if entry
 924         (progn
 925           (setq entry (car entry))
 926           (if (equal (buffer-substring (aref entry 2) (aref entry 3))
 927                      (aref entry 6))
 928               (progn
 929                 (or (aref entry 11)
 930                     (save-excursion
 931                       (calc-embedded-update entry 14 t nil)))
 932                 (setq val (aref entry 11))
 933                 (if (eq (car-safe val) 'calcFunc-evalto)
 934                     (setq val (nth 2 val)))
 935                 (if (eq (car-safe val) 'calcFunc-assign)
 936                     (setq val (nth 2 val)))
 937                 (setq args (cons (cons var val) args)))
 938             (calc-embedded-activate)
 939             (calc-embedded-eval-get-var var base)))))
 940 )
 941
 942
 943 (defun calc-embedded-update (info which need-eval need-display
 944                                   &optional str entry old-val)
 945   (let* ((prev-modes nil)
 946          (open-plain calc-embedded-open-plain)
 947          (close-plain calc-embedded-close-plain)
 948          (vars-used nil)
 949          (evalled nil)
 950          (val (aref info 8))
 951          (old-eval (aref info 11)))
 952     (or old-val (setq old-val val))
 953     (if (eq (car-safe val) 'calcFunc-evalto)
 954         (setq need-display t))
 955     (unwind-protect
 956         (progn
 957           (set-buffer (aref info 1))
 958           (and which
 959                (calc-embedded-set-modes (aref info 15) (aref info 12)
 960                                         (aref info which)
 961                                         (if need-display 'full t)))
 962           (if (memq (car-safe val) '(calcFunc-evalto calcFunc-assign))
 963               (calc-embedded-find-vars val))
 964           (if need-eval
 965               (let ((calc-embedded-info info))
 966                 (setq val (math-evaluate-expr val)
 967                       evalled val)))
 968           (if (or (eq need-eval 'eval) (eq (car-safe val) 'calcFunc-evalto))
 969               (aset info 8 val))
 970           (aset info 9 nil)
 971           (aset info 10 vars-used)
 972           (aset info 11 nil)
 973           (if (or need-display (eq (car-safe val) 'calcFunc-evalto))
 974               (let ((extra (if (eq calc-language 'big) 1 0)))
 975                 (or entry (setq entry (list val 1 nil)))
 976                 (or str (progn
 977                           (setq str (let ((calc-line-numbering nil))
 978                                       (math-format-stack-value entry)))
 979                           (if (eq calc-language 'big)
 980                               (setq str (substring str 0 -1)))))
 981                 (and calc-show-plain
 982                      (setq str (concat open-plain
 983                                        (math-showing-full-precision
 984                                         (math-format-flat-expr val 0))
 985                                        close-plain
 986                                        str)))
 987                 (save-excursion
 988                   (calc-embedded-original-buffer t info)
 989                   (or (equal str (aref info 6))
 990                       (let ((delta (- (aref info 5) (aref info 3)))
 991                             (buffer-read-only nil))
 992                         (goto-char (aref info 2))
 993                         (delete-region (point) (aref info 3))
 994                         (and (> (nth 1 entry) (1+ extra))
 995                              (aref info 7)
 996                              (progn
 997                                (aset info 7 nil)
 998                                (delete-horizontal-space)
 999                                (insert "\n\n")
1000                                (delete-horizontal-space)
1001                                (backward-char 1)))
1002                         (insert str)
1003                         (set-marker (aref info 3) (point))
1004                         (set-marker (aref info 5) (+ (point) delta))
1005                         (aset info 6 str))))))
1006           (if (eq (car-safe val) 'calcFunc-evalto)
1007               (progn
1008                 (setq evalled (nth 2 val)
1009                       val (nth 1 val))))
1010           (if (eq (car-safe val) 'calcFunc-assign)
1011               (progn
1012                 (aset info 9 (nth 1 val))
1013                 (aset info 11 (or evalled
1014                                   (let ((calc-embedded-info info))
1015                                     (math-evaluate-expr (nth 2 val)))))
1016                 (or (equal old-eval (aref info 11))
1017                     (calc-embedded-var-change (nth 1 val) (aref info 0))))
1018             (if (eq (car-safe old-val) 'calcFunc-evalto)
1019                 (setq old-val (nth 1 old-val)))
1020             (if (eq (car-safe old-val) 'calcFunc-assign)
1021                 (calc-embedded-var-change (nth 1 old-val) (aref info 0)))))
1022       (set-buffer (aref info 1))
1023       (while prev-modes
1024         (cond ((eq (car (car prev-modes)) 'the-language)
1025                (if need-display
1026                    (calc-embedded-set-language (cdr (car prev-modes)))))
1027               ((eq (car (car prev-modes)) 'the-display-just)
1028                (if need-display
1029                    (calc-embedded-set-justify (cdr (car prev-modes)))))
1030               (t
1031                (set (car (car prev-modes)) (cdr (car prev-modes)))))
1032         (setq prev-modes (cdr prev-modes)))))
1033 )
1034
1035
1036
1037
1038 ;;; These are hooks called by the main part of Calc.
1039
1040 (defun calc-embedded-select-buffer ()
1041   (if (eq (current-buffer) (aref calc-embedded-info 0))
1042       (let ((info calc-embedded-info)
1043             horiz vert)
1044         (if (and (or (< (point) (aref info 4))
1045                      (> (point) (aref info 5)))
1046                  (not calc-embedded-no-reselect))
1047             (let ((calc-embedded-quiet t))
1048               (message "(Switching Calc Embedded mode to new formula.)")
1049               (calc-embedded nil)
1050               (calc-embedded nil)))
1051         (setq horiz (max (min (current-column) (- (point) (aref info 2))) 0)
1052               vert (if (<= (aref info 2) (point))
1053                        (- (count-lines (aref info 2) (point))
1054                           (if (bolp) 0 1))
1055                      0))
1056         (set-buffer (aref info 1))
1057         (if calc-show-plain
1058             (if (= vert 0)
1059                 (setq horiz 0)
1060               (setq vert (1- vert))))
1061         (calc-cursor-stack-index 1)
1062         (if calc-line-numbering
1063             (setq horiz (+ horiz 4)))
1064         (if (> vert 0)
1065             (forward-line vert))
1066         (forward-char (min horiz
1067                            (- (point-max) (point)))))
1068     (calc-select-buffer))
1069 )
1070 (setq calc-embedded-no-reselect nil)
1071
1072 (defun calc-embedded-finish-command ()
1073   (let ((buf (current-buffer))
1074         horiz vert)
1075     (save-excursion
1076       (set-buffer (aref calc-embedded-info 1))
1077       (if (> (calc-stack-size) 0)
1078           (let ((pt (point))
1079                 (col (current-column))
1080                 (bol (bolp)))
1081             (calc-cursor-stack-index 0)
1082             (if (< pt (point))
1083                 (progn
1084                   (calc-cursor-stack-index 1)
1085                   (if (>= pt (point))
1086                       (progn
1087                         (setq horiz (- col (if calc-line-numbering 4 0))
1088                               vert (- (count-lines (point) pt)
1089                                       (if bol 0 1)))
1090                         (if calc-show-plain
1091                             (setq vert (max 1 (1+ vert))))))))
1092             (goto-char pt))))
1093     (if horiz
1094         (progn
1095           (set-buffer (aref calc-embedded-info 0))
1096           (goto-char (aref calc-embedded-info 2))
1097           (if (> vert 0)
1098               (forward-line vert))
1099           (forward-char (max horiz 0))
1100           (set-buffer buf))))
1101 )
1102
1103 (defun calc-embedded-stack-change ()
1104   (or calc-executing-macro
1105       (save-excursion
1106         (set-buffer (aref calc-embedded-info 1))
1107         (let* ((info calc-embedded-info)
1108                (extra-line (if (eq calc-language 'big) 1 0))
1109                (the-point (point))
1110                (empty (= (calc-stack-size) 0))
1111                (entry (if empty
1112                           (list '(var empty var-empty) 1 nil)
1113                         (calc-top 1 'entry)))
1114                (old-val (aref info 8))
1115                top bot str)
1116           (if empty
1117               (setq str "empty")
1118             (save-excursion
1119               (calc-cursor-stack-index 1)
1120               (setq top (point))
1121               (calc-cursor-stack-index 0)
1122               (setq bot (- (point) extra-line))
1123               (setq str (buffer-substring top (- bot 1))))
1124             (if calc-line-numbering
1125                 (let ((pos 0))
1126                   (setq str (substring str 4))
1127                   (while (setq pos (string-match "\n...." str pos))
1128                     (setq str (concat (substring str 0 (1+ pos))
1129                                       (substring str (+ pos 5)))
1130                           pos (1+ pos))))))
1131           (calc-embedded-original-buffer t)
1132           (aset info 8 (car entry))
1133           (calc-embedded-update info 13 nil t str entry old-val))))
1134 )
1135
1136 (defun calc-embedded-mode-line-change ()
1137   (let ((str mode-line-buffer-identification))
1138     (save-excursion
1139       (calc-embedded-original-buffer t)
1140       (setq mode-line-buffer-identification str)
1141       (set-buffer-modified-p (buffer-modified-p))))
1142 )
1143
1144 (defun calc-embedded-modes-change (vars)
1145   (if (eq (car vars) 'calc-language) (setq vars '(the-language)))
1146   (if (eq (car vars) 'calc-display-just) (setq vars '(the-display-just)))
1147   (while (and vars
1148               (not (rassq (car vars) calc-embedded-mode-vars)))
1149     (setq vars (cdr vars)))
1150   (if (and vars calc-mode-save-mode (not (eq calc-mode-save-mode 'save)))
1151       (save-excursion
1152         (let* ((save-mode calc-mode-save-mode)
1153                (header (if (eq save-mode 'local)
1154                            "calc-mode:"
1155                          (format "calc-%s-mode:" save-mode)))
1156                (the-language (calc-embedded-language))
1157                (the-display-just (calc-embedded-justify))
1158                (values (mapcar 'symbol-value vars))
1159                (num (cond ((eq save-mode 'local) 12)
1160                           ((eq save-mode 'edit) 13)
1161                           ((eq save-mode 'perm) 14)
1162                           (t nil)))
1163                base limit mname mlist)
1164           (calc-embedded-original-buffer t)
1165           (save-excursion
1166             (if (eq save-mode 'global)
1167                 (setq base (point-max)
1168                       limit (point-min)
1169                       mlist calc-embedded-globals)
1170               (goto-char (aref calc-embedded-info 4))
1171               (beginning-of-line)
1172               (setq base (point)
1173                     limit (max (- (point) 1000) (point-min))
1174                     mlist (and num (aref calc-embedded-info num)))
1175               (and (re-search-backward
1176                     (format "\\(%s\\)[^\001]*\\(%s\\)\\|\\[calc-defaults]"
1177                             calc-embedded-open-formula
1178                             calc-embedded-close-formula) limit t)
1179                    (setq limit (point))))
1180             (while vars
1181               (goto-char base)
1182               (if (setq mname (car (rassq (car vars)
1183                                           calc-embedded-mode-vars)))
1184                   (let ((buffer-read-only nil)
1185                         (found (assq (car vars) mlist)))
1186                     (if found
1187                         (setcdr found (car values))
1188                       (setq mlist (cons (cons (car vars) (car values)) mlist))
1189                       (if num
1190                           (aset calc-embedded-info num mlist)
1191                         (if (eq save-mode 'global)
1192                             (setq calc-embedded-globals mlist))))
1193                     (if (re-search-backward
1194                          (format "\\[%s *%s: *\\(\"\\([^\"\n\\]\\|\\\\.\\)*\"\\|[- ()a-zA-Z0-9]+\\)]"
1195                                  header mname)
1196                          limit t)
1197                         (progn
1198                           (goto-char (match-beginning 1))
1199                           (delete-region (point) (match-end 1))
1200                           (insert (prin1-to-string (car values))))
1201                       (goto-char base)
1202                       (insert-before-markers
1203                        calc-embedded-open-mode
1204                        "[" header " " mname ": "
1205                        (prin1-to-string (car values)) "]"
1206                        calc-embedded-close-mode))))
1207               (setq vars (cdr vars)
1208                     values (cdr values)))))))
1209 )
1210
1211 (defun calc-embedded-var-change (var &optional buf)
1212   (if (symbolp var)
1213       (setq var (list 'var
1214                       (if (string-match "\\`var-.+\\'"
1215                                         (symbol-name var))
1216                           (intern (substring (symbol-name var) 4))
1217                         var)
1218                       var)))
1219   (save-excursion
1220     (let ((manual (not calc-auto-recompute))
1221           (bp calc-embedded-active)
1222           (first t))
1223       (if buf (setq bp (memq (assq buf bp) bp)))
1224       (while bp
1225         (let ((calc-embedded-no-reselect t)
1226               (p (and (buffer-name (car (car bp)))
1227                       (cdr (car bp)))))
1228           (while p
1229             (if (assoc var (aref (car p) 10))
1230                 (if manual
1231                     (if (aref (car p) 11)
1232                         (progn
1233                           (aset (car p) 11 nil)
1234                           (if (aref (car p) 9)
1235                               (calc-embedded-var-change (aref (car p) 9)))))
1236                   (set-buffer (aref (car p) 0))
1237                   (if (equal (buffer-substring (aref (car p) 2)
1238                                                (aref (car p) 3))
1239                              (aref (car p) 6))
1240                       (let ((calc-embedded-info nil))
1241                         (or calc-embedded-quiet
1242                             (message "Recomputing..."))
1243                         (setq first nil)
1244                         (calc-wrapper
1245                          (set-buffer (aref (car p) 0))
1246                          (calc-embedded-update (car p) 14 t nil)))
1247                     (setcdr (car bp) (delq (car p) (cdr (car bp))))
1248                     (message
1249                      "(Tried to recompute but formula was changed or missing.)"))))
1250             (setq p (cdr p))))
1251         (setq bp (if buf nil (cdr bp))))
1252       (or first calc-embedded-quiet (message ""))))
1253 )
1254
1255
1256
1257
1258