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