Don't distribute etc/Old files.
[bpt/emacs.git] / lisp / register.el
CommitLineData
c88ab9ce
ER
1;;; register.el --- register commands for Emacs.
2
9750e079
ER
3;; Copyright (C) 1985 Free Software Foundation, Inc.
4
4821e2af 5;; Maintainer: FSF
d7b4d18f 6;; Keywords: internal
4821e2af 7
efeae993
RS
8;; This file is part of GNU Emacs.
9
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
e5167999 12;; the Free Software Foundation; either version 2, or (at your option)
efeae993
RS
13;; any later version.
14
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.
19
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.
23
4821e2af 24;;; Code:
efeae993
RS
25
26(defvar register-alist nil
27 "Alist of elements (NAME . CONTENTS), one for each Emacs register.
28NAME is a character (a number). CONTENTS is a string, number,
0cc89026 29frame configuration, mark or list.
b42e6156 30A list represents a rectangle; its elements are strings.")
efeae993
RS
31
32(defun get-register (char)
33 "Return contents of Emacs register named CHAR, or nil if none."
34 (cdr (assq char register-alist)))
35
36(defun set-register (char value)
14c5b721 37 "Set contents of Emacs register named CHAR to VALUE. Returns VALUE."
efeae993
RS
38 (let ((aelt (assq char register-alist)))
39 (if aelt
40 (setcdr aelt value)
41 (setq aelt (cons char value))
42 (setq register-alist (cons aelt register-alist)))
43 value))
44
a8a6776b 45(defun point-to-register (char &optional arg)
b42e6156 46 "Store current location of point in register REGISTER.
0cc89026 47With prefix argument, store current frame configuration.
b42e6156 48Use \\[jump-to-register] to go to that location or restore that configuration.
efeae993 49Argument is a character, naming the register."
b42e6156 50 (interactive "cPoint to register: \nP")
0cc89026 51 (set-register char (if arg (current-frame-configuration) (point-marker))))
efeae993 52
a8a6776b 53(defun window-configuration-to-register (char &optional arg)
83b5d757
RS
54 "Store the window configuration of the selected frame in register REGISTER.
55Use \\[jump-to-register] to restore the configuration.
56Argument is a character, naming the register."
57 (interactive "cPoint to register: \nP")
58 (set-register char (current-window-configuration)))
59
a8a6776b 60(defun frame-configuration-to-register (char &optional arg)
83b5d757
RS
61 "Store the window configuration of all frames in register REGISTER.
62Use \\[jump-to-register] to restore the configuration.
63Argument is a character, naming the register."
64 (interactive "cPoint to register: \nP")
65 (set-register char (current-frame-configuration)))
66
efeae993
RS
67(fset 'register-to-point 'jump-to-register)
68(defun jump-to-register (char)
69 "Move point to location stored in a register.
83b5d757
RS
70If the register contains a window configuration (one frame) or a frame
71configuration (all frames), restore that frame or all frames accordingly.
efeae993
RS
72Argument is a character, naming the register."
73 (interactive "cJump to register: ")
74 (let ((val (get-register char)))
376a7584
JB
75 (cond
76 ((frame-configuration-p val)
77 (set-frame-configuration val))
78 ((window-configuration-p val)
79 (set-window-configuration val))
80 ((markerp val)
81 (switch-to-buffer (marker-buffer val))
82 (goto-char val))
83 (t
84 (error "Register doesn't contain a buffer position or configuration")))))
efeae993
RS
85
86;(defun number-to-register (arg char)
87; "Store a number in a register.
88;Two args, NUMBER and REGISTER (a character, naming the register).
89;If NUMBER is nil, digits in the buffer following point are read
90;to get the number to store.
91;Interactively, NUMBER is the prefix arg (none means nil)."
92; (interactive "P\ncNumber to register: ")
93; (set-register char
94; (if arg
95; (prefix-numeric-value arg)
96; (if (looking-at "[0-9][0-9]*")
97; (save-excursion
98; (save-restriction
99; (narrow-to-region (point)
100; (progn (skip-chars-forward "0-9")
101; (point)))
102; (goto-char (point-min))
103; (read (current-buffer))))
104; 0))))
105
106;(defun increment-register (arg char)
107; "Add NUMBER to the contents of register REGISTER.
108;Interactively, NUMBER is the prefix arg (none means nil)."
109; (interactive "p\ncNumber to register: ")
110; (or (integerp (get-register char))
111; (error "Register does not contain a number"))
112; (set-register char (+ arg (get-register char))))
113
114(defun view-register (char)
115 "Display what is contained in register named REGISTER.
116REGISTER is a character."
117 (interactive "cView register: ")
118 (let ((val (get-register char)))
119 (if (null val)
120 (message "Register %s is empty" (single-key-description char))
121 (with-output-to-temp-buffer "*Output*"
122 (princ "Register ")
123 (princ (single-key-description char))
124 (princ " contains ")
ed83b192
JB
125 (cond
126 ((integerp val)
127 (princ val))
128
129 ((markerp val)
130 (princ "a buffer position:\nbuffer ")
131 (princ (buffer-name (marker-buffer val)))
132 (princ ", position ")
133 (princ (+ 0 val)))
134
135 ((window-configuration-p val)
136 (princ "a window configuration."))
137
138 ((frame-configuration-p val)
139 (princ "a frame configuration."))
140
141 ((consp val)
142 (princ "the rectangle:\n")
143 (while val
144 (princ (car val))
145 (terpri)
146 (setq val (cdr val))))
147
148 ((stringp val)
149 (princ "the text:\n")
150 (princ val))
151
152 (t
153 (princ "Garbage:\n")
154 (prin1 val)))))))
efeae993
RS
155
156(defun insert-register (char &optional arg)
157 "Insert contents of register REG. REG is a character.
158Normally puts point before and mark after the inserted text.
159If optional second arg is non-nil, puts mark before and point after.
160Interactively, second arg is non-nil if prefix arg is supplied."
161 (interactive "cInsert register: \nP")
162 (push-mark)
163 (let ((val (get-register char)))
164 (if (consp val)
165 (insert-rectangle val)
166 (if (stringp val)
167 (insert val)
168 (if (or (integerp val) (markerp val))
169 (princ (+ 0 val) (current-buffer))
170 (error "Register does not contain text")))))
171 (if (not arg) (exchange-point-and-mark)))
172
173(defun copy-to-register (char start end &optional delete-flag)
14c5b721
JB
174 "Copy region into register REG. With prefix arg, delete as well.
175Called from program, takes four args: REG, START, END and DELETE-FLAG.
efeae993
RS
176START and END are buffer positions indicating what to copy."
177 (interactive "cCopy to register: \nr\nP")
178 (set-register char (buffer-substring start end))
179 (if delete-flag (delete-region start end)))
180
181(defun append-to-register (char start end &optional delete-flag)
14c5b721
JB
182 "Append region to text in register REG. With prefix arg, delete as well.
183Called from program, takes four args: REG, START, END and DELETE-FLAG.
efeae993
RS
184START and END are buffer positions indicating what to append."
185 (interactive "cAppend to register: \nr\nP")
186 (or (stringp (get-register char))
187 (error "Register does not contain text"))
188 (set-register char (concat (get-register char)
189 (buffer-substring start end)))
190 (if delete-flag (delete-region start end)))
191
192(defun prepend-to-register (char start end &optional delete-flag)
14c5b721
JB
193 "Prepend region to text in register REG. With prefix arg, delete as well.
194Called from program, takes four args: REG, START, END and DELETE-FLAG.
efeae993
RS
195START and END are buffer positions indicating what to prepend."
196 (interactive "cPrepend to register: \nr\nP")
197 (or (stringp (get-register char))
198 (error "Register does not contain text"))
199 (set-register char (concat (buffer-substring start end)
200 (get-register char)))
201 (if delete-flag (delete-region start end)))
202
203(defun copy-rectangle-to-register (char start end &optional delete-flag)
14c5b721
JB
204 "Copy rectangular region into register REG. With prefix arg, delete as well.
205Called from program, takes four args: REG, START, END and DELETE-FLAG.
efeae993
RS
206START and END are buffer positions giving two corners of rectangle."
207 (interactive "cCopy rectangle to register: \nr\nP")
208 (set-register char
209 (if delete-flag
210 (delete-extract-rectangle start end)
211 (extract-rectangle start end))))
c88ab9ce
ER
212
213;;; register.el ends here