X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/7c3247627a102b53e9808ef51eca4a22c3a39fa3..ad5572b:/lisp/register.el diff --git a/lisp/register.el b/lisp/register.el index cca0993061..045a4308fd 100644 --- a/lisp/register.el +++ b/lisp/register.el @@ -1,9 +1,9 @@ ;;; register.el --- register commands for Emacs -*- lexical-binding: t; -*- -;; Copyright (C) 1985, 1993-1994, 2001-2014 Free Software Foundation, +;; Copyright (C) 1985, 1993-1994, 2001-2016 Free Software Foundation, ;; Inc. -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: internal ;; Package: emacs @@ -27,12 +27,14 @@ ;; This package of functions emulates and somewhat extends the venerable ;; TECO's `register' feature, which permits you to save various useful ;; pieces of buffer state to named variables. The entry points are -;; documented in the Emacs user's manual. +;; documented in the Emacs user's manual: (info "(emacs) Registers"). (eval-when-compile (require 'cl-lib)) ;;; Code: +;; FIXME: Clean up namespace usage! + (cl-defstruct (registerv (:constructor nil) (:constructor registerv--make (&optional data print-func @@ -81,10 +83,9 @@ A list of the form (FRAME-CONFIGURATION POSITION) (defcustom register-separator nil "Register containing the text to put between collected texts, or nil if none. -When collecting text with -`append-to-register' (resp. `prepend-to-register') contents of -this register is added to the beginning (resp. end) of the marked -text." +When collecting text with \\[append-to-register] (or \\[prepend-to-register]), +contents of this register is added to the beginning (or end, respectively) +of the marked text." :group 'register :type '(choice (const :tag "None" nil) (character :tag "Use register" :value ?+))) @@ -99,16 +100,12 @@ If nil, do not show register previews, unless `help-char' (or a member of (defun get-register (register) "Return contents of Emacs register named REGISTER, or nil if none." - (cdr (assq register register-alist))) + (alist-get register register-alist)) (defun set-register (register value) "Set contents of Emacs register named REGISTER to VALUE. Returns VALUE. See the documentation of the variable `register-alist' for possible VALUEs." - (let ((aelt (assq register register-alist))) - (if aelt - (setcdr aelt value) - (push (cons register value) register-alist)) - value)) + (setf (alist-get register register-alist) value)) (defun register-describe-oneline (c) "One-line description of register C." @@ -121,8 +118,8 @@ See the documentation of the variable `register-alist' for possible VALUEs." (defun register-preview-default (r) "Default function for the variable `register-preview-function'." - (format "%s %s\n" - (concat (single-key-description (car r)) ":") + (format "%s: %s\n" + (single-key-description (car r)) (register-describe-oneline (car r)))) (defvar register-preview-function #'register-preview-default @@ -135,21 +132,23 @@ Returns a string.") If SHOW-EMPTY is non-nil show the window even if no registers. Format of each entry is controlled by the variable `register-preview-function'." (when (or show-empty (consp register-alist)) - (with-temp-buffer-window + (with-current-buffer-window buffer (cons 'display-buffer-below-selected - '((window-height . fit-window-to-buffer))) + '((window-height . fit-window-to-buffer) + (preserve-size . (nil . t)))) nil (with-current-buffer standard-output (setq cursor-in-non-selected-windows nil) (insert (mapconcat register-preview-function register-alist "")))))) (defun register-read-with-preview (prompt) - "Read and return an event, prompting with PROMPT, possibly showing a preview. -If `register-alist' and `register-preview-delay' are both non-nil, -display a window listing registers after `register-preview-delay' seconds. -If `help-char' (or a member of `help-event-list') is pressed, display -such a window regardless." + "Read and return a register name, possibly showing existing registers. +Prompt with the string PROMPT. If `register-alist' and +`register-preview-delay' are both non-nil, display a window +listing existing registers after `register-preview-delay' seconds. +If `help-char' (or a member of `help-event-list') is pressed, +display such a window regardless." (let* ((buffer "*Register Preview*") (timer (when (numberp register-preview-delay) (run-with-timer register-preview-delay nil @@ -161,7 +160,7 @@ such a window regardless." collect c))) (unwind-protect (progn - (while (memq (read-event (propertize prompt 'face 'minibuffer-prompt)) + (while (memq (read-key (propertize prompt 'face 'minibuffer-prompt)) help-chars) (unless (get-buffer-window buffer) (register-preview buffer 'show-empty))) @@ -176,7 +175,9 @@ such a window regardless." "Store current location of point in register REGISTER. With prefix argument, store current frame configuration. Use \\[jump-to-register] to go to that location or restore that configuration. -Argument is a character, naming the register." +Argument is a character, naming the register. + +Interactively, reads the register using `register-read-with-preview'." (interactive (list (register-read-with-preview "Point to register: ") current-prefix-arg)) ;; Turn the marker into a file-ref if the buffer is killed. @@ -188,7 +189,9 @@ Argument is a character, naming the register." (defun window-configuration-to-register (register &optional _arg) "Store the window configuration of the selected frame in register REGISTER. Use \\[jump-to-register] to restore the configuration. -Argument is a character, naming the register." +Argument is a character, naming the register. + +Interactively, reads the register using `register-read-with-preview'." (interactive (list (register-read-with-preview "Window configuration to register: ") current-prefix-arg)) @@ -196,10 +199,16 @@ Argument is a character, naming the register." ;; of point in the current buffer, so record that separately. (set-register register (list (current-window-configuration) (point-marker)))) +;; It has had the optional arg for ages, but never used it. +(set-advertised-calling-convention 'window-configuration-to-register + '(register) "24.4") + (defun frame-configuration-to-register (register &optional _arg) "Store the window configuration of all frames in register REGISTER. Use \\[jump-to-register] to restore the configuration. -Argument is a character, naming the register." +Argument is a character, naming the register. + +Interactively, reads the register using `register-read-with-preview'." (interactive (list (register-read-with-preview "Frame configuration to register: ") current-prefix-arg)) @@ -207,6 +216,12 @@ Argument is a character, naming the register." ;; of point in the current buffer, so record that separately. (set-register register (list (current-frame-configuration) (point-marker)))) +;; It has had the optional arg for ages, but never used it. +(set-advertised-calling-convention 'frame-configuration-to-register + '(register) "24.4") + +(make-obsolete 'frame-configuration-to-register 'frameset-to-register "24.4") + (defalias 'register-to-point 'jump-to-register) (defun jump-to-register (register &optional delete) "Move point to location stored in a register. @@ -217,7 +232,9 @@ If the register contains a window configuration (one frame) or a frameset First argument is a character, naming the register. Optional second arg non-nil (interactively, prefix argument) says to delete any existing frames that the frameset doesn't mention. -\(Otherwise, these frames are iconified.)" +\(Otherwise, these frames are iconified.) + +Interactively, reads the register using `register-read-with-preview'." (interactive (list (register-read-with-preview "Jump to register: ") current-prefix-arg)) (let ((val (get-register register))) @@ -235,19 +252,22 @@ delete any existing frames that the frameset doesn't mention. (goto-char (cadr val))) ((markerp val) (or (marker-buffer val) - (error "That register's buffer no longer exists")) + (user-error "That register's buffer no longer exists")) (switch-to-buffer (marker-buffer val)) + (unless (or (= (point) (marker-position val)) + (eq last-command 'jump-to-register)) + (push-mark)) (goto-char val)) ((and (consp val) (eq (car val) 'file)) (find-file (cdr val))) ((and (consp val) (eq (car val) 'file-query)) (or (find-buffer-visiting (nth 1 val)) (y-or-n-p (format "Visit file %s again? " (nth 1 val))) - (error "Register access aborted")) + (user-error "Register access aborted")) (find-file (nth 1 val)) (goto-char (nth 2 val))) (t - (error "Register doesn't contain a buffer position or configuration"))))) + (user-error "Register doesn't contain a buffer position or configuration"))))) (defun register-swap-out () "Turn markers into file-query references when a buffer is killed." @@ -265,7 +285,9 @@ delete any existing frames that the frameset doesn't mention. Two args, NUMBER and REGISTER (a character, naming the register). If NUMBER is nil, a decimal number is read from the buffer starting at point, and point moves to the end of that number. -Interactively, NUMBER is the prefix arg (none means nil)." +Interactively, NUMBER is the prefix arg (none means nil). + +Interactively, reads the register using `register-read-with-preview'." (interactive (list current-prefix-arg (register-read-with-preview "Number to register: "))) (set-register register @@ -285,8 +307,11 @@ If REGISTER contains a number, add `prefix-numeric-value' of PREFIX to it. If REGISTER is empty or if it contains text, call -`append-to-register' with `delete-flag' set to PREFIX." - (interactive "P\ncIncrement register: ") +`append-to-register' with `delete-flag' set to PREFIX. + +Interactively, reads the register using `register-read-with-preview'." + (interactive (list current-prefix-arg + (register-read-with-preview "Increment register: "))) (let ((register-val (get-register register))) (cond ((numberp register-val) @@ -294,11 +319,13 @@ If REGISTER is empty or if it contains text, call (set-register register (+ number register-val)))) ((or (not register-val) (stringp register-val)) (append-to-register register (region-beginning) (region-end) prefix)) - (t (error "Register does not contain a number or text"))))) + (t (user-error "Register does not contain a number or text"))))) (defun view-register (register) "Display what is contained in register named REGISTER. -The Lisp value REGISTER is a character." +The Lisp value REGISTER is a character. + +Interactively, reads the register using `register-read-with-preview'." (interactive (list (register-read-with-preview "View register: "))) (let ((val (get-register register))) (if (null val) @@ -400,11 +427,14 @@ The Lisp value REGISTER is a character." "Insert contents of register REGISTER. (REGISTER is a character.) Normally puts point before and mark after the inserted text. If optional second arg is non-nil, puts mark before and point after. -Interactively, second arg is non-nil if prefix arg is supplied." +Interactively, second arg is nil if prefix arg is supplied and t +otherwise. + +Interactively, reads the register using `register-read-with-preview'." (interactive (progn (barf-if-buffer-read-only) (list (register-read-with-preview "Insert register: ") - current-prefix-arg))) + (not current-prefix-arg)))) (push-mark) (let ((val (get-register register))) (cond @@ -422,16 +452,18 @@ Interactively, second arg is non-nil if prefix arg is supplied." ((and (markerp val) (marker-position val)) (princ (marker-position val) (current-buffer))) (t - (error "Register does not contain text")))) + (user-error "Register does not contain text")))) (if (not arg) (exchange-point-and-mark))) (defun copy-to-register (register start end &optional delete-flag region) "Copy region into register REGISTER. 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 copy. -The optional argument REGION if non-nil, indicates that we're not just copying -some text between START and END, but we're copying the region." +Called from program, takes five args: REGISTER, START, END, DELETE-FLAG, +and REGION. START and END are buffer positions indicating what to copy. +The optional argument REGION if non-nil, indicates that we're not just +copying some text between START and END, but we're copying the region. + +Interactively, reads the register using `register-read-with-preview'." (interactive (list (register-read-with-preview "Copy to register: ") (region-beginning) (region-end) @@ -450,7 +482,9 @@ some text between START and END, but we're copying the region." "Append region to text in register REGISTER. 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." +START and END are buffer positions indicating what to append. + +Interactively, reads the register using `register-read-with-preview'." (interactive (list (register-read-with-preview "Append to register: ") (region-beginning) (region-end) @@ -461,7 +495,7 @@ START and END are buffer positions indicating what to append." (set-register register (cond ((not reg) text) ((stringp reg) (concat reg separator text)) - (t (error "Register does not contain text"))))) + (t (user-error "Register does not contain text"))))) (setq deactivate-mark t) (cond (delete-flag (delete-region start end)) @@ -472,7 +506,9 @@ START and END are buffer positions indicating what to append." "Prepend region to text in register REGISTER. 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." +START and END are buffer positions indicating what to prepend. + +Interactively, reads the register using `register-read-with-preview'." (interactive (list (register-read-with-preview "Prepend to register: ") (region-beginning) (region-end) @@ -483,7 +519,7 @@ START and END are buffer positions indicating what to prepend." (set-register register (cond ((not reg) text) ((stringp reg) (concat text separator reg)) - (t (error "Register does not contain text"))))) + (t (user-error "Register does not contain text"))))) (setq deactivate-mark t) (cond (delete-flag (delete-region start end)) @@ -496,7 +532,9 @@ With prefix arg, delete as well. 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." +START and END are buffer positions giving two corners of rectangle. + +Interactively, reads the register using `register-read-with-preview'." (interactive (list (register-read-with-preview "Copy rectangle to register: ") (region-beginning)