![[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 [Apple XNU] / GNUtools / emacs / lisp|
Return to register.el CVS log | Up to [Apple XNU] / GNUtools / emacs / lisp |
1.1 root 1: ;; Register commands for Emacs.
2: ;; Copyright (C) 1985 Free Software Foundation, Inc.
3:
4: ;; This file is part of GNU Emacs.
5:
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)
9: ;; any later version.
10:
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.
15:
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.
19:
20:
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.")
25:
26: (defun get-register (char)
27: "Return contents of Emacs register named CHAR, or nil if none."
28: (cdr (assq char register-alist)))
29:
30: (defun set-register (char value)
31: "Set contents of Emacs register named CHAR to VALUE."
32: (let ((aelt (assq char register-alist)))
33: (if aelt
34: (setcdr aelt value)
35: (setq aelt (cons char value))
36: (setq register-alist (cons aelt register-alist)))))
37:
38: (defun point-to-register (char)
39: "Store current location of point in a register.
40: Argument is a character, naming the register."
41: (interactive "cPoint to register: ")
42: (set-register char (point-marker)))
43:
44: (defun register-to-point (char)
45: "Move point to location stored in a register.
46: Argument is a character, naming the register."
47: (interactive "cRegister to point: ")
48: (let ((val (get-register char)))
49: (if (markerp val)
50: (progn
51: (switch-to-buffer (marker-buffer val))
52: (goto-char val))
53: (error "Register doesn't contain a buffer position"))))
54:
55: ;(defun number-to-register (arg char)
56: ; "Store a number in a register.
57: ;Two args, NUMBER and REGISTER (a character, naming the register).
58: ;If NUMBER is nil, digits in the buffer following point are read
59: ;to get the number to store.
60: ;Interactively, NUMBER is the prefix arg (none means nil)."
61: ; (interactive "P\ncNumber to register: ")
62: ; (set-register char
63: ; (if arg
64: ; (prefix-numeric-value arg)
65: ; (if (looking-at "[0-9][0-9]*")
66: ; (save-excursion
67: ; (save-restriction
68: ; (narrow-to-region (point)
69: ; (progn (skip-chars-forward "0-9")
70: ; (point)))
71: ; (goto-char (point-min))
72: ; (read (current-buffer))))
73: ; 0))))
74:
75: ;(defun increment-register (arg char)
76: ; "Add NUMBER to the contents of register REGISTER.
77: ;Interactively, NUMBER is the prefix arg (none means nil)."
78: ; (interactive "p\ncNumber to register: ")
79: ; (or (integerp (get-register char))
80: ; (error "Register does not contain a number"))
81: ; (set-register char (+ arg (get-register char))))
82:
83: (defun view-register (char)
84: "Display what is contained in register named REGISTER.
85: REGISTER is a character."
86: (interactive "cView register: ")
87: (let ((val (get-register char)))
88: (if (null val)
89: (message "Register %s is empty" (single-key-description char))
90: (with-output-to-temp-buffer "*Output*"
91: (princ "Register ")
92: (princ (single-key-description char))
93: (princ " contains ")
94: (if (integerp val)
95: (princ val)
96: (if (markerp val)
97: (progn
98: (princ "a buffer position:\nbuffer ")
99: (princ (buffer-name (marker-buffer val)))
100: (princ ", position ")
101: (princ (+ 0 val)))
102: (if (consp val)
103: (progn
104: (princ "the rectangle:\n")
105: (while val
106: (princ (car val))
107: (terpri)
108: (setq val (cdr val))))
109: (princ "the string:\n")
110: (princ val))))))))
111:
112: (defun insert-register (char &optional arg)
113: "Insert contents of register REG. REG is a character.
114: Normally puts point before and mark after the inserted text.
115: If optional second arg is non-nil, puts mark before and point after.
116: Interactively, second arg is non-nil if prefix arg is supplied."
117: (interactive "cInsert register: \nP")
118: (push-mark)
119: (let ((val (get-register char)))
120: (if (consp val)
121: (insert-rectangle val)
122: (if (stringp val)
123: (insert val)
124: (if (or (integerp val) (markerp val))
125: (princ (+ 0 val) (current-buffer))
126: (error "Register does not contain text")))))
127: (or arg (exchange-point-and-mark)))
128:
129: (defun copy-to-register (char start end &optional delete-flag)
130: "Copy region into register REG.
131: With prefix arg, delete as well.
132: Called from program, takes four args:
133: REG, START, END and DELETE-FLAG.
134: START and END are buffer positions indicating what to copy."
135: (interactive "cCopy to register: \nr\nP")
136: (set-register char (buffer-substring start end))
137: (if delete-flag (delete-region start end)))
138:
139: (defun append-to-register (char start end &optional delete-flag)
140: "Append region to text in register REG.
141: With prefix arg, delete as well.
142: Called from program, takes four args:
143: REG, START, END and DELETE-FLAG.
144: START and END are buffer positions indicating what to append."
145: (interactive "cAppend to register: \nr\nP")
146: (or (stringp (get-register char))
147: (error "Register does not contain text"))
148: (set-register char (concat (get-register char)
149: (buffer-substring start end)))
150: (if delete-flag (delete-region start end)))
151:
152: (defun prepend-to-register (char start end &optional delete-flag)
153: "Prepend region to text in register REG.
154: With prefix arg, delete as well.
155: Called from program, takes four args:
156: REG, START, END and DELETE-FLAG.
157: START and END are buffer positions indicating what to prepend."
158: (interactive "cPrepend to register: \nr\nP")
159: (or (stringp (get-register char))
160: (error "Register does not contain text"))
161: (set-register char (concat (buffer-substring start end)
162: (get-register char)))
163: (if delete-flag (delete-region start end)))
164:
165: (defun copy-rectangle-to-register (char start end &optional delete-flag)
166: "Copy rectangular region into register REG.
167: With prefix arg, delete as well.
168: Called from program, takes four args:
169: REG, START, END and DELETE-FLAG.
170: START and END are buffer positions giving two corners of rectangle."
171: (interactive "cCopy rectangle to register: \nr\nP")
172: (set-register char
173: (if delete-flag
174: (delete-extract-rectangle start end)
175: (extract-rectangle start end))))
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.