code.delx.au - gnu-emacs/blob - lisp/calc/calc-embed.el

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