Commit 92840a31 authored by Richard M. Stallman's avatar Richard M. Stallman

(list-registers): New command.

(describe-register-1): New subroutine, taken out of view-register.
parent 3be4340f
...@@ -168,6 +168,20 @@ The Lisp value REGISTER is a character." ...@@ -168,6 +168,20 @@ The Lisp value REGISTER is a character."
(if (null val) (if (null val)
(message "Register %s is empty" (single-key-description register)) (message "Register %s is empty" (single-key-description register))
(with-output-to-temp-buffer "*Output*" (with-output-to-temp-buffer "*Output*"
(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 "Register ")
(princ (single-key-description register)) (princ (single-key-description register))
(princ " contains ") (princ " contains ")
...@@ -179,7 +193,7 @@ The Lisp value REGISTER is a character." ...@@ -179,7 +193,7 @@ The Lisp value REGISTER is a character."
(let ((buf (marker-buffer val))) (let ((buf (marker-buffer val)))
(if (null buf) (if (null buf)
(princ "a marker in no buffer") (princ "a marker in no buffer")
(princ "a buffer position:\nbuffer ") (princ "a buffer position:\n buffer ")
(princ (buffer-name buf)) (princ (buffer-name buf))
(princ ", position ") (princ ", position ")
(princ (marker-position val))))) (princ (marker-position val)))))
...@@ -196,26 +210,35 @@ The Lisp value REGISTER is a character." ...@@ -196,26 +210,35 @@ The Lisp value REGISTER is a character."
(princ ".")) (princ "."))
((and (consp val) (eq (car val) 'file-query)) ((and (consp val) (eq (car val) 'file-query))
(princ "a file-query reference:\nfile ") (princ "a file-query reference:\n file ")
(prin1 (car (cdr val))) (prin1 (car (cdr val)))
(princ ",\nposition ") (princ ",\n position ")
(princ (car (cdr (cdr val)))) (princ (car (cdr (cdr val))))
(princ ".")) (princ "."))
((consp val) ((consp val)
(if verbose
(progn
(princ "the rectangle:\n") (princ "the rectangle:\n")
(while val (while val
(princ " ")
(princ (car val)) (princ (car val))
(terpri) (terpri)
(setq val (cdr val)))) (setq val (cdr val))))
(princ "a rectangle starting with ")
(princ (car val))))
((stringp val) ((stringp val)
(if verbose
(progn
(princ "the text:\n") (princ "the text:\n")
(princ val)) (princ val))
(princ "text starting with\n ")
(string-match "[^ \t\n].\\{,20\\}" val)
(princ (match-string 0 val))))
(t (t
(princ "Garbage:\n") (princ "Garbage:\n")
(prin1 val))))))) (if verbose (prin1 val)))))
(defun insert-register (register &optional arg) (defun insert-register (register &optional arg)
"Insert contents of register REGISTER. (REGISTER is a character.) "Insert contents of register REGISTER. (REGISTER is a character.)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment