diff lisp/prim/register.el @ 195:a2f645c6b9f8 r20-3b24

Import from CVS: tag r20-3b24
author cvs
date Mon, 13 Aug 2007 09:59:05 +0200
parents b9518feda344
children
line wrap: on
line diff
--- a/lisp/prim/register.el	Mon Aug 13 09:58:32 2007 +0200
+++ b/lisp/prim/register.el	Mon Aug 13 09:59:05 2007 +0200
@@ -1,4 +1,4 @@
-;;; register.el --- register commands for XEmacs.
+;;; register.el --- register commands for Emacs.
 
 ;; Copyright (C) 1985, 1993, 1994 Free Software Foundation, Inc.
 
@@ -7,29 +7,29 @@
 
 ;; This file is part of XEmacs.
 
-;; XEmacs is free software; you can redistribute it and/or modify it
-;; under the terms of the GNU General Public License as published by
+;; XEmacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
 ;; the Free Software Foundation; either version 2, or (at your option)
 ;; any later version.
 
-;; XEmacs is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;; General Public License for more details.
+;; XEmacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
+;; along with XEmacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
 
-;;; Synched up with: FSF 19.34.
+;;; Synched up with: FSF 20.1
 
 ;;; Commentary:
 
 ;; This package of functions emulates and somewhat extends the venerable
 ;; TECO's `register' feature, which permits you to save various useful
 ;; pieces of buffer state to named variables.  The entry points are
-;; documented in the XEmacs Reference Manual.
+;; documented in the Emacs user's manual.
 
 ;;; Code:
 
@@ -38,7 +38,9 @@
 NAME is a character (a number).  CONTENTS is a string, number,
 frame configuration, mark or list.
 A list of strings represents a rectangle.
-A list of the form (file . NAME) represents the file named NAME.")
+A list of the form (file . NAME) represents the file named NAME.
+A list of the form (file-query NAME POSITION) represents position POSITION
+ in the file named NAME, but query before visiting it.")
 
 (defun get-register (reg)
   "Return contents of Emacs register named REG, or nil if none."
@@ -46,7 +48,7 @@
 
 (defun set-register (register value)
   "Set contents of Emacs register named REGISTER to VALUE.  Returns VALUE.
-See the documentation of the variable `register-alist' for possible VALUEs."
+See the documentation of the variable `register-alist' for possible VALUE."
   (let ((aelt (assq register register-alist)))
     (if aelt
 	(setcdr aelt value)
@@ -103,9 +105,30 @@
       (goto-char val))
      ((and (consp val) (eq (car val) 'file))
       (find-file (cdr val)))
+     ((and (consp val) (eq (car val) 'file-query))
+      (or (find-buffer-visiting (nth 1 val))
+	  (y-or-n-p (format "Visit file %s again? " (nth 1 val)))
+	  (error "Register access aborted"))
+      (find-file (nth 1 val))
+      (goto-char (nth 2 val)))
      (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 ()
+  (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)
+
 ;(defun number-to-register (arg char)
 ;  "Store a number in a register.
 ;Two args, NUMBER and REGISTER (a character, naming the register).
@@ -142,9 +165,10 @@
     (if (null val)
 	(message "Register %s is empty" (single-key-description register))
       (with-output-to-temp-buffer "*Output*"
-	(princ (format "Register %s contains "
-		       (single-key-description register)))
-	(cond 
+	(princ "Register ")
+	(princ (single-key-description register))
+	(princ " contains ")
+	(cond
 	 ((integerp val)
 	  (princ val))
 
@@ -152,17 +176,16 @@
 	  (let ((buf (marker-buffer val)))
 	    (if (null buf)
 		(princ "a marker in no buffer")
-	      (princ (format
-		      "a buffer position:\nbuff %s, position %s"
-		      (buffer-name (marker-buffer val))
-		      (marker-position val))))))
+	      (princ "a buffer position:\nbuffer ")
+	      (princ (buffer-name buf))
+	      (princ ", position ")
+	      (princ (marker-position val)))))
 
 	 ((window-configuration-p val)
 	  (princ "a window configuration."))
 
-
-;;       ((frame-configuration-p val)
-;;        (princ "a frame configuration."))
+	 ((frame-configuration-p val)
+	  (princ "a frame configuration."))
 
 	 ((and (consp val) (eq (car val) 'file))
 	  (princ "the file ")
@@ -171,7 +194,7 @@
 
 	 ((consp val)
 	  (princ "the rectangle:\n")
-          (while val
+	  (while val
 	    (princ (car val))
 	    (terpri)
 	    (setq val (cdr val))))
@@ -185,7 +208,7 @@
 	  (prin1 val)))))))
 
 (defun insert-register (register &optional arg)
-  "Insert contents of register REGISTER.  (REGISTER is a character).
+  "Insert contents of register REGISTER.  (REGISTER is a character.)
 Normally puts point before and mark after the inserted text.
 If optional second arg is non-nil, puts mark before and point after.
 Interactively, second arg is non-nil if prefix arg is supplied."
@@ -203,8 +226,7 @@
       (princ (marker-position val) (current-buffer)))
      (t
       (error "Register does not contain text"))))
-  ;; XEmacs: don't activate the region.  It's annoying.
-  (if (not arg) (exchange-point-and-mark t)))
+  (if (not arg) (exchange-point-and-mark)))
 
 (defun copy-to-register (register start end &optional delete-flag)
   "Copy region into register REGISTER.  With prefix arg, delete as well.
@@ -223,7 +245,7 @@
   (or (stringp (get-register register))
       (error "Register does not contain text"))
   (set-register register (concat (get-register register)
-			     (buffer-substring start end)))
+			    (buffer-substring start end)))
   (if delete-flag (delete-region start end)))
 
 (defun prepend-to-register (register start end &optional delete-flag)
@@ -235,7 +257,7 @@
   (or (stringp (get-register register))
       (error "Register does not contain text"))
   (set-register register (concat (buffer-substring start end)
-			     (get-register register)))
+			    (get-register register)))
   (if delete-flag (delete-region start end)))
 
 (defun copy-rectangle-to-register (register start end &optional delete-flag)