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