;;; calc-yank.el --- kill-ring functionality for Calc
;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007 Free Software Foundation, Inc.
+;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
(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)
(interactive "r")
(calc-kill-region top bot t))
-;;; This function uses calc-last-kill if possible to get an exact result,
-;;; otherwise it just parses the yanked string.
-;;; Modified to use Emacs 19 extended concept of kill-ring. -- daveg 12/15/96
+;; This function uses calc-last-kill if possible to get an exact result,
+;; otherwise it just parses the yanked string.
+;; Modified to use Emacs 19 extended concept of kill-ring. -- daveg 12/15/96
+;;;###autoload
(defun calc-yank ()
(interactive)
(calc-wrapper
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
(setq top (point))
(calc-cursor-stack-index 0)
(setq bot (point))))
- (save-excursion
- (set-buffer newbuf)
+ (with-current-buffer newbuf
(if (consp nn)
(kill-region (region-beginning) (region-end)))
(push-mark (point) t)
(if (and overwrite-mode (not (consp nn)))
- (calc-overwrite-string (save-excursion
- (set-buffer oldbuf)
+ (calc-overwrite-string (with-current-buffer oldbuf
(buffer-substring top bot))
eat-lnums)
(or (bolp) (setq eat-lnums nil))
(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)
(self-insert-command 1))
(setq i (1+ i))))))
-;;; First, require that buffer is visible and does not begin with "*"
-;;; Second, require only that it not begin with "*Calc"
+;; First, require that buffer is visible and does not begin with "*"
+;; Second, require only that it not begin with "*Calc"
(defun calc-find-writable-buffer (buf mode)
(and buf
(if (or (string-match "\\`\\( .*\\|\\*Calc.*\\)"
(backward-char 1)
(calc-set-command-flag 'do-edit))
-(defvar calc-edit-mode-map nil "Keymap for use by the calc-edit command.")
-(if calc-edit-mode-map
- ()
- (setq calc-edit-mode-map (make-sparse-keymap))
- (define-key calc-edit-mode-map "\n" 'calc-edit-finish)
- (define-key calc-edit-mode-map "\r" 'calc-edit-return)
- (define-key calc-edit-mode-map "\C-c\C-c" 'calc-edit-finish))
+(defvar calc-edit-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "\n" 'calc-edit-finish)
+ (define-key map "\r" 'calc-edit-return)
+ (define-key map "\C-c\C-c" 'calc-edit-finish)
+ map)
+ "Keymap for use by the calc-edit command.")
(defvar calc-original-buffer)
(defvar calc-return-buffer)
(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)
(provide 'calc-yank)
-;;; arch-tag: ca61019e-caca-4daa-b32c-b6afe372d5b5
+;; Local variables:
+;; generated-autoload-file: "calc-loaddefs.el"
+;; End:
+
+;; arch-tag: ca61019e-caca-4daa-b32c-b6afe372d5b5
;;; calc-yank.el ends here
HCoop / bpt / emacs.git / blobdiff