(report_file_error): String pointer args now point to

[gnu-emacs] / lisp / register.el

diff --git a/lisp/register.el b/lisp/register.el
index e609e8bfb73f6ef24b5d49e4a6f9fe9786916310..98adce7ae86fdcb7e96cf288fda69da67c4e4bfb 100644 (file)
--- a/lisp/register.el
+++ b/lisp/register.el
@@ -168,54 +168,81 @@ 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)
-         (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.)
@@ -229,7 +256,7 @@ Interactively, second arg is non-nil if prefix arg is supplied."
      ((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))