Commit | Line | Data |
---|---|---|
6594deb0 ER |
1 | ;;; rect.el --- rectangle functions for GNU Emacs. |
2 | ||
d733c5ec | 3 | ;; Copyright (C) 1985, 1994 Free Software Foundation, Inc. |
9750e079 | 4 | |
4821e2af | 5 | ;; Maintainer: FSF |
d7b4d18f | 6 | ;; Keywords: internal |
4821e2af | 7 | |
a2535589 JA |
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) |
a2535589 JA |
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 | |
b578f267 EN |
21 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
22 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
23 | ;; Boston, MA 02111-1307, USA. | |
a2535589 | 24 | |
edbd2f74 ER |
25 | ;;; Commentary: |
26 | ||
27 | ;; This package provides the operations on rectangles that are ocumented | |
28 | ;; in the Emacs manual. | |
29 | ||
4821e2af | 30 | ;;; Code: |
a2535589 | 31 | |
e40261d0 KH |
32 | ;;;###autoload |
33 | (defun move-to-column-force (column) | |
34 | "Move point to column COLUMN rigidly in the current line. | |
35 | If COLUMN is within a multi-column character, replace it by | |
36 | spaces and tab." | |
37 | (let ((col (move-to-column column t))) | |
38 | (if (> col column) | |
39 | (let (pos) | |
40 | (delete-char -1) | |
41 | (insert-char ? (- column (current-column))) | |
42 | (setq pos (point)) | |
43 | (indent-to col) | |
44 | (goto-char pos))) | |
45 | column)) | |
46 | ||
3d1b9783 RS |
47 | ;; extract-rectangle-line stores lines into this list |
48 | ;; to accumulate them for extract-rectangle and delete-extract-rectangle. | |
49 | (defvar operate-on-rectangle-lines) | |
50 | ||
a2535589 JA |
51 | (defun operate-on-rectangle (function start end coerce-tabs) |
52 | "Call FUNCTION for each line of rectangle with corners at START, END. | |
53 | If COERCE-TABS is non-nil, convert multi-column characters | |
54 | that span the starting or ending columns on any line | |
55 | to multiple spaces before calling FUNCTION. | |
56 | FUNCTION is called with three arguments: | |
57 | position of start of segment of this line within the rectangle, | |
58 | number of columns that belong to rectangle but are before that position, | |
59 | number of columns that belong to rectangle but are after point. | |
60 | Point is at the end of the segment of this line within the rectangle." | |
61 | (let (startcol startlinepos endcol endlinepos) | |
62 | (save-excursion | |
63 | (goto-char start) | |
64 | (setq startcol (current-column)) | |
65 | (beginning-of-line) | |
66 | (setq startlinepos (point))) | |
67 | (save-excursion | |
68 | (goto-char end) | |
69 | (setq endcol (current-column)) | |
70 | (forward-line 1) | |
71 | (setq endlinepos (point-marker))) | |
72 | (if (< endcol startcol) | |
08ce70d1 | 73 | (setq startcol (prog1 endcol (setq endcol startcol)))) |
bc8ea543 RS |
74 | (save-excursion |
75 | (goto-char startlinepos) | |
76 | (while (< (point) endlinepos) | |
77 | (let (startpos begextra endextra) | |
e40261d0 KH |
78 | (if coerce-tabs |
79 | (move-to-column-force startcol) | |
80 | (move-to-column startcol)) | |
bc8ea543 RS |
81 | (setq begextra (- (current-column) startcol)) |
82 | (setq startpos (point)) | |
e40261d0 KH |
83 | (if coerce-tabs |
84 | (move-to-column-force endcol) | |
85 | (move-to-column endcol)) | |
daabd795 RS |
86 | ;; If we overshot, move back one character |
87 | ;; so that endextra will be positive. | |
88 | (if (and (not coerce-tabs) (> (current-column) endcol)) | |
89 | (backward-char 1)) | |
bc8ea543 RS |
90 | (setq endextra (- endcol (current-column))) |
91 | (if (< begextra 0) | |
92 | (setq endextra (+ endextra begextra) | |
93 | begextra 0)) | |
94 | (funcall function startpos begextra endextra)) | |
95 | (forward-line 1))) | |
a2535589 JA |
96 | (- endcol startcol))) |
97 | ||
98 | (defun delete-rectangle-line (startdelpos ignore ignore) | |
99 | (delete-region startdelpos (point))) | |
100 | ||
101 | (defun delete-extract-rectangle-line (startdelpos begextra endextra) | |
102 | (save-excursion | |
103 | (extract-rectangle-line startdelpos begextra endextra)) | |
104 | (delete-region startdelpos (point))) | |
105 | ||
106 | (defun extract-rectangle-line (startdelpos begextra endextra) | |
107 | (let ((line (buffer-substring startdelpos (point))) | |
108 | (end (point))) | |
109 | (goto-char startdelpos) | |
110 | (while (search-forward "\t" end t) | |
111 | (let ((width (- (current-column) | |
112 | (save-excursion (forward-char -1) | |
113 | (current-column))))) | |
114 | (setq line (concat (substring line 0 (- (point) end 1)) | |
115 | (spaces-string width) | |
116 | (substring line (+ (length line) (- (point) end))))))) | |
117 | (if (or (> begextra 0) (> endextra 0)) | |
118 | (setq line (concat (spaces-string begextra) | |
119 | line | |
120 | (spaces-string endextra)))) | |
3d1b9783 | 121 | (setq operate-on-rectangle-lines (cons line operate-on-rectangle-lines)))) |
a2535589 JA |
122 | |
123 | (defconst spaces-strings | |
124 | '["" " " " " " " " " " " " " " " " "]) | |
125 | ||
126 | (defun spaces-string (n) | |
127 | (if (<= n 8) (aref spaces-strings n) | |
128 | (let ((val "")) | |
129 | (while (> n 8) | |
130 | (setq val (concat " " val) | |
131 | n (- n 8))) | |
132 | (concat val (aref spaces-strings n))))) | |
133 | ||
f9f9507e | 134 | ;;;###autoload |
a2535589 JA |
135 | (defun delete-rectangle (start end) |
136 | "Delete (don't save) text in rectangle with point and mark as corners. | |
573f9b32 RS |
137 | The same range of columns is deleted in each line starting with the line |
138 | where the region begins and ending with the line where the region ends." | |
a2535589 JA |
139 | (interactive "r") |
140 | (operate-on-rectangle 'delete-rectangle-line start end t)) | |
141 | ||
f9f9507e | 142 | ;;;###autoload |
a2535589 JA |
143 | (defun delete-extract-rectangle (start end) |
144 | "Delete contents of rectangle and return it as a list of strings. | |
145 | Arguments START and END are the corners of the rectangle. | |
146 | The value is list of strings, one for each line of the rectangle." | |
3d1b9783 | 147 | (let (operate-on-rectangle-lines) |
a2535589 JA |
148 | (operate-on-rectangle 'delete-extract-rectangle-line |
149 | start end t) | |
3d1b9783 | 150 | (nreverse operate-on-rectangle-lines))) |
a2535589 | 151 | |
f9f9507e | 152 | ;;;###autoload |
a2535589 JA |
153 | (defun extract-rectangle (start end) |
154 | "Return contents of rectangle with corners at START and END. | |
155 | Value is list of strings, one for each line of the rectangle." | |
3d1b9783 | 156 | (let (operate-on-rectangle-lines) |
a2535589 | 157 | (operate-on-rectangle 'extract-rectangle-line start end nil) |
3d1b9783 | 158 | (nreverse operate-on-rectangle-lines))) |
a2535589 JA |
159 | |
160 | (defvar killed-rectangle nil | |
161 | "Rectangle for yank-rectangle to insert.") | |
162 | ||
f9f9507e | 163 | ;;;###autoload |
a2535589 JA |
164 | (defun kill-rectangle (start end) |
165 | "Delete rectangle with corners at point and mark; save as last killed one. | |
166 | Calling from program, supply two args START and END, buffer positions. | |
573f9b32 | 167 | But in programs you might prefer to use `delete-extract-rectangle'." |
a2535589 | 168 | (interactive "r") |
db03492e RS |
169 | (if buffer-read-only |
170 | (progn | |
171 | (setq killed-rectangle (extract-rectangle start end)) | |
172 | (barf-if-buffer-read-only))) | |
a2535589 JA |
173 | (setq killed-rectangle (delete-extract-rectangle start end))) |
174 | ||
f9f9507e | 175 | ;;;###autoload |
a2535589 JA |
176 | (defun yank-rectangle () |
177 | "Yank the last killed rectangle with upper left corner at point." | |
178 | (interactive) | |
179 | (insert-rectangle killed-rectangle)) | |
180 | ||
f9f9507e | 181 | ;;;###autoload |
a2535589 JA |
182 | (defun insert-rectangle (rectangle) |
183 | "Insert text of RECTANGLE with upper left corner at point. | |
573f9b32 RS |
184 | RECTANGLE's first line is inserted at point, its second |
185 | line is inserted at a point vertically under point, etc. | |
23317eac RS |
186 | RECTANGLE should be a list of strings. |
187 | After this command, the mark is at the upper left corner | |
188 | and point is at the lower right corner." | |
a2535589 JA |
189 | (let ((lines rectangle) |
190 | (insertcolumn (current-column)) | |
191 | (first t)) | |
23317eac | 192 | (push-mark) |
a2535589 JA |
193 | (while lines |
194 | (or first | |
195 | (progn | |
196 | (forward-line 1) | |
197 | (or (bolp) (insert ?\n)) | |
e40261d0 | 198 | (move-to-column-force insertcolumn))) |
a2535589 JA |
199 | (setq first nil) |
200 | (insert (car lines)) | |
201 | (setq lines (cdr lines))))) | |
202 | ||
f9f9507e | 203 | ;;;###autoload |
a2535589 JA |
204 | (defun open-rectangle (start end) |
205 | "Blank out rectangle with corners at point and mark, shifting text right. | |
206 | The text previously in the region is not overwritten by the blanks, | |
08ce70d1 | 207 | but instead winds up to the right of the rectangle." |
a2535589 | 208 | (interactive "r") |
08ce70d1 JB |
209 | (operate-on-rectangle 'open-rectangle-line start end nil) |
210 | (goto-char start)) | |
a2535589 JA |
211 | |
212 | (defun open-rectangle-line (startpos begextra endextra) | |
bc8ea543 RS |
213 | ;; Column where rectangle ends. |
214 | (let ((endcol (+ (current-column) endextra)) | |
215 | whitewidth) | |
a2535589 | 216 | (goto-char startpos) |
bc8ea543 RS |
217 | ;; Column where rectangle begins. |
218 | (let ((begcol (- (current-column) begextra))) | |
e40261d0 KH |
219 | (if (> begextra 0) |
220 | (move-to-column-force begcol)) | |
a2535589 | 221 | (skip-chars-forward " \t") |
bc8ea543 RS |
222 | ;; Width of whitespace to be deleted and recreated. |
223 | (setq whitewidth (- (current-column) begcol))) | |
224 | ;; Delete the whitespace following the start column. | |
225 | (delete-region startpos (point)) | |
226 | ;; Open the desired width, plus same amount of whitespace we just deleted. | |
227 | (indent-to (+ endcol whitewidth)))) | |
a2535589 | 228 | |
ee9ec2a5 | 229 | ;;;###autoload (defalias 'close-rectangle 'delete-whitespace-rectangle) ;; Old name |
ecb079ed | 230 | ;;;###autoload |
b4de43a3 | 231 | (defun delete-whitespace-rectangle (start end) |
ecb079ed RS |
232 | "Delete all whitespace following a specified column in each line. |
233 | The left edge of the rectangle specifies the position in each line | |
234 | at which whitespace deletion should begin. On each line in the | |
235 | rectangle, all continuous whitespace starting at that column is deleted." | |
236 | (interactive "r") | |
237 | (operate-on-rectangle '(lambda (startpos begextra endextra) | |
238 | (save-excursion | |
239 | (goto-char startpos) | |
240 | (delete-region (point) | |
241 | (progn | |
242 | (skip-syntax-forward " ") | |
243 | (point))))) | |
244 | start end t)) | |
245 | ||
3d1b9783 RS |
246 | ;; string-rectangle uses this variable to pass the string |
247 | ;; to string-rectangle-line. | |
248 | (defvar string-rectangle-string) | |
ecb079ed | 249 | |
131ca136 | 250 | ;;;###autoload |
ccb629e4 | 251 | (defun string-rectangle (start end string) |
eb148b90 RS |
252 | "Replace rectangle contents with STRING on each line. |
253 | The length of STRING need not be the same as the rectangle width. | |
ccb629e4 RS |
254 | |
255 | Called from a program, takes three args; START, END and STRING." | |
256 | (interactive "r\nsString rectangle: ") | |
3d1b9783 RS |
257 | (let ((string-rectangle-string string)) |
258 | (operate-on-rectangle 'string-rectangle-line start end t))) | |
131ca136 | 259 | |
ccb629e4 | 260 | (defun string-rectangle-line (startpos begextra endextra) |
bc8ea543 | 261 | (let (whitespace) |
eb148b90 RS |
262 | ;; Delete the width of the rectangle. |
263 | (delete-region startpos (point)) | |
bc8ea543 | 264 | ;; Compute horizontal width of following whitespace. |
131ca136 ER |
265 | (let ((ocol (current-column))) |
266 | (skip-chars-forward " \t") | |
bc8ea543 RS |
267 | (setq whitespace (- (current-column) ocol))) |
268 | ;; Delete the following whitespace. | |
269 | (delete-region startpos (point)) | |
270 | ;; Insert the desired string. | |
3d1b9783 | 271 | (insert string-rectangle-string) |
bc8ea543 RS |
272 | ;; Insert the same width of whitespace that we had before. |
273 | (indent-to (+ (current-column) whitespace)))) | |
131ca136 | 274 | |
f9f9507e | 275 | ;;;###autoload |
a2535589 JA |
276 | (defun clear-rectangle (start end) |
277 | "Blank out rectangle with corners at point and mark. | |
278 | The text previously in the region is overwritten by the blanks. | |
279 | When called from a program, requires two args which specify the corners." | |
280 | (interactive "r") | |
281 | (operate-on-rectangle 'clear-rectangle-line start end t)) | |
282 | ||
283 | (defun clear-rectangle-line (startpos begextra endextra) | |
bc8ea543 | 284 | ;; Find end of whitespace after the rectangle. |
a2535589 JA |
285 | (skip-chars-forward " \t") |
286 | (let ((column (+ (current-column) endextra))) | |
bc8ea543 | 287 | ;; Delete the text in the rectangle, and following whitespace. |
a2535589 JA |
288 | (delete-region (point) |
289 | (progn (goto-char startpos) | |
290 | (skip-chars-backward " \t") | |
291 | (point))) | |
bc8ea543 | 292 | ;; Reindent out to same column that we were at. |
a2535589 JA |
293 | (indent-to column))) |
294 | ||
08ce70d1 | 295 | (provide 'rect) |
6594deb0 ER |
296 | |
297 | ;;; rect.el ends here |