lisp/calc/calc-embed.el

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