]> code.delx.au - gnu-emacs/blobdiff - lisp/register.el
(report_file_error): String pointer args now point to
[gnu-emacs] / lisp / register.el
index eb0aa8107c2dc7b2b38031c3f103034f0d61097a..98adce7ae86fdcb7e96cf288fda69da67c4e4bfb 100644 (file)
@@ -1,4 +1,4 @@
-;;; register.el --- register commands for Emacs.
+;;; register.el --- register commands for Emacs
 
 ;; Copyright (C) 1985, 1993, 1994 Free Software Foundation, Inc.
 
@@ -136,29 +136,29 @@ delete any existing frames that the frame configuration doesn't mention.
 
 (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 cha
-               (if arg
-                   (prefix-numeric-value arg)
+  (set-register registe
+               (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.
@@ -168,47 +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 "."))
-
-        ((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.)
@@ -222,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))