1 ;;; register.el --- register commands for Emacs.
3 ;; 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 2, 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 &optional 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 (defun window-configuration-to-register (char &optional arg
)
54 "Store the window configuration of the selected frame in register REGISTER.
55 Use \\[jump-to-register] to restore the configuration.
56 Argument is a character, naming the register."
57 (interactive "cPoint to register: \nP")
58 (set-register char
(current-window-configuration)))
60 (defun frame-configuration-to-register (char &optional arg
)
61 "Store the window configuration of all frames in register REGISTER.
62 Use \\[jump-to-register] to restore the configuration.
63 Argument is a character, naming the register."
64 (interactive "cPoint to register: \nP")
65 (set-register char
(current-frame-configuration)))
67 (fset 'register-to-point
'jump-to-register
)
68 (defun jump-to-register (char)
69 "Move point to location stored in a register.
70 If the register contains a window configuration (one frame) or a frame
71 configuration (all frames), restore that frame or all frames accordingly.
72 Argument is a character, naming the register."
73 (interactive "cJump to register: ")
74 (let ((val (get-register char
)))
76 ((frame-configuration-p val
)
77 (set-frame-configuration val
))
78 ((window-configuration-p val
)
79 (set-window-configuration val
))
81 (switch-to-buffer (marker-buffer val
))
84 (error "Register doesn't contain a buffer position or configuration")))))
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: ")
95 ; (prefix-numeric-value arg)
96 ; (if (looking-at "[0-9][0-9]*")
99 ; (narrow-to-region (point)
100 ; (progn (skip-chars-forward "0-9")
102 ; (goto-char (point-min))
103 ; (read (current-buffer))))
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))))
114 (defun view-register (char)
115 "Display what is contained in register named REGISTER.
116 REGISTER is a character."
117 (interactive "cView register: ")
118 (let ((val (get-register char
)))
120 (message "Register %s is empty" (single-key-description char
))
121 (with-output-to-temp-buffer "*Output*"
123 (princ (single-key-description char
))
130 (princ "a buffer position:\nbuffer ")
131 (princ (buffer-name (marker-buffer val
)))
132 (princ ", position ")
135 ((window-configuration-p val
)
136 (princ "a window configuration."))
138 ((frame-configuration-p val
)
139 (princ "a frame configuration."))
142 (princ "the rectangle:\n")
146 (setq val
(cdr val
))))
149 (princ "the text:\n")
156 (defun insert-register (char &optional arg
)
157 "Insert contents of register REG. REG is a character.
158 Normally puts point before and mark after the inserted text.
159 If optional second arg is non-nil, puts mark before and point after.
160 Interactively, second arg is non-nil if prefix arg is supplied."
161 (interactive "cInsert register: \nP")
163 (let ((val (get-register char
)))
165 (insert-rectangle 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)))
173 (defun copy-to-register (char start end
&optional delete-flag
)
174 "Copy region into register REG. With prefix arg, delete as well.
175 Called from program, takes four args: REG, START, END and DELETE-FLAG.
176 START 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
)))
181 (defun append-to-register (char start end
&optional delete-flag
)
182 "Append region to text in register REG. With prefix arg, delete as well.
183 Called from program, takes four args: REG, START, END and DELETE-FLAG.
184 START 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
)))
192 (defun prepend-to-register (char start end
&optional delete-flag
)
193 "Prepend region to text in register REG. With prefix arg, delete as well.
194 Called from program, takes four args: REG, START, END and DELETE-FLAG.
195 START 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
)))
203 (defun copy-rectangle-to-register (char start end
&optional delete-flag
)
204 "Copy rectangular region into register REG. With prefix arg, delete as well.
205 Called from program, takes four args: REG, START, END and DELETE-FLAG.
206 START and END are buffer positions giving two corners of rectangle."
207 (interactive "cCopy rectangle to register: \nr\nP")
210 (delete-extract-rectangle start end
)
211 (extract-rectangle start end
))))
213 ;;; register.el ends here