diff lisp/register.el @ 2510:6f72d9a709c3

[xemacs-hg @ 2005-01-26 09:56:05 by ben] Sync to FSF fill.el: Sync for real to FSF 19.34. page.el, register.el: Sync to FSF 21.3.
author ben
date Wed, 26 Jan 2005 09:56:06 +0000
parents 3ecd8885ac67
children cae0c437c95a
line wrap: on
line diff
--- a/lisp/register.el	Wed Jan 26 09:53:32 2005 +0000
+++ b/lisp/register.el	Wed Jan 26 09:56:06 2005 +0000
@@ -1,4 +1,4 @@
-;;; register.el --- register commands for Emacs.
+;;; register.el --- register commands for Emacs
 
 ;; Copyright (C) 1985, 1993, 1994, 1997 Free Software Foundation, Inc.
 
@@ -22,7 +22,7 @@
 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 ;; 02111-1307, USA.
 
-;;; Synched up with: FSF 20.3
+;;; Synched up with: FSF 21.3
 
 ;;; Commentary:
 
@@ -57,8 +57,7 @@
   (let ((aelt (assq register register-alist)))
     (if aelt
 	(setcdr aelt value)
-      (setq aelt (cons register value))
-      (setq register-alist (cons aelt register-alist)))
+      (push (cons register value) register-alist))
     value))
 
 (defun point-to-register (register &optional arg)
@@ -67,6 +66,8 @@
 Use \\[jump-to-register] to go to that location or restore that configuration.
 Argument is a character, naming the register."
   (interactive "cPoint to register: \nP")
+  ;; Turn the marker into a file-ref if the buffer is killed.
+  (add-hook 'kill-buffer-hook 'register-swap-out nil t)
   (set-register register
 		(if arg (list (current-frame-configuration) (point-marker))
 		  (point-marker))))
@@ -125,20 +126,16 @@
      (t
       (error "Register doesn't contain a buffer position or configuration")))))
 
-;; Turn markers into file-query references when a buffer is killed.
 (defun register-swap-out ()
+  "Turn markers into file-query references when a buffer is killed."
   (and buffer-file-name
-       (let ((tail register-alist))
-	 (while tail
-	   (and (markerp (cdr (car tail)))
-		(eq (marker-buffer (cdr (car tail))) (current-buffer))
-		(setcdr (car tail)
-			(list 'file-query
-			      buffer-file-name
-			      (marker-position (cdr (car tail))))))
-	   (setq tail (cdr tail))))))
-
-(add-hook 'kill-buffer-hook 'register-swap-out)
+       (dolist (elem register-alist)
+	 (and (markerp (cdr elem))
+	      (eq (marker-buffer (cdr elem)) (current-buffer))
+	      (setcdr elem
+		      (list 'file-query
+			    buffer-file-name
+			    (marker-position (cdr elem))))))))
 
 (defun number-to-register (number register)
   "Store a number in a register.
@@ -147,7 +144,7 @@
 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 register 
+  (set-register register
 		(if number
 		    (prefix-numeric-value number)
 		  (if (looking-at "\\s-*-?[0-9]+")
@@ -172,54 +169,89 @@
     (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))
+	(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))))))
 
-	 ((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)))))
+(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))
 
-	 ((and (consp val) (window-configuration-p (car val)))
-	  (princ "a window configuration."))
+     ((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) (frame-configuration-p (car val)))
-	  (princ "a frame configuration."))
+     ((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))
-	  (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 "."))
 
-	 ((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)
+      (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))))
 
-	 ((consp val)
-	  (princ "the rectangle:\n")
-	  (while val
-	    (princ (car val))
-	    (terpri)
-	    (setq val (cdr val))))
-
-	 ((stringp val)
-	  (princ "the text:\n")
-	  (princ val))
-
+     ((stringp val)
+      (remove-list-of-text-properties 0 (length val)
+                                      yank-excluded-properties val)
+      (if verbose
+	  (progn
+	    (princ "the text:\n")
+	    (princ val))
+	(cond
+	 ;; Extract first N characters starting with first non-whitespace.
+	 ((string-match (format "[^ \t\n].\\{,%d\\}"
+				;; Deduct 6 for the spaces inserted below.
+				(min 20 (max 0 (- (window-width) 6))))
+			val)
+	  (princ "text starting with\n    ")
+	  (princ (match-string 0 val)))
+	 ((string-match "^[ \t\n]+$" val)
+	  (princ "whitespace"))
 	 (t
-	  (princ "Garbage:\n")
-	  (prin1 val)))))))
+	  (princ "the empty string")))))
+     (t
+      (princ "Garbage:\n")
+      (if verbose (prin1 val))))))
 
 (defun insert-register (register &optional arg)
   "Insert contents of register REGISTER.  (REGISTER is a character.)
@@ -233,7 +265,7 @@
      ((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))