X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/68e7476278a3dc4bd13dab63cc23bc0e671e5525..c1473b4cfeb477ced05d457868c5e1eb97a58eb0:/lisp/calc/calc-yank.el diff --git a/lisp/calc/calc-yank.el b/lisp/calc/calc-yank.el index 41a8d4157c..65bec46db8 100644 --- a/lisp/calc/calc-yank.el +++ b/lisp/calc/calc-yank.el @@ -8,10 +8,10 @@ ;; 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 +19,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 +46,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 +83,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) @@ -103,9 +108,10 @@ (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 @@ -126,6 +132,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 @@ -373,8 +501,8 @@ (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.*\\)" @@ -417,13 +545,13 @@ (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) @@ -583,5 +711,9 @@ To cancel the edit, simply kill the *Calc Edit* buffer." (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