;;; calc-yank.el --- kill-ring functionality for Calc
;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
(setq num (1- num)))
(setq num (- num n)
n (- n))))
+ (calc-check-stack num)
(let ((stuff (calc-top-list n (- num n -1))))
(calc-cursor-stack-index num)
(let ((first (point)))
(calc-force-refresh)
(calc-set-command-flag 'no-align)
(let* ((top-num (calc-locate-cursor-element top))
+ (top-pos (save-excursion
+ (calc-cursor-stack-index top-num)
+ (point)))
(bot-num (calc-locate-cursor-element (1- bot)))
+ (bot-pos (save-excursion
+ (calc-cursor-stack-index (max 0 (1- bot-num)))
+ (point)))
(num (- top-num bot-num -1)))
- (copy-region-as-kill top bot)
+ (copy-region-as-kill top-pos bot-pos)
(setq calc-last-kill (cons (car kill-ring)
(calc-top-list num bot-num)))
(if (not no-delete)
val))
val))))))))
+;;; The Calc set- and get-register commands are modified versions of functions
+;;; in register.el
+
+(defvar calc-register-alist nil
+ "Alist of elements (NAME . (TEXT . CALCVAL)).
+NAME is a character (a number).
+TEXT and CALCVAL are the TEXT and internal structure of stack entries.")
+
+(defun calc-set-register (register text calcval)
+ "Set the contents of the Calc register REGISTER to (TEXT . CALCVAL),
+as well as set the contents of the Emacs register REGISTER to TEXT."
+ (set-register register text)
+ (let ((aelt (assq register calc-register-alist)))
+ (if aelt
+ (setcdr aelt (cons text calcval))
+ (push (cons register (cons text calcval)) calc-register-alist))))
+
+(defun calc-get-register (reg)
+ "Return the CALCVAL portion of the contents of the Calc register REG,
+unless the TEXT portion doesn't match the contents of the Emacs register REG,
+in which case either return the contents of the Emacs register (if it is
+text) or `nil'."
+ (let ((cval (cdr (assq reg calc-register-alist)))
+ (val (cdr (assq reg register-alist))))
+ (if (stringp val)
+ (if (and (stringp (car cval))
+ (string= (car cval) val))
+ (cdr cval)
+ val))))
+
+(defun calc-copy-to-register (register start end &optional delete-flag)
+ "Copy the lines in the region into register REGISTER.
+With prefix arg, delete as well."
+ (interactive "cCopy to register: \nr\nP")
+ (if (eq major-mode 'calc-mode)
+ (let* ((top-num (calc-locate-cursor-element start))
+ (top-pos (save-excursion
+ (calc-cursor-stack-index top-num)
+ (point)))
+ (bot-num (calc-locate-cursor-element (1- end)))
+ (bot-pos (save-excursion
+ (calc-cursor-stack-index (max 0 (1- bot-num)))
+ (point)))
+ (num (- top-num bot-num -1))
+ (str (buffer-substring top-pos bot-pos)))
+ (calc-set-register register str (calc-top-list num bot-num))
+ (if delete-flag
+ (calc-wrapper
+ (calc-pop-stack num bot-num))))
+ (copy-to-register register start end delete-flag)))
+
+(defun calc-insert-register (register)
+ "Insert the contents of register REGISTER."
+ (interactive "cInsert register: ")
+ (if (eq major-mode 'calc-mode)
+ (let ((val (calc-get-register register)))
+ (calc-wrapper
+ (calc-pop-push-record-list
+ 0 "insr"
+ (if (not val)
+ (error "Bad format in register data")
+ (if (consp val)
+ val
+ (let ((nval (math-read-exprs (calc-clean-newlines val))))
+ (if (eq (car-safe nval) 'error)
+ (progn
+ (setq nval (math-read-exprs val))
+ (if (eq (car-safe nval) 'error)
+ (error "Bad format in register data")
+ nval))
+ nval)))))))
+ (insert-register register)))
+
+(defun calc-add-to-register (register start end prepend delete-flag)
+ "Add the lines in the region to register REGISTER.
+If PREPEND is non-nil, add them to the beginning of the register,
+otherwise the end. If DELETE-FLAG is non-nil, also delete the region."
+ (let* ((top-num (calc-locate-cursor-element start))
+ (top-pos (save-excursion
+ (calc-cursor-stack-index top-num)
+ (point)))
+ (bot-num (calc-locate-cursor-element (1- end)))
+ (bot-pos (save-excursion
+ (calc-cursor-stack-index (max 0 (1- bot-num)))
+ (point)))
+ (num (- top-num bot-num -1))
+ (str (buffer-substring top-pos bot-pos))
+ (calcval (calc-top-list num bot-num))
+ (cval (cdr (assq register calc-register-alist))))
+ (if (not cval)
+ (calc-set-register register str calcval)
+ (if prepend
+ (calc-set-register
+ register
+ (concat str (car cval))
+ (append calcval (cdr cval)))
+ (calc-set-register
+ register
+ (concat (car cval) str)
+ (append (cdr cval) calcval))))
+ (if delete-flag
+ (calc-wrapper
+ (calc-pop-stack num bot-num)))))
+
+(defun calc-append-to-register (register start end &optional delete-flag)
+ "Copy the lines in the region to the end of register REGISTER.
+With prefix arg, also delete the region."
+ (interactive "cAppend to register: \nr\nP")
+ (if (eq major-mode 'calc-mode)
+ (calc-add-to-register register start end nil delete-flag)
+ (append-to-register register start end delete-flag)))
+
+(defun calc-prepend-to-register (register start end &optional delete-flag)
+ "Copy the lines in the region to the beginning of register REGISTER.
+With prefix arg, also delete the region."
+ (interactive "cPrepend to register: \nr\nP")
+ (if (eq major-mode 'calc-mode)
+ (calc-add-to-register register start end t delete-flag)
+ (prepend-to-register register start end delete-flag)))
+
+
+
(defun calc-clean-newlines (s)
(cond
(insert str))
(let ((i 0))
(while (< i (length str))
- (if (= (setq last-command-char (aref str i)) ?\n)
+ (if (= (setq last-command-event (aref str i)) ?\n)
(or (= i (1- (length str)))
(let ((pt (point)))
(end-of-line)
(if calc-edit-disp-trail
(calc-trail-display 1 t))
(and vals
- (let ((calc-simplify-mode (if (eq last-command-char ?\C-j)
+ (let ((calc-simplify-mode (if (eq last-command-event ?\C-j)
'none
calc-simplify-mode)))
(if (>= num 0)