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

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