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