calc-embed.el 50 KB

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