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