-;;; register.el --- register commands for Emacs.
+;;; register.el --- register commands for Emacs
;; Copyright (C) 1985, 1993, 1994 Free Software Foundation, Inc.
(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)
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))))
(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)
-
-(defun number-to-register (arg char)
+ (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.
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 char
- (if arg
- (prefix-numeric-value arg)
+ (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)))
+ (string-to-number (match-string 0)))
0))))
-(defun increment-register (arg char)
+(defun increment-register (number register)
"Add NUMBER to the contents of register REGISTER.
-Interactively, NUMBER is the prefix arg (none means nil)."
+Interactively, NUMBER is the prefix arg."
(interactive "p\ncIncrement register: ")
- (or (numberp (get-register char))
+ (or (numberp (get-register register))
(error "Register does not contain a number"))
- (set-register char (+ arg (get-register char))))
+ (set-register register (+ number (get-register register))))
(defun view-register (register)
"Display what is contained in register named REGISTER.
(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))
-
- ((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)))))
-
- ((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 "."))
-
- ((consp val)
- (princ "the rectangle:\n")
- (while val
- (princ (car val))
- (terpri)
- (setq val (cdr val))))
-
- ((stringp val)
- (princ "the text:\n")
- (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))))))
+
+(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))
+
+ ((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) (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-query))
+ (princ "a file-query reference:\n file ")
+ (prin1 (car (cdr val)))
+ (princ ",\n position ")
+ (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))))
+
+ ((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.)
((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))
(defun copy-rectangle-to-register (register start end &optional delete-flag)
"Copy rectangular region into register REGISTER.
-With prefix arg, delete as well.
-Called from program, takes four args: REGISTER, START, END and DELETE-FLAG.
+With prefix arg, delete as well. To insert this register
+in the buffer, use \\[insert-register].
+
+Called from a 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")
(set-register register
(delete-extract-rectangle start end)
(extract-rectangle start end))))
+(provide 'register)
+;;; arch-tag: ce14dd68-8265-475f-9341-5d4ec5a53035
;;; register.el ends here