lisp/calc/calc-embed.el

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