Mercurial > hg > xemacs-beta
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)
