Add 2010 to copyright years.
[bpt/emacs.git] / lisp / calc / calc-yank.el
CommitLineData
3132f345
CW
1;;; calc-yank.el --- kill-ring functionality for Calc
2
58ba2f8f 3;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004,
114f9c96 4;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
3132f345
CW
5
6;; Author: David Gillespie <daveg@synaptics.com>
e8fff8ed 7;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
136211a9
EZ
8
9;; This file is part of GNU Emacs.
10
662c9c64 11;; GNU Emacs is free software: you can redistribute it and/or modify
7c671b23 12;; it under the terms of the GNU General Public License as published by
662c9c64
GM
13;; the Free Software Foundation, either version 3 of the License, or
14;; (at your option) any later version.
7c671b23 15
136211a9 16;; GNU Emacs is distributed in the hope that it will be useful,
7c671b23
GM
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
662c9c64 22;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
136211a9 23
3132f345 24;;; Commentary:
136211a9 25
3132f345 26;;; Code:
136211a9
EZ
27
28;; This file is autoloaded from calc-ext.el.
136211a9 29
b1687f60 30(require 'calc-ext)
136211a9
EZ
31(require 'calc-macs)
32
136211a9
EZ
33;;; Kill ring commands.
34
35(defun calc-kill (nn &optional no-delete)
36 (interactive "P")
37 (if (eq major-mode 'calc-mode)
38 (calc-wrapper
39 (calc-force-refresh)
40 (calc-set-command-flag 'no-align)
41 (let ((num (max (calc-locate-cursor-element (point)) 1))
42 (n (prefix-numeric-value nn)))
43 (if (< n 0)
44 (progn
45 (if (eobp)
46 (setq num (1- num)))
47 (setq num (- num n)
48 n (- n))))
87bd269a 49 (calc-check-stack num)
136211a9
EZ
50 (let ((stuff (calc-top-list n (- num n -1))))
51 (calc-cursor-stack-index num)
52 (let ((first (point)))
53 (calc-cursor-stack-index (- num n))
54 (if (null nn)
55 (backward-char 1)) ; don't include newline for raw C-k
56 (copy-region-as-kill first (point))
57 (if (not no-delete)
58 (calc-pop-stack n (- num n -1))))
59 (setq calc-last-kill (cons (car kill-ring) stuff)))))
bf77c646 60 (kill-line nn)))
136211a9
EZ
61
62(defun calc-force-refresh ()
63 (if (or calc-executing-macro calc-display-dirty)
64 (let ((calc-executing-macro nil))
bf77c646 65 (calc-refresh))))
136211a9
EZ
66
67(defun calc-locate-cursor-element (pt)
68 (save-excursion
69 (goto-char (point-max))
bf77c646 70 (calc-locate-cursor-scan (- calc-stack-top) calc-stack pt)))
136211a9
EZ
71
72(defun calc-locate-cursor-scan (n stack pt)
73 (if (or (<= (point) pt)
74 (null stack))
75 n
76 (forward-line (- (nth 1 (car stack))))
bf77c646 77 (calc-locate-cursor-scan (1+ n) (cdr stack) pt)))
136211a9
EZ
78
79(defun calc-kill-region (top bot &optional no-delete)
80 (interactive "r")
81 (if (eq major-mode 'calc-mode)
82 (calc-wrapper
83 (calc-force-refresh)
84 (calc-set-command-flag 'no-align)
85 (let* ((top-num (calc-locate-cursor-element top))
87bd269a
JB
86 (top-pos (save-excursion
87 (calc-cursor-stack-index top-num)
88 (point)))
136211a9 89 (bot-num (calc-locate-cursor-element (1- bot)))
87bd269a
JB
90 (bot-pos (save-excursion
91 (calc-cursor-stack-index (max 0 (1- bot-num)))
92 (point)))
136211a9 93 (num (- top-num bot-num -1)))
87bd269a 94 (copy-region-as-kill top-pos bot-pos)
136211a9
EZ
95 (setq calc-last-kill (cons (car kill-ring)
96 (calc-top-list num bot-num)))
97 (if (not no-delete)
98 (calc-pop-stack num bot-num))))
99 (if no-delete
100 (copy-region-as-kill top bot)
bf77c646 101 (kill-region top bot))))
136211a9
EZ
102
103(defun calc-copy-as-kill (n)
104 (interactive "P")
bf77c646 105 (calc-kill n t))
136211a9
EZ
106
107(defun calc-copy-region-as-kill (top bot)
108 (interactive "r")
bf77c646 109 (calc-kill-region top bot t))
136211a9 110
2378f044
SM
111;; This function uses calc-last-kill if possible to get an exact result,
112;; otherwise it just parses the yanked string.
113;; Modified to use Emacs 19 extended concept of kill-ring. -- daveg 12/15/96
114;;;###autoload
136211a9
EZ
115(defun calc-yank ()
116 (interactive)
117 (calc-wrapper
118 (calc-pop-push-record-list
119 0 "yank"
120 (let ((thing (if (fboundp 'current-kill)
121 (current-kill 0 t)
122 (car kill-ring-yank-pointer))))
123 (if (eq (car-safe calc-last-kill) thing)
124 (cdr calc-last-kill)
125 (if (stringp thing)
126 (let ((val (math-read-exprs (calc-clean-newlines thing))))
127 (if (eq (car-safe val) 'error)
128 (progn
129 (setq val (math-read-exprs thing))
130 (if (eq (car-safe val) 'error)
131 (error "Bad format in yanked data")
132 val))
bf77c646 133 val))))))))
136211a9 134
c8a991aa
JB
135;;; The Calc set- and get-register commands are modified versions of functions
136;;; in register.el
137
138(defvar calc-register-alist nil
139 "Alist of elements (NAME . (TEXT . CALCVAL)).
140NAME is a character (a number).
141TEXT and CALCVAL are the TEXT and internal structure of stack entries.")
142
143(defun calc-set-register (register text calcval)
144 "Set the contents of the Calc register REGISTER to (TEXT . CALCVAL),
145as well as set the contents of the Emacs register REGISTER to TEXT."
146 (set-register register text)
147 (let ((aelt (assq register calc-register-alist)))
148 (if aelt
149 (setcdr aelt (cons text calcval))
150 (push (cons register (cons text calcval)) calc-register-alist))))
151
152(defun calc-get-register (reg)
153 "Return the CALCVAL portion of the contents of the Calc register REG,
154unless the TEXT portion doesn't match the contents of the Emacs register REG,
155in which case either return the contents of the Emacs register (if it is
156text) or `nil'."
157 (let ((cval (cdr (assq reg calc-register-alist)))
158 (val (cdr (assq reg register-alist))))
2e4daa0e
JB
159 (if (stringp val)
160 (if (and (stringp (car cval))
161 (string= (car cval) val))
c8a991aa
JB
162 (cdr cval)
163 val))))
164
165(defun calc-copy-to-register (register start end &optional delete-flag)
166 "Copy the lines in the region into register REGISTER.
167With prefix arg, delete as well."
168 (interactive "cCopy to register: \nr\nP")
169 (if (eq major-mode 'calc-mode)
170 (let* ((top-num (calc-locate-cursor-element start))
171 (top-pos (save-excursion
172 (calc-cursor-stack-index top-num)
173 (point)))
174 (bot-num (calc-locate-cursor-element (1- end)))
175 (bot-pos (save-excursion
176 (calc-cursor-stack-index (max 0 (1- bot-num)))
177 (point)))
178 (num (- top-num bot-num -1))
179 (str (buffer-substring top-pos bot-pos)))
180 (calc-set-register register str (calc-top-list num bot-num))
181 (if delete-flag
182 (calc-wrapper
183 (calc-pop-stack num bot-num))))
184 (copy-to-register register start end delete-flag)))
185
186(defun calc-insert-register (register)
187 "Insert the contents of register REGISTER."
188 (interactive "cInsert register: ")
189 (if (eq major-mode 'calc-mode)
190 (let ((val (calc-get-register register)))
191 (calc-wrapper
192 (calc-pop-push-record-list
193 0 "insr"
194 (if (not val)
195 (error "Bad format in register data")
196 (if (consp val)
197 val
198 (let ((nval (math-read-exprs (calc-clean-newlines val))))
199 (if (eq (car-safe nval) 'error)
200 (progn
201 (setq nval (math-read-exprs val))
202 (if (eq (car-safe nval) 'error)
203 (error "Bad format in register data")
204 nval))
205 nval)))))))
206 (insert-register register)))
207
208(defun calc-add-to-register (register start end prepend delete-flag)
209 "Add the lines in the region to register REGISTER.
210If PREPEND is non-nil, add them to the beginning of the register,
211otherwise the end. If DELETE-FLAG is non-nil, also delete the region."
212 (let* ((top-num (calc-locate-cursor-element start))
213 (top-pos (save-excursion
214 (calc-cursor-stack-index top-num)
215 (point)))
216 (bot-num (calc-locate-cursor-element (1- end)))
217 (bot-pos (save-excursion
218 (calc-cursor-stack-index (max 0 (1- bot-num)))
219 (point)))
220 (num (- top-num bot-num -1))
221 (str (buffer-substring top-pos bot-pos))
222 (calcval (calc-top-list num bot-num))
223 (cval (cdr (assq register calc-register-alist))))
224 (if (not cval)
225 (calc-set-register register str calcval)
226 (if prepend
227 (calc-set-register
228 register
229 (concat str (car cval))
230 (append calcval (cdr cval)))
231 (calc-set-register
232 register
233 (concat (car cval) str)
234 (append (cdr cval) calcval))))
235 (if delete-flag
236 (calc-wrapper
237 (calc-pop-stack num bot-num)))))
238
239(defun calc-append-to-register (register start end &optional delete-flag)
240 "Copy the lines in the region to the end of register REGISTER.
241With prefix arg, also delete the region."
242 (interactive "cAppend to register: \nr\nP")
243 (if (eq major-mode 'calc-mode)
244 (calc-add-to-register register start end nil delete-flag)
245 (append-to-register register start end delete-flag)))
246
247(defun calc-prepend-to-register (register start end &optional delete-flag)
248 "Copy the lines in the region to the beginning of register REGISTER.
249With prefix arg, also delete the region."
250 (interactive "cPrepend to register: \nr\nP")
251 (if (eq major-mode 'calc-mode)
252 (calc-add-to-register register start end t delete-flag)
253 (prepend-to-register register start end delete-flag)))
254
255
256
136211a9
EZ
257(defun calc-clean-newlines (s)
258 (cond
a1506d29 259
136211a9
EZ
260 ;; Omit leading/trailing whitespace
261 ((or (string-match "\\`[ \n\r]+\\([^\001]*\\)\\'" s)
262 (string-match "\\`\\([^\001]*\\)[ \n\r]+\\'" s))
263 (calc-clean-newlines (math-match-substring s 1)))
264
265 ;; Convert newlines to commas
266 ((string-match "\\`\\(.*\\)[\n\r]+\\([^\001]*\\)\\'" s)
267 (calc-clean-newlines (concat (math-match-substring s 1) ","
268 (math-match-substring s 2))))
a1506d29 269
bf77c646 270 (t s)))
136211a9
EZ
271
272
273(defun calc-do-grab-region (top bot arg)
3132f345
CW
274 (when (memq major-mode '(calc-mode calc-trail-mode))
275 (error "This command works only in a regular text buffer"))
136211a9
EZ
276 (let* ((from-buffer (current-buffer))
277 (calc-was-started (get-buffer-window "*Calculator*"))
278 (single nil)
279 data vals pos)
280 (if arg
281 (if (consp arg)
282 (setq single t)
283 (setq arg (prefix-numeric-value arg))
284 (if (= arg 0)
285 (save-excursion
286 (beginning-of-line)
287 (setq top (point))
288 (end-of-line)
289 (setq bot (point)))
290 (save-excursion
291 (setq top (point))
292 (forward-line arg)
293 (if (> arg 0)
294 (setq bot (point))
295 (setq bot top
296 top (point)))))))
297 (setq data (buffer-substring top bot))
298 (calc)
299 (if single
300 (setq vals (math-read-expr data))
301 (setq vals (math-read-expr (concat "[" data "]")))
302 (and (eq (car-safe vals) 'vec)
303 (= (length vals) 2)
304 (eq (car-safe (nth 1 vals)) 'vec)
305 (setq vals (nth 1 vals))))
306 (if (eq (car-safe vals) 'error)
307 (progn
308 (if calc-was-started
309 (pop-to-buffer from-buffer)
310 (calc-quit t)
311 (switch-to-buffer from-buffer))
312 (goto-char top)
313 (forward-char (+ (nth 1 vals) (if single 0 1)))
314 (error (nth 2 vals))))
315 (calc-slow-wrapper
bf77c646 316 (calc-enter-result 0 "grab" vals))))
136211a9
EZ
317
318
319(defun calc-do-grab-rectangle (top bot arg &optional reduce)
320 (and (memq major-mode '(calc-mode calc-trail-mode))
3132f345 321 (error "This command works only in a regular text buffer"))
136211a9
EZ
322 (let* ((col1 (save-excursion (goto-char top) (current-column)))
323 (col2 (save-excursion (goto-char bot) (current-column)))
324 (from-buffer (current-buffer))
325 (calc-was-started (get-buffer-window "*Calculator*"))
326 data mat vals lnum pt pos)
327 (if (= col1 col2)
328 (save-excursion
3132f345
CW
329 (unless (= col1 0)
330 (error "Point and mark must be at beginning of line, or define a rectangle"))
136211a9
EZ
331 (goto-char top)
332 (while (< (point) bot)
333 (setq pt (point))
334 (forward-line 1)
335 (setq data (cons (buffer-substring pt (1- (point))) data)))
336 (setq data (nreverse data)))
337 (setq data (extract-rectangle top bot)))
338 (calc)
339 (setq mat (list 'vec)
340 lnum 0)
3132f345
CW
341 (when arg
342 (setq arg (if (consp arg) 0 (prefix-numeric-value arg))))
136211a9
EZ
343 (while data
344 (if (natnump arg)
345 (progn
346 (if (= arg 0)
347 (setq arg 1000000))
348 (setq pos 0
349 vals (list 'vec))
350 (let ((w (length (car data)))
351 j v)
352 (while (< pos w)
353 (setq j (+ pos arg)
354 v (if (>= j w)
355 (math-read-expr (substring (car data) pos))
356 (math-read-expr (substring (car data) pos j))))
357 (if (eq (car-safe v) 'error)
358 (setq vals v w 0)
359 (setq vals (nconc vals (list v))
360 pos j)))))
361 (if (string-match "\\` *-?[0-9][0-9]?[0-9]?[0-9]?[0-9]?[0-9]? *\\'"
362 (car data))
ca9cbc31 363 (setq vals (list 'vec (string-to-number (car data))))
136211a9
EZ
364 (if (and (null arg)
365 (string-match "[[{][^][{}]*[]}]" (car data)))
366 (setq pos (match-beginning 0)
367 vals (math-read-expr (math-match-substring (car data) 0)))
368 (let ((s (if (string-match
369 "\\`\\([0-9]+:[ \t]\\)?\\(.*[^, \t]\\)[, \t]*\\'"
370 (car data))
371 (math-match-substring (car data) 2)
372 (car data))))
373 (setq pos -1
374 vals (math-read-expr (concat "[" s "]")))
375 (if (eq (car-safe vals) 'error)
376 (let ((v2 (math-read-expr s)))
3132f345
CW
377 (unless (eq (car-safe v2) 'error)
378 (setq vals (list 'vec v2)))))))))
136211a9
EZ
379 (if (eq (car-safe vals) 'error)
380 (progn
381 (if calc-was-started
382 (pop-to-buffer from-buffer)
383 (calc-quit t)
384 (switch-to-buffer from-buffer))
385 (goto-char top)
386 (forward-line lnum)
387 (forward-char (+ (nth 1 vals) (min col1 col2) pos))
388 (error (nth 2 vals))))
3132f345
CW
389 (unless (equal vals '(vec))
390 (setq mat (cons vals mat)))
136211a9
EZ
391 (setq data (cdr data)
392 lnum (1+ lnum)))
393 (calc-slow-wrapper
394 (if reduce
395 (calc-enter-result 0 "grb+" (list reduce '(var add var-add)
396 (nreverse mat)))
bf77c646 397 (calc-enter-result 0 "grab" (nreverse mat))))))
136211a9
EZ
398
399
400(defun calc-copy-to-buffer (nn)
401 "Copy the top of stack into an editing buffer."
402 (interactive "P")
403 (let ((thebuf (and (not (memq major-mode '(calc-mode calc-trail-mode)))
404 (current-buffer)))
405 (movept nil)
406 oldbuf newbuf)
407 (calc-wrapper
408 (save-excursion
409 (calc-force-refresh)
410 (let ((n (prefix-numeric-value nn))
411 (eat-lnums calc-line-numbering)
412 (big-offset (if (eq calc-language 'big) 1 0))
413 top bot)
414 (setq oldbuf (current-buffer)
415 newbuf (or thebuf
416 (calc-find-writable-buffer (buffer-list) 0)
417 (calc-find-writable-buffer (buffer-list) 1)
418 (error "No other buffer")))
419 (cond ((and (or (null nn)
420 (consp nn))
421 (= (calc-substack-height 0)
422 (- (1- (calc-substack-height 1)) big-offset)))
423 (calc-cursor-stack-index 1)
424 (if (looking-at
425 (if calc-line-numbering "[0-9]+: *[^ \n]" " *[^ \n]"))
426 (goto-char (1- (match-end 0))))
427 (setq eat-lnums nil
428 top (point))
429 (calc-cursor-stack-index 0)
430 (setq bot (- (1- (point)) big-offset)))
431 ((> n 0)
432 (calc-cursor-stack-index n)
433 (setq top (point))
434 (calc-cursor-stack-index 0)
435 (setq bot (- (point) big-offset)))
436 ((< n 0)
437 (calc-cursor-stack-index (- n))
438 (setq top (point))
439 (calc-cursor-stack-index (1- (- n)))
440 (setq bot (point)))
441 (t
442 (goto-char (point-min))
443 (forward-line 1)
444 (setq top (point))
445 (calc-cursor-stack-index 0)
446 (setq bot (point))))
6df9b6d7 447 (with-current-buffer newbuf
136211a9
EZ
448 (if (consp nn)
449 (kill-region (region-beginning) (region-end)))
450 (push-mark (point) t)
451 (if (and overwrite-mode (not (consp nn)))
6df9b6d7 452 (calc-overwrite-string (with-current-buffer oldbuf
136211a9
EZ
453 (buffer-substring top bot))
454 eat-lnums)
455 (or (bolp) (setq eat-lnums nil))
456 (insert-buffer-substring oldbuf top bot)
457 (and eat-lnums
458 (let ((n 1))
459 (while (and (> (point) (mark))
460 (progn
461 (forward-line -1)
462 (>= (point) (mark))))
463 (delete-char 4)
464 (setq n (1+ n)))
465 (forward-line n))))
3132f345
CW
466 (when thebuf
467 (setq movept (point)))
468 (when (get-buffer-window (current-buffer))
469 (set-window-point (get-buffer-window (current-buffer))
470 (point)))))))
471 (when movept
472 (goto-char movept))
473 (when (and (consp nn)
474 (not thebuf))
475 (calc-quit t)
476 (switch-to-buffer newbuf))))
136211a9
EZ
477
478(defun calc-overwrite-string (str eat-lnums)
3132f345
CW
479 (when (string-match "\n\\'" str)
480 (setq str (substring str 0 -1)))
481 (when eat-lnums
482 (setq str (substring str 4)))
136211a9
EZ
483 (if (and (string-match "\\`[-+]?[0-9.]+\\(e-?[0-9]+\\)?\\'" str)
484 (looking-at "[-+]?[0-9.]+\\(e-?[0-9]+\\)?"))
485 (progn
486 (delete-region (point) (match-end 0))
487 (insert str))
488 (let ((i 0))
489 (while (< i (length str))
e93c003e 490 (if (= (setq last-command-event (aref str i)) ?\n)
136211a9
EZ
491 (or (= i (1- (length str)))
492 (let ((pt (point)))
493 (end-of-line)
494 (delete-region pt (point))
495 (if (eobp)
496 (insert "\n")
497 (forward-char 1))
498 (if eat-lnums (setq i (+ i 4)))))
499 (self-insert-command 1))
bf77c646 500 (setq i (1+ i))))))
136211a9 501
2378f044
SM
502;; First, require that buffer is visible and does not begin with "*"
503;; Second, require only that it not begin with "*Calc"
136211a9
EZ
504(defun calc-find-writable-buffer (buf mode)
505 (and buf
506 (if (or (string-match "\\`\\( .*\\|\\*Calc.*\\)"
507 (buffer-name (car buf)))
508 (and (= mode 0)
509 (or (string-match "\\`\\*.*" (buffer-name (car buf)))
510 (not (get-buffer-window (car buf))))))
511 (calc-find-writable-buffer (cdr buf) mode)
bf77c646 512 (car buf))))
136211a9
EZ
513
514
515(defun calc-edit (n)
516 (interactive "p")
517 (calc-slow-wrapper
3132f345
CW
518 (when (eq n 0)
519 (setq n (calc-stack-size)))
136211a9
EZ
520 (let* ((flag nil)
521 (allow-ret (> n 1))
522 (list (math-showing-full-precision
523 (mapcar (if (> n 1)
524 (function (lambda (x)
525 (math-format-flat-expr x 0)))
526 (function
527 (lambda (x)
528 (if (math-vectorp x) (setq allow-ret t))
8f66f479 529 (math-format-nice-expr x (frame-width)))))
136211a9
EZ
530 (if (> n 0)
531 (calc-top-list n)
532 (calc-top-list 1 (- n)))))))
533 (calc-edit-mode (list 'calc-finish-stack-edit (or flag n)) allow-ret)
534 (while list
535 (insert (car list) "\n")
536 (setq list (cdr list)))))
bf77c646 537 (calc-show-edit-buffer))
136211a9
EZ
538
539(defun calc-alg-edit (str)
540 (calc-edit-mode '(calc-finish-stack-edit 0))
541 (calc-show-edit-buffer)
542 (insert str "\n")
543 (backward-char 1)
bf77c646 544 (calc-set-command-flag 'do-edit))
136211a9 545
2378f044
SM
546(defvar calc-edit-mode-map
547 (let ((map (make-sparse-keymap)))
548 (define-key map "\n" 'calc-edit-finish)
549 (define-key map "\r" 'calc-edit-return)
550 (define-key map "\C-c\C-c" 'calc-edit-finish)
551 map)
552 "Keymap for use by the calc-edit command.")
136211a9 553
3f53a1f4
JB
554(defvar calc-original-buffer)
555(defvar calc-return-buffer)
556(defvar calc-one-window)
557(defvar calc-edit-handler)
558(defvar calc-restore-trail)
559(defvar calc-allow-ret)
f57a0962 560(defvar calc-edit-top)
3f53a1f4 561
136211a9
EZ
562(defun calc-edit-mode (&optional handler allow-ret title)
563 "Calculator editing mode. Press RET, LFD, or C-c C-c to finish.
564To cancel the edit, simply kill the *Calc Edit* buffer."
565 (interactive)
3132f345
CW
566 (unless handler
567 (error "This command can be used only indirectly through calc-edit"))
136211a9
EZ
568 (let ((oldbuf (current-buffer))
569 (buf (get-buffer-create "*Calc Edit*")))
570 (set-buffer buf)
571 (kill-all-local-variables)
572 (use-local-map calc-edit-mode-map)
573 (setq buffer-read-only nil)
574 (setq truncate-lines nil)
575 (setq major-mode 'calc-edit-mode)
576 (setq mode-name "Calc Edit")
5c5fb26b 577 (run-mode-hooks 'calc-edit-mode-hook)
136211a9
EZ
578 (make-local-variable 'calc-original-buffer)
579 (setq calc-original-buffer oldbuf)
580 (make-local-variable 'calc-return-buffer)
581 (setq calc-return-buffer oldbuf)
582 (make-local-variable 'calc-one-window)
583 (setq calc-one-window (and (one-window-p t) pop-up-windows))
584 (make-local-variable 'calc-edit-handler)
585 (setq calc-edit-handler handler)
586 (make-local-variable 'calc-restore-trail)
587 (setq calc-restore-trail (get-buffer-window (calc-trail-buffer)))
588 (make-local-variable 'calc-allow-ret)
589 (setq calc-allow-ret allow-ret)
48e7c397
JB
590 (let ((inhibit-read-only t))
591 (erase-buffer))
dcbdf573
JB
592 (add-hook 'kill-buffer-hook (lambda ()
593 (let ((calc-edit-handler nil))
594 (calc-edit-finish t))
595 (message "(Cancelled)")) t t)
72e53dcd
JB
596 (insert (propertize
597 (concat
598 (or title title "Calc Edit Mode. ")
599 "Press `C-c C-c'"
600 (if allow-ret "" " or RET")
601 " to finish, `C-x k RET' to cancel.\n\n")
f57a0962
JB
602 'font-lock-face 'italic 'read-only t 'rear-nonsticky t 'front-sticky t))
603 (make-local-variable 'calc-edit-top)
604 (setq calc-edit-top (point))))
136211a9
EZ
605(put 'calc-edit-mode 'mode-class 'special)
606
607(defun calc-show-edit-buffer ()
608 (let ((buf (current-buffer)))
609 (if (and (one-window-p t) pop-up-windows)
610 (pop-to-buffer (get-buffer-create "*Calc Edit*"))
611 (and calc-embedded-info (get-buffer-window (aref calc-embedded-info 1))
612 (select-window (get-buffer-window (aref calc-embedded-info 1))))
613 (switch-to-buffer (get-buffer-create "*Calc Edit*")))
614 (setq calc-return-buffer buf)
8f66f479 615 (if (and (< (window-width) (frame-width))
136211a9
EZ
616 calc-display-trail)
617 (let ((win (get-buffer-window (calc-trail-buffer))))
618 (if win
619 (delete-window win))))
620 (set-buffer-modified-p nil)
f57a0962 621 (goto-char calc-edit-top)))
136211a9
EZ
622
623(defun calc-edit-return ()
624 (interactive)
625 (if (and (boundp 'calc-allow-ret) calc-allow-ret)
626 (newline)
bf77c646 627 (calc-edit-finish)))
136211a9 628
7fc684b3
JB
629;; The variable calc-edit-disp-trail is local to calc-edit finish, but
630;; is used by calc-finish-selection-edit and calc-finish-stack-edit.
631(defvar calc-edit-disp-trail)
632
136211a9
EZ
633(defun calc-edit-finish (&optional keep)
634 "Finish calc-edit mode. Parse buffer contents and push them on the stack."
635 (interactive "P")
636 (message "Working...")
637 (or (and (boundp 'calc-original-buffer)
638 (boundp 'calc-return-buffer)
639 (boundp 'calc-one-window)
640 (boundp 'calc-edit-handler)
641 (boundp 'calc-restore-trail)
642 (eq major-mode 'calc-edit-mode))
3132f345 643 (error "This command is valid only in buffers created by calc-edit"))
136211a9
EZ
644 (let ((buf (current-buffer))
645 (original calc-original-buffer)
646 (return calc-return-buffer)
647 (one-window calc-one-window)
7fc684b3 648 (calc-edit-disp-trail calc-restore-trail))
136211a9 649 (save-excursion
3132f345
CW
650 (when (or (null (buffer-name original))
651 (progn
652 (set-buffer original)
653 (not (eq major-mode 'calc-mode))))
654 (error "Original calculator buffer has been corrupted")))
f57a0962 655 (goto-char calc-edit-top)
136211a9
EZ
656 (if (buffer-modified-p)
657 (eval calc-edit-handler))
a1ed7bec 658 (if (and one-window (not (one-window-p t)))
136211a9
EZ
659 (delete-window))
660 (if (get-buffer-window return)
661 (select-window (get-buffer-window return))
662 (switch-to-buffer return))
663 (if keep
664 (bury-buffer buf)
665 (kill-buffer buf))
7fc684b3 666 (if calc-edit-disp-trail
136211a9
EZ
667 (calc-wrapper
668 (calc-trail-display 1 t)))
bf77c646 669 (message "")))
136211a9
EZ
670
671(defun calc-edit-cancel ()
672 "Cancel calc-edit mode. Ignore the Calc Edit buffer and don't change stack."
673 (interactive)
674 (let ((calc-edit-handler nil))
675 (calc-edit-finish))
bf77c646 676 (message "(Cancelled)"))
136211a9
EZ
677
678(defun calc-finish-stack-edit (num)
679 (let ((buf (current-buffer))
f57a0962 680 (str (buffer-substring calc-edit-top (point-max)))
136211a9
EZ
681 (start (point))
682 pos)
683 (if (and (integerp num) (> num 1))
684 (while (setq pos (string-match "\n." str))
685 (aset str pos ?\,)))
686 (switch-to-buffer calc-original-buffer)
687 (let ((vals (let ((calc-language nil)
84812f0e 688 (math-expr-opers (math-standard-ops)))
136211a9
EZ
689 (and (string-match "[^\n\t ]" str)
690 (math-read-exprs str)))))
3132f345
CW
691 (when (eq (car-safe vals) 'error)
692 (switch-to-buffer buf)
693 (goto-char (+ start (nth 1 vals)))
694 (error (nth 2 vals)))
136211a9
EZ
695 (calc-wrapper
696 (if (symbolp num)
697 (progn
698 (set num (car vals))
699 (calc-refresh-evaltos num))
7fc684b3 700 (if calc-edit-disp-trail
136211a9
EZ
701 (calc-trail-display 1 t))
702 (and vals
e93c003e 703 (let ((calc-simplify-mode (if (eq last-command-event ?\C-j)
136211a9
EZ
704 'none
705 calc-simplify-mode)))
706 (if (>= num 0)
707 (calc-enter-result num "edit" vals)
bf77c646 708 (calc-enter-result 1 "edit" vals (- num))))))))))
136211a9 709
b1687f60
JB
710(provide 'calc-yank)
711
2378f044
SM
712;; Local variables:
713;; generated-autoload-file: "calc-loaddefs.el"
714;; End:
715
716;; arch-tag: ca61019e-caca-4daa-b32c-b6afe372d5b5
bf77c646 717;;; calc-yank.el ends here