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