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