1 ;;; register.el --- register commands for Emacs.
4 ;; Last-Modified: 9 Jul 1992
6 ;; Copyright (C) 1985 Free Software Foundation, Inc.
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 1, or (at your option)
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to
22 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
26 (defvar register-alist nil
27 "Alist of elements (NAME . CONTENTS), one for each Emacs register.
28 NAME is a character (a number). CONTENTS is a string, number,
29 frame configuration, mark or list.
30 A list represents a rectangle; its elements are strings.")
32 (defun get-register (char)
33 "Return contents of Emacs register named CHAR, or nil if none."
34 (cdr (assq char register-alist
)))
36 (defun set-register (char value
)
37 "Set contents of Emacs register named CHAR to VALUE. Returns VALUE."
38 (let ((aelt (assq char register-alist
)))
41 (setq aelt
(cons char value
))
42 (setq register-alist
(cons aelt register-alist
)))
45 (defun point-to-register (char arg
)
46 "Store current location of point in register REGISTER.
47 With prefix argument, store current frame configuration.
48 Use \\[jump-to-register] to go to that location or restore that configuration.
49 Argument is a character, naming the register."
50 (interactive "cPoint to register: \nP")
51 (set-register char
(if arg
(current-frame-configuration) (point-marker))))
53 (fset 'register-to-point
'jump-to-register
)
54 (defun jump-to-register (char)
55 "Move point to location stored in a register.
56 Argument is a character, naming the register."
57 (interactive "cJump to register: ")
58 (let ((val (get-register char
)))
60 (set-frame-configuration val
)
64 (switch-to-buffer (marker-buffer val
))
66 (error "Register doesn't contain a buffer position or frame configuration"))))))
68 ;(defun number-to-register (arg char)
69 ; "Store a number in a register.
70 ;Two args, NUMBER and REGISTER (a character, naming the register).
71 ;If NUMBER is nil, digits in the buffer following point are read
72 ;to get the number to store.
73 ;Interactively, NUMBER is the prefix arg (none means nil)."
74 ; (interactive "P\ncNumber to register: ")
77 ; (prefix-numeric-value arg)
78 ; (if (looking-at "[0-9][0-9]*")
81 ; (narrow-to-region (point)
82 ; (progn (skip-chars-forward "0-9")
84 ; (goto-char (point-min))
85 ; (read (current-buffer))))
88 ;(defun increment-register (arg char)
89 ; "Add NUMBER to the contents of register REGISTER.
90 ;Interactively, NUMBER is the prefix arg (none means nil)."
91 ; (interactive "p\ncNumber to register: ")
92 ; (or (integerp (get-register char))
93 ; (error "Register does not contain a number"))
94 ; (set-register char (+ arg (get-register char))))
96 (defun view-register (char)
97 "Display what is contained in register named REGISTER.
98 REGISTER is a character."
99 (interactive "cView register: ")
100 (let ((val (get-register char
)))
102 (message "Register %s is empty" (single-key-description char
))
103 (with-output-to-temp-buffer "*Output*"
105 (princ (single-key-description char
))
111 (princ "a buffer position:\nbuffer ")
112 (princ (buffer-name (marker-buffer val
)))
113 (princ ", position ")
117 (princ "the rectangle:\n")
121 (setq val
(cdr val
))))
122 (princ "the string:\n")
125 (defun insert-register (char &optional arg
)
126 "Insert contents of register REG. REG is a character.
127 Normally puts point before and mark after the inserted text.
128 If optional second arg is non-nil, puts mark before and point after.
129 Interactively, second arg is non-nil if prefix arg is supplied."
130 (interactive "cInsert register: \nP")
132 (let ((val (get-register char
)))
134 (insert-rectangle val
)
137 (if (or (integerp val
) (markerp val
))
138 (princ (+ 0 val
) (current-buffer))
139 (error "Register does not contain text")))))
140 (if (not arg
) (exchange-point-and-mark)))
142 (defun copy-to-register (char start end
&optional delete-flag
)
143 "Copy region into register REG. With prefix arg, delete as well.
144 Called from program, takes four args: REG, START, END and DELETE-FLAG.
145 START and END are buffer positions indicating what to copy."
146 (interactive "cCopy to register: \nr\nP")
147 (set-register char
(buffer-substring start end
))
148 (if delete-flag
(delete-region start end
)))
150 (defun append-to-register (char start end
&optional delete-flag
)
151 "Append region to text in register REG. With prefix arg, delete as well.
152 Called from program, takes four args: REG, START, END and DELETE-FLAG.
153 START and END are buffer positions indicating what to append."
154 (interactive "cAppend to register: \nr\nP")
155 (or (stringp (get-register char
))
156 (error "Register does not contain text"))
157 (set-register char
(concat (get-register char
)
158 (buffer-substring start end
)))
159 (if delete-flag
(delete-region start end
)))
161 (defun prepend-to-register (char start end
&optional delete-flag
)
162 "Prepend region to text in register REG. With prefix arg, delete as well.
163 Called from program, takes four args: REG, START, END and DELETE-FLAG.
164 START and END are buffer positions indicating what to prepend."
165 (interactive "cPrepend to register: \nr\nP")
166 (or (stringp (get-register char
))
167 (error "Register does not contain text"))
168 (set-register char
(concat (buffer-substring start end
)
169 (get-register char
)))
170 (if delete-flag
(delete-region start end
)))
172 (defun copy-rectangle-to-register (char start end
&optional delete-flag
)
173 "Copy rectangular region into register REG. With prefix arg, delete as well.
174 Called from program, takes four args: REG, START, END and DELETE-FLAG.
175 START and END are buffer positions giving two corners of rectangle."
176 (interactive "cCopy rectangle to register: \nr\nP")
179 (delete-extract-rectangle start end
)
180 (extract-rectangle start end
))))
182 ;;; register.el ends here