A list of the form (FRAME-CONFIGURATION POSITION)
represents a saved frame configuration plus a saved value of point.")
+(defgroup register nil
+ "Register commands."
+ :group 'convenience
+ :version "24.2.50")
+
+(defcustom separator-register nil
+ "Use contents of this register to separate collected text.
+
+When collecting text with
+`append-to-register' (resp. `prepend-to-register') contents of
+this register is added to the beginning (resp. end) of the marked
+text."
+ :group 'register
+ :type '(choice (const :tag "None" nil)
+ (character :tag "Use register" :value ?+)))
+
(defun get-register (register)
"Return contents of Emacs register named REGISTER, or nil if none."
(cdr (assq register register-alist)))
(string-to-number (match-string 0)))
0))))
-(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 increment-register (prefix register)
+ "Augment contents of REGISTER.
+Interactively, PREFIX is in raw form.
+
+If REGISTER contains a number, add `prefix-numeric-value' of
+PREFIX to it.
+
+If REGISTER is empty or if it contains text, call
+`append-to-register' with `delete-flag' set to PREFIX."
+ (interactive "P\ncIncrement register: ")
+ (let ((register-val (get-register register)))
+ (cond
+ ((numberp register-val)
+ (let ((number (prefix-numeric-value prefix)))
+ (set-register register (+ number register-val))))
+ ((or (not register-val) (stringp register-val))
+ (append-to-register register (region-beginning) (region-end) prefix))
+ (t (error "Register does not contain a number or text")))))
(defun view-register (register)
"Display what is contained in register named REGISTER.
START and END are buffer positions indicating what to copy."
(interactive "cCopy to register: \nr\nP")
(set-register register (filter-buffer-substring start end))
- (if delete-flag (delete-region start end)))
+ (setq deactivate-mark t)
+ (cond (delete-flag
+ (delete-region start end))
+ ((called-interactively-p 'interactive)
+ (indicate-copied-region))))
(defun append-to-register (register start end &optional delete-flag)
"Append region to text in register REGISTER.
START and END are buffer positions indicating what to append."
(interactive "cAppend to register: \nr\nP")
(let ((reg (get-register register))
- (text (filter-buffer-substring start end)))
+ (text (filter-buffer-substring start end))
+ (separator (and separator-register (get-register separator-register))))
(set-register
register (cond ((not reg) text)
- ((stringp reg) (concat reg text))
+ ((stringp reg) (concat reg separator text))
(t (error "Register does not contain text")))))
- (if delete-flag (delete-region start end)))
+ (cond (delete-flag
+ (delete-region start end))
+ ((called-interactively-p 'interactive)
+ (indicate-copied-region))))
(defun prepend-to-register (register start end &optional delete-flag)
"Prepend region to text in register REGISTER.
START and END are buffer positions indicating what to prepend."
(interactive "cPrepend to register: \nr\nP")
(let ((reg (get-register register))
- (text (filter-buffer-substring start end)))
+ (text (filter-buffer-substring start end))
+ (separator (and separator-register (get-register separator-register))))
(set-register
register (cond ((not reg) text)
- ((stringp reg) (concat text reg))
+ ((stringp reg) (concat text separator reg))
(t (error "Register does not contain text")))))
- (if delete-flag (delete-region start end)))
+ (cond (delete-flag
+ (delete-region start end))
+ ((called-interactively-p 'interactive)
+ (indicate-copied-region))))
(defun copy-rectangle-to-register (register start end &optional delete-flag)
"Copy rectangular region into register 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
- (if delete-flag
- (delete-extract-rectangle start end)
- (extract-rectangle start end))))
+ (let ((rectangle (if delete-flag
+ (delete-extract-rectangle start end)
+ (extract-rectangle start end))))
+ (set-register register rectangle)
+ (when (and (null delete-flag)
+ (called-interactively-p 'interactive))
+ (setq deactivate-mark t)
+ (indicate-copied-region (length (car rectangle))))))
+
(provide 'register)
;;; register.el ends here