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