X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/08861c5cb87e91e83e5b0bf53cb53c1377434c8f..322b7dab59b98b5d8625d2cd29e48f1ce605f769:/lisp/calc/calc-yank.el diff --git a/lisp/calc/calc-yank.el b/lisp/calc/calc-yank.el index cd13076cd2..2360cf00dd 100644 --- a/lisp/calc/calc-yank.el +++ b/lisp/calc/calc-yank.el @@ -1,17 +1,16 @@ ;;; 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. +;; Copyright (C) 1990-1993, 2001-2011 Free Software Foundation, Inc. ;; Author: David Gillespie ;; Maintainer: Jay Belanger ;; 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 3, 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 @@ -19,9 +18,7 @@ ;; 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 . ;;; Commentary: @@ -48,6 +45,7 @@ (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))) @@ -84,9 +82,15 @@ (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) @@ -127,6 +131,128 @@ 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 @@ -155,11 +281,8 @@ (setq single t) (setq arg (prefix-numeric-value arg)) (if (= arg 0) - (save-excursion - (beginning-of-line) - (setq top (point)) - (end-of-line) - (setq bot (point))) + (setq top (point-at-bol) + bot (point-at-eol)) (save-excursion (setq top (point)) (forward-line arg) @@ -317,14 +440,12 @@ (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)) @@ -362,7 +483,7 @@ (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) @@ -575,7 +696,7 @@ To cancel the edit, simply kill the *Calc Edit* 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) @@ -588,5 +709,4 @@ To cancel the edit, simply kill the *Calc Edit* buffer." ;; generated-autoload-file: "calc-loaddefs.el" ;; End: -;; arch-tag: ca61019e-caca-4daa-b32c-b6afe372d5b5 ;;; calc-yank.el ends here