-;;; register.el --- register commands for Emacs.
+;;; register.el --- register commands for Emacs
;; Copyright (C) 1985, 1993, 1994 Free Software Foundation, Inc.
(add-hook 'kill-buffer-hook 'register-swap-out)
-(defun number-to-register (arg char)
+(defun number-to-register (number register)
"Store a number in a register.
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)."
(interactive "P\ncNumber to register: ")
- (set-register char
- (if arg
- (prefix-numeric-value arg)
+ (set-register register
+ (if number
+ (prefix-numeric-value number)
(if (looking-at "\\s-*-?[0-9]+")
(progn
(goto-char (match-end 0))
(string-to-int (match-string 0)))
0))))
-(defun increment-register (arg char)
+(defun increment-register (number register)
"Add NUMBER to the contents of register REGISTER.
-Interactively, NUMBER is the prefix arg (none means nil)."
+Interactively, NUMBER is the prefix arg."
(interactive "p\ncIncrement register: ")
- (or (numberp (get-register char))
+ (or (numberp (get-register register))
(error "Register does not contain a number"))
- (set-register char (+ arg (get-register char))))
+ (set-register register (+ number (get-register register))))
(defun view-register (register)
"Display what is contained in register named REGISTER.
(if (null val)
(message "Register %s is empty" (single-key-description register))
(with-output-to-temp-buffer "*Output*"
- (princ "Register ")
- (princ (single-key-description register))
- (princ " contains ")
- (cond
- ((numberp val)
- (princ val))
-
- ((markerp val)
- (let ((buf (marker-buffer val)))
- (if (null buf)
- (princ "a marker in no buffer")
- (princ "a buffer position:\nbuffer ")
- (princ (buffer-name buf))
- (princ ", position ")
- (princ (marker-position val)))))
-
- ((and (consp val) (window-configuration-p (car val)))
- (princ "a window configuration."))
-
- ((and (consp val) (frame-configuration-p (car val)))
- (princ "a frame configuration."))
-
- ((and (consp val) (eq (car val) 'file))
- (princ "the file ")
- (prin1 (cdr val))
- (princ "."))
-
- ((consp val)
- (princ "the rectangle:\n")
- (while val
- (princ (car val))
- (terpri)
- (setq val (cdr val))))
-
- ((stringp val)
- (princ "the text:\n")
- (princ val))
-
- (t
- (princ "Garbage:\n")
- (prin1 val)))))))
+ (describe-register-1 register t)))))
+
+(defun list-registers ()
+ "Display a list of nonempty registers saying briefly what they contain."
+ (interactive)
+ (let ((list (copy-sequence register-alist)))
+ (setq list (sort list (lambda (a b) (< (car a) (car b)))))
+ (with-output-to-temp-buffer "*Output*"
+ (dolist (elt list)
+ (when (get-register (car elt))
+ (describe-register-1 (car elt))
+ (terpri))))))
+
+(defun describe-register-1 (register &optional verbose)
+ (princ "Register ")
+ (princ (single-key-description register))
+ (princ " contains ")
+ (let ((val (get-register register)))
+ (cond
+ ((numberp val)
+ (princ val))
+
+ ((markerp val)
+ (let ((buf (marker-buffer val)))
+ (if (null buf)
+ (princ "a marker in no buffer")
+ (princ "a buffer position:\n buffer ")
+ (princ (buffer-name buf))
+ (princ ", position ")
+ (princ (marker-position val)))))
+
+ ((and (consp val) (window-configuration-p (car val)))
+ (princ "a window configuration."))
+
+ ((and (consp val) (frame-configuration-p (car val)))
+ (princ "a frame configuration."))
+
+ ((and (consp val) (eq (car val) 'file))
+ (princ "the file ")
+ (prin1 (cdr val))
+ (princ "."))
+
+ ((and (consp val) (eq (car val) 'file-query))
+ (princ "a file-query reference:\n file ")
+ (prin1 (car (cdr val)))
+ (princ ",\n position ")
+ (princ (car (cdr (cdr val))))
+ (princ "."))
+
+ ((consp val)
+ (if verbose
+ (progn
+ (princ "the rectangle:\n")
+ (while val
+ (princ " ")
+ (princ (car val))
+ (terpri)
+ (setq val (cdr val))))
+ (princ "a rectangle starting with ")
+ (princ (car val))))
+
+ ((stringp val)
+ (setq val
+ (remove-list-of-text-properties 0 (length val)
+ yank-excluded-properties val))
+ (if verbose
+ (progn
+ (princ "the text:\n")
+ (princ val))
+ (princ "text starting with\n ")
+ (string-match "[^ \t\n].\\{,20\\}" val)
+ (princ (match-string 0 val))))
+ (t
+ (princ "Garbage:\n")
+ (if verbose (prin1 val))))))
(defun insert-register (register &optional arg)
"Insert contents of register REGISTER. (REGISTER is a character.)
((consp val)
(insert-rectangle val))
((stringp val)
- (insert val))
+ (insert-for-yank val))
((numberp val)
(princ val (current-buffer)))
((and (markerp val) (marker-position val))