X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/5ef5d6ce31fe96ea47ce8f29cb12b36f16b657d3..b0c7121cabe1cc5f4df12c3acd4354d4a5c5f042:/lisp/register.el diff --git a/lisp/register.el b/lisp/register.el index 0ba6a9addd..6a8156e329 100644 --- a/lisp/register.el +++ b/lisp/register.el @@ -1,16 +1,17 @@ ;;; register.el --- register commands for Emacs -;; Copyright (C) 1985, 1993, 1994 Free Software Foundation, Inc. +;; Copyright (C) 1985, 1993, 1994, 2001, 2002, 2003, 2004, +;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: internal ;; 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 @@ -18,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., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -29,6 +28,22 @@ ;; pieces of buffer state to named variables. The entry points are ;; documented in the Emacs user's manual. +;;; Global key bindings + +;;;###autoload (define-key ctl-x-r-map "\C-@" 'point-to-register) +;;;###autoload (define-key ctl-x-r-map [?\C-\ ] 'point-to-register) +;;;###autoload (define-key ctl-x-r-map " " 'point-to-register) +;;;###autoload (define-key ctl-x-r-map "j" 'jump-to-register) +;;;###autoload (define-key ctl-x-r-map "s" 'copy-to-register) +;;;###autoload (define-key ctl-x-r-map "x" 'copy-to-register) +;;;###autoload (define-key ctl-x-r-map "i" 'insert-register) +;;;###autoload (define-key ctl-x-r-map "g" 'insert-register) +;;;###autoload (define-key ctl-x-r-map "r" 'copy-rectangle-to-register) +;;;###autoload (define-key ctl-x-r-map "n" 'number-to-register) +;;;###autoload (define-key ctl-x-r-map "+" 'increment-register) +;;;###autoload (define-key ctl-x-r-map "w" 'window-configuration-to-register) +;;;###autoload (define-key ctl-x-r-map "f" 'frame-configuration-to-register) + ;;; Code: (defvar register-alist nil @@ -227,8 +242,10 @@ The Lisp value REGISTER is a character." (princ (car val)))) ((stringp val) - (remove-list-of-text-properties 0 (length val) - yank-excluded-properties val) + (if (eq yank-excluded-properties t) + (set-text-properties 0 (length val) nil val) + (remove-list-of-text-properties 0 (length val) + yank-excluded-properties val)) (if verbose (progn (princ "the text:\n") @@ -275,7 +292,7 @@ Interactively, second arg is non-nil if prefix arg is supplied." Called from program, takes four args: REGISTER, START, END and DELETE-FLAG. START and END are buffer positions indicating what to copy." (interactive "cCopy to register: \nr\nP") - (set-register register (buffer-substring start end)) + (set-register register (filter-buffer-substring start end)) (if delete-flag (delete-region start end))) (defun append-to-register (register start end &optional delete-flag) @@ -284,10 +301,12 @@ With prefix arg, delete as well. Called from program, takes four args: REGISTER, START, END and DELETE-FLAG. START and END are buffer positions indicating what to append." (interactive "cAppend to register: \nr\nP") - (or (stringp (get-register register)) - (error "Register does not contain text")) - (set-register register (concat (get-register register) - (buffer-substring start end))) + (let ((reg (get-register register)) + (text (filter-buffer-substring start end))) + (set-register + register (cond ((not reg) text) + ((stringp reg) (concat reg text)) + (t (error "Register does not contain text"))))) (if delete-flag (delete-region start end))) (defun prepend-to-register (register start end &optional delete-flag) @@ -296,10 +315,12 @@ With prefix arg, delete as well. Called from program, takes four args: REGISTER, START, END and DELETE-FLAG. START and END are buffer positions indicating what to prepend." (interactive "cPrepend to register: \nr\nP") - (or (stringp (get-register register)) - (error "Register does not contain text")) - (set-register register (concat (buffer-substring start end) - (get-register register))) + (let ((reg (get-register register)) + (text (filter-buffer-substring start end))) + (set-register + register (cond ((not reg) text) + ((stringp reg) (concat text reg)) + (t (error "Register does not contain text"))))) (if delete-flag (delete-region start end))) (defun copy-rectangle-to-register (register start end &optional delete-flag) @@ -315,5 +336,6 @@ START and END are buffer positions giving two corners of rectangle." (delete-extract-rectangle start end) (extract-rectangle start end)))) -;;; arch-tag: ce14dd68-8265-475f-9341-5d4ec5a53035 +(provide 'register) +;; arch-tag: ce14dd68-8265-475f-9341-5d4ec5a53035 ;;; register.el ends here