lisp/calc/calc-embed.el

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