diff lisp/register.el @ 284:558f606b08ae r21-0b40

Import from CVS: tag r21-0b40
author cvs
date Mon, 13 Aug 2007 10:34:13 +0200
parents c5d627a313b1
children 3cc9f0ebfbd1
line wrap: on
line diff
--- a/lisp/register.el	Mon Aug 13 10:33:19 2007 +0200
+++ b/lisp/register.el	Mon Aug 13 10:34:13 2007 +0200
@@ -22,7 +22,7 @@
 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 ;; 02111-1307, USA.
 
-;;; Synched up with: FSF 20.1
+;;; Synched up with: FSF 20.3
 
 ;;; Commentary:
 
@@ -37,19 +37,22 @@
 
 (defvar register-alist nil
   "Alist of elements (NAME . CONTENTS), one for each Emacs register.
-NAME is a character (a number).  CONTENTS is a string, number,
-frame configuration, mark or list.
+NAME is a character (a number).  CONTENTS is a string, number, marker 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-query NAME POSITION) represents position POSITION
- in the file named NAME, but query before visiting it.")
+ in the file named NAME, but query before visiting it.
+A list of the form (WINDOW-CONFIGURATION POSITION)
+ represents a saved window configuration plus a saved value of point.
+A list of the form (FRAME-CONFIGURATION POSITION)
+ represents a saved frame configuration plus a saved value of point.")
 
 (defun get-register (reg)
   "Return contents of Emacs register named REG, or nil if none."
   (cdr (assq reg register-alist)))
 
 (defun set-register (register value)
-  "Set contents of Emacs register named REGISTER to VALUE.  Return VALUE.
+  "Set contents of Emacs register named REGISTER to VALUE.  Returns VALUE.
 See the documentation of the variable `register-alist' for possible VALUE."
   (let ((aelt (assq register register-alist)))
     (if aelt
@@ -65,21 +68,26 @@
 Argument is a character, naming the register."
   (interactive "cPoint to register: \nP")
   (set-register register
-		(if arg (current-frame-configuration) (point-marker))))
+		(if arg (list (current-frame-configuration) (point-marker))
+		  (point-marker))))
 
 (defun window-configuration-to-register (register &optional arg)
   "Store the window configuration of the selected frame in register REGISTER.
 Use \\[jump-to-register] to restore the configuration.
 Argument is a character, naming the register."
   (interactive "cWindow configuration to register: \nP")
-  (set-register register (current-window-configuration)))
+  ;; current-window-configuration does not include the value
+  ;; of point in the current buffer, so record that separately.
+  (set-register register (list (current-window-configuration) (point-marker))))
 
 (defun frame-configuration-to-register (register &optional arg)
   "Store the window configuration of all frames in register REGISTER.
 Use \\[jump-to-register] to restore the configuration.
 Argument is a character, naming the register."
   (interactive "cFrame configuration to register: \nP")
-  (set-register register (current-frame-configuration)))
+  ;; current-frame-configuration does not include the value
+  ;; of point in the current buffer, so record that separately.
+  (set-register register (list (current-frame-configuration) (point-marker))))
 
 (defalias 'register-to-point 'jump-to-register)
 (defun jump-to-register (register &optional delete)
@@ -95,11 +103,12 @@
   (interactive "cJump to register: \nP")
   (let ((val (get-register register)))
     (cond
-     ((and (fboundp 'frame-configuration-p)
-	   (frame-configuration-p val))
-      (set-frame-configuration val (not delete)))
-     ((window-configuration-p val)
-      (set-window-configuration val))
+     ((and (consp val) (frame-configuration-p (car val)))
+      (set-frame-configuration (car val) (not delete))
+      (goto-char (cadr val)))
+     ((and (consp val) (window-configuration-p (car val)))
+      (set-window-configuration (car val))
+      (goto-char (cadr val)))
      ((markerp val)
       (or (marker-buffer val)
 	  (error "That register's buffer no longer exists"))
@@ -131,33 +140,29 @@
 
 (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).
-;If NUMBER is nil, digits in the buffer following point are read
-;to get the number to store.
-;Interactively, NUMBER is the prefix arg (none means nil)."
-;  (interactive "P\ncNumber to register: ")
-;  (set-register char
-;		(if arg
-;		    (prefix-numeric-value arg)
-;		  (if (looking-at "[0-9][0-9]*")
-;		      (save-excursion
-;		       (save-restriction
-;			(narrow-to-region (point)
-;					  (progn (skip-chars-forward "0-9")
-;						 (point)))
-;			(goto-char (point-min))
-;			(read (current-buffer))))
-;		    0))))
+(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 register 
+		(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)
-;  "Add NUMBER to the contents of register REGISTER.
-;Interactively, NUMBER is the prefix arg (none means nil)."
-;  (interactive "p\ncNumber to register: ")
-;  (or (integerp (get-register char))
-;      (error "Register does not contain a number"))
-;  (set-register char (+ arg (get-register char))))
+(defun increment-register (number register)
+  "Add NUMBER to the contents of register REGISTER.
+Interactively, NUMBER is the prefix arg."
+  (interactive "p\ncIncrement register: ")
+  (or (numberp (get-register register))
+      (error "Register does not contain a number"))
+  (set-register register (+ number (get-register register))))
 
 (defun view-register (register)
   "Display what is contained in register named REGISTER.
@@ -171,7 +176,7 @@
 	(princ (single-key-description register))
 	(princ " contains ")
 	(cond
-	 ((integerp val)
+	 ((numberp val)
 	  (princ val))
 
 	 ((markerp val)
@@ -183,10 +188,10 @@
 	      (princ ", position ")
 	      (princ (marker-position val)))))
 
-	 ((window-configuration-p val)
+	 ((and (consp val) (window-configuration-p (car val)))
 	  (princ "a window configuration."))
 
-	 ((frame-configuration-p val)
+	 ((and (consp val) (frame-configuration-p (car val)))
 	  (princ "a frame configuration."))
 
 	 ((and (consp val) (eq (car val) 'file))
@@ -225,11 +230,11 @@
   (push-mark)
   (let ((val (get-register register)))
     (cond
-     ((and (consp val) (fboundp 'insert-rectangle))
+     ((consp val)
       (insert-rectangle val))
      ((stringp val)
       (insert val))
-     ((integerp val)
+     ((numberp val)
       (princ val (current-buffer)))
      ((and (markerp val) (marker-position val))
       (princ (marker-position val) (current-buffer)))
@@ -275,8 +280,6 @@
 Called from program, takes four args: REGISTER, START, END and DELETE-FLAG.
 START and END are buffer positions giving two corners of rectangle."
   (interactive "cCopy rectangle to register: \nr\nP")
-  (unless (fboundp 'extract-rectangle)
-    (error "Rectangles are not available in this XEmacs"))
   (set-register register
 		(if delete-flag
 		    (delete-extract-rectangle start end)