diff options
Diffstat (limited to 'lisp/register.el')
| -rw-r--r-- | lisp/register.el | 55 |
1 files changed, 27 insertions, 28 deletions
diff --git a/lisp/register.el b/lisp/register.el index 44f15e4a69..2816c9831d 100644 --- a/lisp/register.el +++ b/lisp/register.el @@ -28,31 +28,15 @@ ;; pieces of buffer state to named variables. The entry points are ;; documented in the Emacs user's manual. -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (declare-function semantic-insert-foreign-tag "semantic/tag" (foreign-tag)) (declare-function semantic-tag-buffer "semantic/tag" (tag)) (declare-function semantic-tag-start "semantic/tag" (tag)) -;;; Global key bindings - -(define-key ctl-x-r-map "\C-@" 'point-to-register) -(define-key ctl-x-r-map [?\C-\ ] 'point-to-register) -(define-key ctl-x-r-map " " 'point-to-register) -(define-key ctl-x-r-map "j" 'jump-to-register) -(define-key ctl-x-r-map "s" 'copy-to-register) -(define-key ctl-x-r-map "x" 'copy-to-register) -(define-key ctl-x-r-map "i" 'insert-register) -(define-key ctl-x-r-map "g" 'insert-register) -(define-key ctl-x-r-map "r" 'copy-rectangle-to-register) -(define-key ctl-x-r-map "n" 'number-to-register) -(define-key ctl-x-r-map "+" 'increment-register) -(define-key ctl-x-r-map "w" 'window-configuration-to-register) -(define-key ctl-x-r-map "f" 'frame-configuration-to-register) - ;;; Code: -(defstruct +(cl-defstruct (registerv (:constructor nil) (:constructor registerv--make (&optional data print-func jump-func insert-func)) @@ -64,7 +48,7 @@ (jump-func nil :read-only t) (insert-func nil :read-only t)) -(defun* registerv-make (data &key print-func jump-func insert-func) +(cl-defun registerv-make (data &key print-func jump-func insert-func) "Create a register value object. DATA can be any value. @@ -150,7 +134,7 @@ delete any existing frames that the frame configuration doesn't mention. (let ((val (get-register register))) (cond ((registerv-p val) - (assert (registerv-jump-func val) nil + (cl-assert (registerv-jump-func val) nil "Don't know how to jump to register %s" (single-key-description register)) (funcall (registerv-jump-func val) (registerv-data val))) @@ -325,7 +309,7 @@ Interactively, second arg is non-nil if prefix arg is supplied." (let ((val (get-register register))) (cond ((registerv-p val) - (assert (registerv-insert-func val) nil + (cl-assert (registerv-insert-func val) nil "Don't know how to insert register %s" (single-key-description register)) (funcall (registerv-insert-func val) (registerv-data val))) @@ -352,7 +336,11 @@ 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 (filter-buffer-substring start end)) - (if delete-flag (delete-region start end))) + (setq deactivate-mark t) + (cond (delete-flag + (delete-region start end)) + ((called-interactively-p 'interactive) + (indicate-copied-region)))) (defun append-to-register (register start end &optional delete-flag) "Append region to text in register REGISTER. @@ -366,7 +354,10 @@ START and END are buffer positions indicating what to append." register (cond ((not reg) text) ((stringp reg) (concat reg text)) (t (error "Register does not contain text"))))) - (if delete-flag (delete-region start end))) + (cond (delete-flag + (delete-region start end)) + ((called-interactively-p 'interactive) + (indicate-copied-region)))) (defun prepend-to-register (register start end &optional delete-flag) "Prepend region to text in register REGISTER. @@ -380,7 +371,10 @@ START and END are buffer positions indicating what to prepend." register (cond ((not reg) text) ((stringp reg) (concat text reg)) (t (error "Register does not contain text"))))) - (if delete-flag (delete-region start end))) + (cond (delete-flag + (delete-region start end)) + ((called-interactively-p 'interactive) + (indicate-copied-region)))) (defun copy-rectangle-to-register (register start end &optional delete-flag) "Copy rectangular region into register REGISTER. @@ -390,10 +384,15 @@ To insert this register in the buffer, use \\[insert-register]. Called from a program, takes four args: REGISTER, START, END and DELETE-FLAG. START and END are buffer positions giving two corners of rectangle." (interactive "cCopy rectangle to register: \nr\nP") - (set-register register - (if delete-flag - (delete-extract-rectangle start end) - (extract-rectangle start end)))) + (let ((rectangle (if delete-flag + (delete-extract-rectangle start end) + (extract-rectangle start end)))) + (set-register register rectangle) + (when (and (null delete-flag) + (called-interactively-p 'interactive)) + (setq deactivate-mark t) + (indicate-copied-region (length (car rectangle)))))) + (provide 'register) ;;; register.el ends here |