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