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