![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to register.el CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSD / contrib / emacs / lisp|
Return to register.el CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / emacs / lisp |
1.1 root 1: ;; Register commands for Emacs.
2: ;; Copyright (C) 1985 Richard M. Stallman.
3:
4: ;; This file is part of GNU Emacs.
5:
6: ;; GNU Emacs is distributed in the hope that it will be useful,
7: ;; but WITHOUT ANY WARRANTY. No author or distributor
8: ;; accepts responsibility to anyone for the consequences of using it
9: ;; or for whether it serves any particular purpose or works at all,
10: ;; unless he says so in writing. Refer to the GNU Emacs General Public
11: ;; License for full details.
12:
13: ;; Everyone is granted permission to copy, modify and redistribute
14: ;; GNU Emacs, but only under the conditions described in the
15: ;; GNU Emacs General Public License. A copy of this license is
16: ;; supposed to have been given to you along with GNU Emacs so you
17: ;; can know your rights and responsibilities. It should be in a
18: ;; file named COPYING. Among other things, the copyright notice
19: ;; and this notice must be preserved on all copies.
20:
21:
22: (defvar register-alist nil
23: "Alist of elements (NAME . CONTENTS), one for each Emacs register.
24: NAME is a character (a number). CONTENTS is a string, number,
25: mark or list. A list represents a rectangle; its elements are strings.")
26:
27: (defun get-register (char)
28: "Return contents of Emacs register named CHAR, or nil if none."
29: (cdr (assq char register-alist)))
30:
31: (defun set-register (char value)
32: "Set contents of Emacs register named CHAR to VALUE."
33: (let ((aelt (assq char register-alist)))
34: (if aelt
35: (setcdr aelt value)
36: (setq aelt (cons char value))
37: (setq register-alist (cons aelt register-alist)))))
38:
39: (defun point-to-register (char)
40: "Store current location of point in a register.
41: Argument is a character, naming the register."
42: (interactive "cPoint to register: ")
43: (set-register char (point-marker)))
44:
45: (defun register-to-point (char)
46: "Move point to location stored in a register.
47: Argument is a character, naming the register."
48: (interactive "cRegister to point: ")
49: (let ((val (get-register char)))
50: (if (markerp val)
51: (progn
52: (switch-to-buffer (marker-buffer val))
53: (goto-char val))
54: (error "Register doesn't contain a buffer position"))))
55:
56: ;(defun number-to-register (arg char)
57: ; "Store a number in a register.
58: ;Two args, NUMBER and REGISTER (a character, naming the register).
59: ;If NUMBER is nil, digits in the buffer following point are read
60: ;to get the number to store.
61: ;Interactively, NUMBER is the prefix arg (none means nil)."
62: ; (interactive "P\ncNumber to register: ")
63: ; (set-register char
64: ; (if arg
65: ; (prefix-numeric-value arg)
66: ; (if (looking-at "[0-9][0-9]*")
67: ; (save-excursion
68: ; (save-restriction
69: ; (narrow-to-region (point)
70: ; (progn (skip-chars-forward "0-9")
71: ; (point)))
72: ; (goto-char (point-min))
73: ; (read (current-buffer))))
74: ; 0))))
75:
76: ;(defun increment-register (arg char)
77: ; "Add NUMBER to the contents of register REGISTER.
78: ;Interactively, NUMBER is the prefix arg (none means nil)."
79: ; (interactive "p\ncNumber to register: ")
80: ; (or (integerp (get-register char))
81: ; (error "Register does not contain a number"))
82: ; (set-register char (+ arg (get-register char))))
83:
84: (defun view-register (char)
85: "Display what is contained in register named REGISTER.
86: REGISTER is a character."
87: (interactive "cView register: ")
88: (let ((val (get-register char)))
89: (if (null val)
90: (message "Register %s is empty" (single-key-description char))
91: (with-output-to-temp-buffer "*Output*"
92: (princ "Register ")
93: (princ (single-key-description char))
94: (princ " contains ")
95: (if (integerp val)
96: (princ val)
97: (if (markerp val)
98: (progn
99: (princ "a buffer position:\nbuffer ")
100: (princ (buffer-name (marker-buffer val)))
101: (princ ", position ")
102: (princ (+ 0 val)))
103: (if (consp val)
104: (progn
105: (princ "the rectangle:\n")
106: (setq val (cdr val))
107: (while val
108: (princ (car val))
109: (terpri)
110: (setq val (cdr val))))
111: (princ "the string:\n")
112: (princ val))))))))
113:
114: (defun insert-register (char &optional arg)
115: "Insert contents of register REG. REG is a character.
116: Normally puts point before and mark after the inserted text.
117: If optional second arg is non-nil, puts mark before and point after.
118: Interactively, second arg is non-nil if prefix arg is supplied."
119: (interactive "cInsert register: \nP")
120: (push-mark)
121: (let ((val (get-register char)))
122: (if (consp val)
123: (insert-rectangle val)
124: (if (stringp val)
125: (insert val)
126: (if (or (integerp val) (markerp val))
127: (princ (+ 0 val) (current-buffer))
128: (error "Register does not contain text")))))
129: (or arg (exchange-point-and-mark)))
130:
131: (defun copy-to-register (char start end &optional delete-flag)
132: "Copy region into register REG.
133: With prefix arg, delete as well.
134: Called from program, takes four args:
135: REG, START, END and DELETE-FLAG.
136: START and END are buffer positions indicating what to copy."
137: (interactive "cCopy to register: \nr\nP")
138: (set-register char (buffer-substring start end))
139: (if delete-flag (delete-region start end)))
140:
141: (defun append-to-register (char start end &optional delete-flag)
142: "Append region to text in register REG.
143: With prefix arg, delete as well.
144: Called from program, takes four args:
145: REG, START, END and DELETE-FLAG.
146: START and END are buffer positions indicating what to append."
147: (interactive "cAppend to register: \nr\nP")
148: (or (stringp (get-register char))
149: (error "Register does not contain text"))
150: (set-register char (concat (get-register char)
151: (buffer-substring start end)))
152: (if delete-flag (delete-region start end)))
153:
154: (defun prepend-to-register (char start end &optional delete-flag)
155: "Prepend region to text in register REG.
156: With prefix arg, delete as well.
157: Called from program, takes four args:
158: REG, START, END and DELETE-FLAG.
159: START and END are buffer positions indicating what to prepend."
160: (interactive "cPrepend to register: \nr\nP")
161: (or (stringp (get-register char))
162: (error "Register does not contain text"))
163: (set-register char (concat (buffer-substring start end)
164: (get-register char)))
165: (if delete-flag (delete-region start end)))
166:
167: (defun copy-rectangle-to-register (char start end &optional delete-flag)
168: "Copy rectangular region into register REG.
169: With prefix arg, delete as well.
170: Called from program, takes four args:
171: REG, START, END and DELETE-FLAG.
172: START and END are buffer positions giving two corners of rectangle."
173: (interactive "cCopy rectangle to register: \nr\nP")
174: (set-register char
175: (if delete-flag
176: (delete-extract-rectangle start end)
177: (extract-rectangle start end))))
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.