cgit.sxemacs.org Git - packages/blob - xemacs-packages/calc/calc-embed.el

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