From 92840a31c80bc888c161f53524e79d567a29334d Mon Sep 17 00:00:00 2001
From: "Richard M. Stallman" <rms@gnu.org>
Date: Thu, 7 Feb 2002 17:40:44 +0000
Subject: [PATCH] (list-registers): New command. (describe-register-1): New
 subroutine, taken out of view-register.

---
 lisp/register.el | 103 +++++++++++++++++++++++++++++------------------
 1 file changed, 63 insertions(+), 40 deletions(-)

diff --git a/lisp/register.el b/lisp/register.el
index e609e8bfb73..e9322c5c914 100644
--- a/lisp/register.el
+++ b/lisp/register.el
@@ -168,54 +168,77 @@ The Lisp value REGISTER is a character."
     (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 "."))
-
-	 ((and (consp val) (eq (car val) 'file-query))
-	  (princ "a file-query reference:\nfile ")
-	  (prin1 (car (cdr val)))
-	  (princ ",\nposition ")
-	  (princ (car (cdr (cdr val))))
-	  (princ "."))
-
-	 ((consp 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 ")
+  (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)
+   ((stringp val)
+    (if verbose
+	(progn
 	  (princ "the text:\n")
 	  (princ val))
-
-	 (t
-	  (princ "Garbage:\n")
-	  (prin1 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.)
-- 
2.39.5