Refill some copyright headers.
[bpt/emacs.git] / lisp / calc / calc-yank.el
CommitLineData
3132f345
CW
1;;; calc-yank.el --- kill-ring functionality for Calc
2
e9bffc61
GM
3;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, 2005,
4;; 2006, 2007, 2008, 2009, 2010, 2011 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)
9b026d9f
GM
285 (setq top (point-at-bol)
286 bot (point-at-eol))
136211a9
EZ
287 (save-excursion
288 (setq top (point))
289 (forward-line arg)
290 (if (> arg 0)
291 (setq bot (point))
292 (setq bot top
293 top (point)))))))
294 (setq data (buffer-substring top bot))
295 (calc)
296 (if single
297 (setq vals (math-read-expr data))
298 (setq vals (math-read-expr (concat "[" data "]")))
299 (and (eq (car-safe vals) 'vec)
300 (= (length vals) 2)
301 (eq (car-safe (nth 1 vals)) 'vec)
302 (setq vals (nth 1 vals))))
303 (if (eq (car-safe vals) 'error)
304 (progn
305 (if calc-was-started
306 (pop-to-buffer from-buffer)
307 (calc-quit t)
308 (switch-to-buffer from-buffer))
309 (goto-char top)
310 (forward-char (+ (nth 1 vals) (if single 0 1)))
311 (error (nth 2 vals))))
312 (calc-slow-wrapper
bf77c646 313 (calc-enter-result 0 "grab" vals))))
136211a9
EZ
314
315
316(defun calc-do-grab-rectangle (top bot arg &optional reduce)
317 (and (memq major-mode '(calc-mode calc-trail-mode))
3132f345 318 (error "This command works only in a regular text buffer"))
136211a9
EZ
319 (let* ((col1 (save-excursion (goto-char top) (current-column)))
320 (col2 (save-excursion (goto-char bot) (current-column)))
321 (from-buffer (current-buffer))
322 (calc-was-started (get-buffer-window "*Calculator*"))
323 data mat vals lnum pt pos)
324 (if (= col1 col2)
325 (save-excursion
3132f345
CW
326 (unless (= col1 0)
327 (error "Point and mark must be at beginning of line, or define a rectangle"))
136211a9
EZ
328 (goto-char top)
329 (while (< (point) bot)
330 (setq pt (point))
331 (forward-line 1)
332 (setq data (cons (buffer-substring pt (1- (point))) data)))
333 (setq data (nreverse data)))
334 (setq data (extract-rectangle top bot)))
335 (calc)
336 (setq mat (list 'vec)
337 lnum 0)
3132f345
CW
338 (when arg
339 (setq arg (if (consp arg) 0 (prefix-numeric-value arg))))
136211a9
EZ
340 (while data
341 (if (natnump arg)
342 (progn
343 (if (= arg 0)
344 (setq arg 1000000))
345 (setq pos 0
346 vals (list 'vec))
347 (let ((w (length (car data)))
348 j v)
349 (while (< pos w)
350 (setq j (+ pos arg)
351 v (if (>= j w)
352 (math-read-expr (substring (car data) pos))
353 (math-read-expr (substring (car data) pos j))))
354 (if (eq (car-safe v) 'error)
355 (setq vals v w 0)
356 (setq vals (nconc vals (list v))
357 pos j)))))
358 (if (string-match "\\` *-?[0-9][0-9]?[0-9]?[0-9]?[0-9]?[0-9]? *\\'"
359 (car data))
ca9cbc31 360 (setq vals (list 'vec (string-to-number (car data))))
136211a9
EZ
361 (if (and (null arg)
362 (string-match "[[{][^][{}]*[]}]" (car data)))
363 (setq pos (match-beginning 0)
364 vals (math-read-expr (math-match-substring (car data) 0)))
365 (let ((s (if (string-match
366 "\\`\\([0-9]+:[ \t]\\)?\\(.*[^, \t]\\)[, \t]*\\'"
367 (car data))
368 (math-match-substring (car data) 2)
369 (car data))))
370 (setq pos -1
371 vals (math-read-expr (concat "[" s "]")))
372 (if (eq (car-safe vals) 'error)
373 (let ((v2 (math-read-expr s)))
3132f345
CW
374 (unless (eq (car-safe v2) 'error)
375 (setq vals (list 'vec v2)))))))))
136211a9
EZ
376 (if (eq (car-safe vals) 'error)
377 (progn
378 (if calc-was-started
379 (pop-to-buffer from-buffer)
380 (calc-quit t)
381 (switch-to-buffer from-buffer))
382 (goto-char top)
383 (forward-line lnum)
384 (forward-char (+ (nth 1 vals) (min col1 col2) pos))
385 (error (nth 2 vals))))
3132f345
CW
386 (unless (equal vals '(vec))
387 (setq mat (cons vals mat)))
136211a9
EZ
388 (setq data (cdr data)
389 lnum (1+ lnum)))
390 (calc-slow-wrapper
391 (if reduce
392 (calc-enter-result 0 "grb+" (list reduce '(var add var-add)
393 (nreverse mat)))
bf77c646 394 (calc-enter-result 0 "grab" (nreverse mat))))))
136211a9
EZ
395
396
397(defun calc-copy-to-buffer (nn)
398 "Copy the top of stack into an editing buffer."
399 (interactive "P")
400 (let ((thebuf (and (not (memq major-mode '(calc-mode calc-trail-mode)))
401 (current-buffer)))
402 (movept nil)
403 oldbuf newbuf)
404 (calc-wrapper
405 (save-excursion
406 (calc-force-refresh)
407 (let ((n (prefix-numeric-value nn))
408 (eat-lnums calc-line-numbering)
409 (big-offset (if (eq calc-language 'big) 1 0))
410 top bot)
411 (setq oldbuf (current-buffer)
412 newbuf (or thebuf
413 (calc-find-writable-buffer (buffer-list) 0)
414 (calc-find-writable-buffer (buffer-list) 1)
415 (error "No other buffer")))
416 (cond ((and (or (null nn)
417 (consp nn))
418 (= (calc-substack-height 0)
419 (- (1- (calc-substack-height 1)) big-offset)))
420 (calc-cursor-stack-index 1)
421 (if (looking-at
422 (if calc-line-numbering "[0-9]+: *[^ \n]" " *[^ \n]"))
423 (goto-char (1- (match-end 0))))
424 (setq eat-lnums nil
425 top (point))
426 (calc-cursor-stack-index 0)
427 (setq bot (- (1- (point)) big-offset)))
428 ((> n 0)
429 (calc-cursor-stack-index n)
430 (setq top (point))
431 (calc-cursor-stack-index 0)
432 (setq bot (- (point) big-offset)))
433 ((< n 0)
434 (calc-cursor-stack-index (- n))
435 (setq top (point))
436 (calc-cursor-stack-index (1- (- n)))
437 (setq bot (point)))
438 (t
439 (goto-char (point-min))
440 (forward-line 1)
441 (setq top (point))
442 (calc-cursor-stack-index 0)
443 (setq bot (point))))
6df9b6d7 444 (with-current-buffer newbuf
136211a9
EZ
445 (if (consp nn)
446 (kill-region (region-beginning) (region-end)))
447 (push-mark (point) t)
448 (if (and overwrite-mode (not (consp nn)))
6df9b6d7 449 (calc-overwrite-string (with-current-buffer oldbuf
136211a9
EZ
450 (buffer-substring top bot))
451 eat-lnums)
452 (or (bolp) (setq eat-lnums nil))
453 (insert-buffer-substring oldbuf top bot)
454 (and eat-lnums
455 (let ((n 1))
456 (while (and (> (point) (mark))
457 (progn
458 (forward-line -1)
459 (>= (point) (mark))))
460 (delete-char 4)
461 (setq n (1+ n)))
462 (forward-line n))))
3132f345
CW
463 (when thebuf
464 (setq movept (point)))
465 (when (get-buffer-window (current-buffer))
466 (set-window-point (get-buffer-window (current-buffer))
467 (point)))))))
468 (when movept
469 (goto-char movept))
470 (when (and (consp nn)
471 (not thebuf))
472 (calc-quit t)
473 (switch-to-buffer newbuf))))
136211a9
EZ
474
475(defun calc-overwrite-string (str eat-lnums)
3132f345
CW
476 (when (string-match "\n\\'" str)
477 (setq str (substring str 0 -1)))
478 (when eat-lnums
479 (setq str (substring str 4)))
136211a9
EZ
480 (if (and (string-match "\\`[-+]?[0-9.]+\\(e-?[0-9]+\\)?\\'" str)
481 (looking-at "[-+]?[0-9.]+\\(e-?[0-9]+\\)?"))
482 (progn
483 (delete-region (point) (match-end 0))
484 (insert str))
485 (let ((i 0))
486 (while (< i (length str))
e93c003e 487 (if (= (setq last-command-event (aref str i)) ?\n)
136211a9
EZ
488 (or (= i (1- (length str)))
489 (let ((pt (point)))
490 (end-of-line)
491 (delete-region pt (point))
492 (if (eobp)
493 (insert "\n")
494 (forward-char 1))
495 (if eat-lnums (setq i (+ i 4)))))
496 (self-insert-command 1))
bf77c646 497 (setq i (1+ i))))))
136211a9 498
2378f044
SM
499;; First, require that buffer is visible and does not begin with "*"
500;; Second, require only that it not begin with "*Calc"
136211a9
EZ
501(defun calc-find-writable-buffer (buf mode)
502 (and buf
503 (if (or (string-match "\\`\\( .*\\|\\*Calc.*\\)"
504 (buffer-name (car buf)))
505 (and (= mode 0)
506 (or (string-match "\\`\\*.*" (buffer-name (car buf)))
507 (not (get-buffer-window (car buf))))))
508 (calc-find-writable-buffer (cdr buf) mode)
bf77c646 509 (car buf))))
136211a9
EZ
510
511
512(defun calc-edit (n)
513 (interactive "p")
514 (calc-slow-wrapper
3132f345
CW
515 (when (eq n 0)
516 (setq n (calc-stack-size)))
136211a9
EZ
517 (let* ((flag nil)
518 (allow-ret (> n 1))
519 (list (math-showing-full-precision
520 (mapcar (if (> n 1)
521 (function (lambda (x)
522 (math-format-flat-expr x 0)))
523 (function
524 (lambda (x)
525 (if (math-vectorp x) (setq allow-ret t))
8f66f479 526 (math-format-nice-expr x (frame-width)))))
136211a9
EZ
527 (if (> n 0)
528 (calc-top-list n)
529 (calc-top-list 1 (- n)))))))
530 (calc-edit-mode (list 'calc-finish-stack-edit (or flag n)) allow-ret)
531 (while list
532 (insert (car list) "\n")
533 (setq list (cdr list)))))
bf77c646 534 (calc-show-edit-buffer))
136211a9
EZ
535
536(defun calc-alg-edit (str)
537 (calc-edit-mode '(calc-finish-stack-edit 0))
538 (calc-show-edit-buffer)
539 (insert str "\n")
540 (backward-char 1)
bf77c646 541 (calc-set-command-flag 'do-edit))
136211a9 542
2378f044
SM
543(defvar calc-edit-mode-map
544 (let ((map (make-sparse-keymap)))
545 (define-key map "\n" 'calc-edit-finish)
546 (define-key map "\r" 'calc-edit-return)
547 (define-key map "\C-c\C-c" 'calc-edit-finish)
548 map)
549 "Keymap for use by the calc-edit command.")
136211a9 550
3f53a1f4
JB
551(defvar calc-original-buffer)
552(defvar calc-return-buffer)
553(defvar calc-one-window)
554(defvar calc-edit-handler)
555(defvar calc-restore-trail)
556(defvar calc-allow-ret)
f57a0962 557(defvar calc-edit-top)
3f53a1f4 558
136211a9
EZ
559(defun calc-edit-mode (&optional handler allow-ret title)
560 "Calculator editing mode. Press RET, LFD, or C-c C-c to finish.
561To cancel the edit, simply kill the *Calc Edit* buffer."
562 (interactive)
3132f345
CW
563 (unless handler
564 (error "This command can be used only indirectly through calc-edit"))
136211a9
EZ
565 (let ((oldbuf (current-buffer))
566 (buf (get-buffer-create "*Calc Edit*")))
567 (set-buffer buf)
568 (kill-all-local-variables)
569 (use-local-map calc-edit-mode-map)
570 (setq buffer-read-only nil)
571 (setq truncate-lines nil)
572 (setq major-mode 'calc-edit-mode)
573 (setq mode-name "Calc Edit")
5c5fb26b 574 (run-mode-hooks 'calc-edit-mode-hook)
136211a9
EZ
575 (make-local-variable 'calc-original-buffer)
576 (setq calc-original-buffer oldbuf)
577 (make-local-variable 'calc-return-buffer)
578 (setq calc-return-buffer oldbuf)
579 (make-local-variable 'calc-one-window)
580 (setq calc-one-window (and (one-window-p t) pop-up-windows))
581 (make-local-variable 'calc-edit-handler)
582 (setq calc-edit-handler handler)
583 (make-local-variable 'calc-restore-trail)
584 (setq calc-restore-trail (get-buffer-window (calc-trail-buffer)))
585 (make-local-variable 'calc-allow-ret)
586 (setq calc-allow-ret allow-ret)
48e7c397
JB
587 (let ((inhibit-read-only t))
588 (erase-buffer))
dcbdf573
JB
589 (add-hook 'kill-buffer-hook (lambda ()
590 (let ((calc-edit-handler nil))
591 (calc-edit-finish t))
592 (message "(Cancelled)")) t t)
72e53dcd
JB
593 (insert (propertize
594 (concat
595 (or title title "Calc Edit Mode. ")
596 "Press `C-c C-c'"
597 (if allow-ret "" " or RET")
598 " to finish, `C-x k RET' to cancel.\n\n")
f57a0962
JB
599 'font-lock-face 'italic 'read-only t 'rear-nonsticky t 'front-sticky t))
600 (make-local-variable 'calc-edit-top)
601 (setq calc-edit-top (point))))
136211a9
EZ
602(put 'calc-edit-mode 'mode-class 'special)
603
604(defun calc-show-edit-buffer ()
605 (let ((buf (current-buffer)))
606 (if (and (one-window-p t) pop-up-windows)
607 (pop-to-buffer (get-buffer-create "*Calc Edit*"))
608 (and calc-embedded-info (get-buffer-window (aref calc-embedded-info 1))
609 (select-window (get-buffer-window (aref calc-embedded-info 1))))
610 (switch-to-buffer (get-buffer-create "*Calc Edit*")))
611 (setq calc-return-buffer buf)
8f66f479 612 (if (and (< (window-width) (frame-width))
136211a9
EZ
613 calc-display-trail)
614 (let ((win (get-buffer-window (calc-trail-buffer))))
615 (if win
616 (delete-window win))))
617 (set-buffer-modified-p nil)
f57a0962 618 (goto-char calc-edit-top)))
136211a9
EZ
619
620(defun calc-edit-return ()
621 (interactive)
622 (if (and (boundp 'calc-allow-ret) calc-allow-ret)
623 (newline)
bf77c646 624 (calc-edit-finish)))
136211a9 625
7fc684b3
JB
626;; The variable calc-edit-disp-trail is local to calc-edit finish, but
627;; is used by calc-finish-selection-edit and calc-finish-stack-edit.
628(defvar calc-edit-disp-trail)
629
136211a9
EZ
630(defun calc-edit-finish (&optional keep)
631 "Finish calc-edit mode. Parse buffer contents and push them on the stack."
632 (interactive "P")
633 (message "Working...")
634 (or (and (boundp 'calc-original-buffer)
635 (boundp 'calc-return-buffer)
636 (boundp 'calc-one-window)
637 (boundp 'calc-edit-handler)
638 (boundp 'calc-restore-trail)
639 (eq major-mode 'calc-edit-mode))
3132f345 640 (error "This command is valid only in buffers created by calc-edit"))
136211a9
EZ
641 (let ((buf (current-buffer))
642 (original calc-original-buffer)
643 (return calc-return-buffer)
644 (one-window calc-one-window)
7fc684b3 645 (calc-edit-disp-trail calc-restore-trail))
136211a9 646 (save-excursion
3132f345
CW
647 (when (or (null (buffer-name original))
648 (progn
649 (set-buffer original)
650 (not (eq major-mode 'calc-mode))))
651 (error "Original calculator buffer has been corrupted")))
f57a0962 652 (goto-char calc-edit-top)
136211a9
EZ
653 (if (buffer-modified-p)
654 (eval calc-edit-handler))
a1ed7bec 655 (if (and one-window (not (one-window-p t)))
136211a9
EZ
656 (delete-window))
657 (if (get-buffer-window return)
658 (select-window (get-buffer-window return))
659 (switch-to-buffer return))
660 (if keep
661 (bury-buffer buf)
662 (kill-buffer buf))
7fc684b3 663 (if calc-edit-disp-trail
136211a9
EZ
664 (calc-wrapper
665 (calc-trail-display 1 t)))
bf77c646 666 (message "")))
136211a9
EZ
667
668(defun calc-edit-cancel ()
669 "Cancel calc-edit mode. Ignore the Calc Edit buffer and don't change stack."
670 (interactive)
671 (let ((calc-edit-handler nil))
672 (calc-edit-finish))
bf77c646 673 (message "(Cancelled)"))
136211a9
EZ
674
675(defun calc-finish-stack-edit (num)
676 (let ((buf (current-buffer))
f57a0962 677 (str (buffer-substring calc-edit-top (point-max)))
136211a9
EZ
678 (start (point))
679 pos)
680 (if (and (integerp num) (> num 1))
681 (while (setq pos (string-match "\n." str))
682 (aset str pos ?\,)))
683 (switch-to-buffer calc-original-buffer)
684 (let ((vals (let ((calc-language nil)
84812f0e 685 (math-expr-opers (math-standard-ops)))
136211a9
EZ
686 (and (string-match "[^\n\t ]" str)
687 (math-read-exprs str)))))
3132f345
CW
688 (when (eq (car-safe vals) 'error)
689 (switch-to-buffer buf)
690 (goto-char (+ start (nth 1 vals)))
691 (error (nth 2 vals)))
136211a9
EZ
692 (calc-wrapper
693 (if (symbolp num)
694 (progn
695 (set num (car vals))
696 (calc-refresh-evaltos num))
7fc684b3 697 (if calc-edit-disp-trail
136211a9
EZ
698 (calc-trail-display 1 t))
699 (and vals
e93c003e 700 (let ((calc-simplify-mode (if (eq last-command-event ?\C-j)
136211a9
EZ
701 'none
702 calc-simplify-mode)))
703 (if (>= num 0)
704 (calc-enter-result num "edit" vals)
bf77c646 705 (calc-enter-result 1 "edit" vals (- num))))))))))
136211a9 706
b1687f60
JB
707(provide 'calc-yank)
708
2378f044
SM
709;; Local variables:
710;; generated-autoload-file: "calc-loaddefs.el"
711;; End:
712
bf77c646 713;;; calc-yank.el ends here