Commit | Line | Data |
---|---|---|
e8af40ee | 1 | ;;; rect.el --- rectangle functions for GNU Emacs |
6594deb0 | 2 | |
73b0cd50 | 3 | ;; Copyright (C) 1985, 1999-2011 Free Software Foundation, Inc. |
9750e079 | 4 | |
aa01bed1 | 5 | ;; Maintainer: Didier Verna <didier@xemacs.org> |
d7b4d18f | 6 | ;; Keywords: internal |
bd78fa1d | 7 | ;; Package: emacs |
4821e2af | 8 | |
a2535589 JA |
9 | ;; This file is part of GNU Emacs. |
10 | ||
eb3fa2cf | 11 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
a2535589 | 12 | ;; it under the terms of the GNU General Public License as published by |
eb3fa2cf GM |
13 | ;; the Free Software Foundation, either version 3 of the License, or |
14 | ;; (at your option) any later version. | |
a2535589 JA |
15 | |
16 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 | ;; GNU General Public License for more details. | |
20 | ||
21 | ;; You should have received a copy of the GNU General Public License | |
eb3fa2cf | 22 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
a2535589 | 23 | |
edbd2f74 ER |
24 | ;;; Commentary: |
25 | ||
e037c34c | 26 | ;; This package provides the operations on rectangles that are documented |
edbd2f74 ER |
27 | ;; in the Emacs manual. |
28 | ||
5614fd56 CY |
29 | ;; ### NOTE: this file was almost completely rewritten by Didier Verna |
30 | ;; <didier@xemacs.org> in July 1999. | |
e417c66f | 31 | |
8daffab7 JL |
32 | ;;; Global key bindings |
33 | ||
34 | ;;;###autoload (define-key ctl-x-r-map "c" 'clear-rectangle) | |
35 | ;;;###autoload (define-key ctl-x-r-map "k" 'kill-rectangle) | |
36 | ;;;###autoload (define-key ctl-x-r-map "d" 'delete-rectangle) | |
37 | ;;;###autoload (define-key ctl-x-r-map "y" 'yank-rectangle) | |
38 | ;;;###autoload (define-key ctl-x-r-map "o" 'open-rectangle) | |
39 | ;;;###autoload (define-key ctl-x-r-map "t" 'string-rectangle) | |
99f053cf | 40 | ;;;###autoload (define-key ctl-x-r-map "N" 'rectangle-number-lines) |
e417c66f | 41 | |
4821e2af | 42 | ;;; Code: |
a2535589 | 43 | |
5614fd56 | 44 | ;; FIXME: this function should be replaced by `apply-on-rectangle' |
a2535589 JA |
45 | (defun operate-on-rectangle (function start end coerce-tabs) |
46 | "Call FUNCTION for each line of rectangle with corners at START, END. | |
47 | If COERCE-TABS is non-nil, convert multi-column characters | |
48 | that span the starting or ending columns on any line | |
49 | to multiple spaces before calling FUNCTION. | |
50 | FUNCTION is called with three arguments: | |
51 | position of start of segment of this line within the rectangle, | |
52 | number of columns that belong to rectangle but are before that position, | |
53 | number of columns that belong to rectangle but are after point. | |
54 | Point is at the end of the segment of this line within the rectangle." | |
55 | (let (startcol startlinepos endcol endlinepos) | |
56 | (save-excursion | |
57 | (goto-char start) | |
58 | (setq startcol (current-column)) | |
59 | (beginning-of-line) | |
60 | (setq startlinepos (point))) | |
61 | (save-excursion | |
62 | (goto-char end) | |
63 | (setq endcol (current-column)) | |
64 | (forward-line 1) | |
65 | (setq endlinepos (point-marker))) | |
66 | (if (< endcol startcol) | |
08ce70d1 | 67 | (setq startcol (prog1 endcol (setq endcol startcol)))) |
bc8ea543 RS |
68 | (save-excursion |
69 | (goto-char startlinepos) | |
70 | (while (< (point) endlinepos) | |
71 | (let (startpos begextra endextra) | |
e40261d0 | 72 | (if coerce-tabs |
b9e81d0a | 73 | (move-to-column startcol t) |
e40261d0 | 74 | (move-to-column startcol)) |
bc8ea543 RS |
75 | (setq begextra (- (current-column) startcol)) |
76 | (setq startpos (point)) | |
e40261d0 | 77 | (if coerce-tabs |
b9e81d0a | 78 | (move-to-column endcol t) |
e40261d0 | 79 | (move-to-column endcol)) |
daabd795 RS |
80 | ;; If we overshot, move back one character |
81 | ;; so that endextra will be positive. | |
82 | (if (and (not coerce-tabs) (> (current-column) endcol)) | |
83 | (backward-char 1)) | |
bc8ea543 RS |
84 | (setq endextra (- endcol (current-column))) |
85 | (if (< begextra 0) | |
86 | (setq endextra (+ endextra begextra) | |
87 | begextra 0)) | |
88 | (funcall function startpos begextra endextra)) | |
89 | (forward-line 1))) | |
a2535589 JA |
90 | (- endcol startcol))) |
91 | ||
e417c66f RS |
92 | (defun apply-on-rectangle (function start end &rest args) |
93 | "Call FUNCTION for each line of rectangle with corners at START, END. | |
94 | FUNCTION is called with two arguments: the start and end columns of the | |
e037c34c | 95 | rectangle, plus ARGS extra arguments. Point is at the beginning of line when |
e417c66f RS |
96 | the function is called." |
97 | (let (startcol startpt endcol endpt) | |
98 | (save-excursion | |
99 | (goto-char start) | |
100 | (setq startcol (current-column)) | |
101 | (beginning-of-line) | |
102 | (setq startpt (point)) | |
103 | (goto-char end) | |
104 | (setq endcol (current-column)) | |
105 | (forward-line 1) | |
106 | (setq endpt (point-marker)) | |
107 | ;; ensure the start column is the left one. | |
108 | (if (< endcol startcol) | |
109 | (let ((col startcol)) | |
110 | (setq startcol endcol endcol col))) | |
111 | ;; start looping over lines | |
112 | (goto-char startpt) | |
113 | (while (< (point) endpt) | |
114 | (apply function startcol endcol args) | |
115 | (forward-line 1))) | |
116 | )) | |
117 | ||
118 | (defun delete-rectangle-line (startcol endcol fill) | |
b29b5c24 | 119 | (when (= (move-to-column startcol (if fill t 'coerce)) startcol) |
b9e81d0a SM |
120 | (delete-region (point) |
121 | (progn (move-to-column endcol 'coerce) | |
122 | (point))))) | |
e417c66f RS |
123 | |
124 | (defun delete-extract-rectangle-line (startcol endcol lines fill) | |
125 | (let ((pt (point-at-eol))) | |
b29b5c24 | 126 | (if (< (move-to-column startcol (if fill t 'coerce)) startcol) |
e417c66f RS |
127 | (setcdr lines (cons (spaces-string (- endcol startcol)) |
128 | (cdr lines))) | |
129 | ;; else | |
130 | (setq pt (point)) | |
b9e81d0a | 131 | (move-to-column endcol t) |
5c831ccd | 132 | (setcdr lines (cons (filter-buffer-substring pt (point) t) (cdr lines)))) |
e417c66f RS |
133 | )) |
134 | ||
5614fd56 CY |
135 | ;; This is actually the only function that needs to do complicated |
136 | ;; stuff like what's happening in `operate-on-rectangle', because the | |
137 | ;; buffer might be read-only. | |
e417c66f RS |
138 | (defun extract-rectangle-line (startcol endcol lines) |
139 | (let (start end begextra endextra line) | |
140 | (move-to-column startcol) | |
141 | (setq start (point) | |
142 | begextra (- (current-column) startcol)) | |
143 | (move-to-column endcol) | |
144 | (setq end (point) | |
145 | endextra (- endcol (current-column))) | |
146 | (setq line (buffer-substring start (point))) | |
147 | (if (< begextra 0) | |
148 | (setq endextra (+ endextra begextra) | |
149 | begextra 0)) | |
150 | (if (< endextra 0) | |
151 | (setq endextra 0)) | |
152 | (goto-char start) | |
a2535589 JA |
153 | (while (search-forward "\t" end t) |
154 | (let ((width (- (current-column) | |
155 | (save-excursion (forward-char -1) | |
156 | (current-column))))) | |
157 | (setq line (concat (substring line 0 (- (point) end 1)) | |
158 | (spaces-string width) | |
e417c66f RS |
159 | (substring line (+ (length line) |
160 | (- (point) end))))))) | |
a2535589 JA |
161 | (if (or (> begextra 0) (> endextra 0)) |
162 | (setq line (concat (spaces-string begextra) | |
163 | line | |
164 | (spaces-string endextra)))) | |
e417c66f | 165 | (setcdr lines (cons line (cdr lines))))) |
a2535589 JA |
166 | |
167 | (defconst spaces-strings | |
168 | '["" " " " " " " " " " " " " " " " "]) | |
169 | ||
170 | (defun spaces-string (n) | |
6cda144f | 171 | "Return a string with N spaces." |
a2535589 | 172 | (if (<= n 8) (aref spaces-strings n) |
6cda144f | 173 | (make-string n ?\s))) |
f1180544 | 174 | |
f9f9507e | 175 | ;;;###autoload |
e417c66f | 176 | (defun delete-rectangle (start end &optional fill) |
e037c34c DL |
177 | "Delete (don't save) text in the region-rectangle. |
178 | The same range of columns is deleted in each line starting with the | |
179 | line where the region begins and ending with the line where the region | |
180 | ends. | |
181 | ||
182 | When called from a program the rectangle's corners are START and END. | |
183 | With a prefix (or a FILL) argument, also fill lines where nothing has | |
184 | to be deleted." | |
185 | (interactive "*r\nP") | |
e417c66f | 186 | (apply-on-rectangle 'delete-rectangle-line start end fill)) |
a2535589 | 187 | |
f9f9507e | 188 | ;;;###autoload |
e417c66f | 189 | (defun delete-extract-rectangle (start end &optional fill) |
7db6139a | 190 | "Delete the contents of the rectangle with corners at START and END. |
e037c34c | 191 | Return it as a list of strings, one for each line of the rectangle. |
e417c66f | 192 | |
e037c34c | 193 | When called from a program the rectangle's corners are START and END. |
e417c66f RS |
194 | With an optional FILL argument, also fill lines where nothing has to be |
195 | deleted." | |
196 | (let ((lines (list nil))) | |
197 | (apply-on-rectangle 'delete-extract-rectangle-line start end lines fill) | |
198 | (nreverse (cdr lines)))) | |
a2535589 | 199 | |
f9f9507e | 200 | ;;;###autoload |
a2535589 | 201 | (defun extract-rectangle (start end) |
e037c34c DL |
202 | "Return the contents of the rectangle with corners at START and END. |
203 | Return it as a list of strings, one for each line of the rectangle." | |
e417c66f RS |
204 | (let ((lines (list nil))) |
205 | (apply-on-rectangle 'extract-rectangle-line start end lines) | |
206 | (nreverse (cdr lines)))) | |
a2535589 JA |
207 | |
208 | (defvar killed-rectangle nil | |
e037c34c | 209 | "Rectangle for `yank-rectangle' to insert.") |
a2535589 | 210 | |
f9f9507e | 211 | ;;;###autoload |
e417c66f | 212 | (defun kill-rectangle (start end &optional fill) |
e037c34c DL |
213 | "Delete the region-rectangle and save it as the last killed one. |
214 | ||
215 | When called from a program the rectangle's corners are START and END. | |
216 | You might prefer to use `delete-extract-rectangle' from a program. | |
e417c66f RS |
217 | |
218 | With a prefix (or a FILL) argument, also fill lines where nothing has to be | |
5c831ccd EZ |
219 | deleted. |
220 | ||
221 | If the buffer is read-only, Emacs will beep and refrain from deleting | |
222 | the rectangle, but put it in the kill ring anyway. This means that | |
223 | you can use this command to copy text from a read-only buffer. | |
224 | \(If the variable `kill-read-only-ok' is non-nil, then this won't | |
225 | even beep.)" | |
226 | (interactive "r\nP") | |
227 | (condition-case nil | |
228 | (setq killed-rectangle (delete-extract-rectangle start end fill)) | |
229 | ((buffer-read-only text-read-only) | |
230 | (setq killed-rectangle (extract-rectangle start end)) | |
231 | (if kill-read-only-ok | |
232 | (progn (message "Read only text copied to kill ring") nil) | |
233 | (barf-if-buffer-read-only) | |
234 | (signal 'text-read-only (list (current-buffer))))))) | |
e417c66f | 235 | |
f9f9507e | 236 | ;;;###autoload |
a2535589 JA |
237 | (defun yank-rectangle () |
238 | "Yank the last killed rectangle with upper left corner at point." | |
e037c34c | 239 | (interactive "*") |
a2535589 JA |
240 | (insert-rectangle killed-rectangle)) |
241 | ||
f9f9507e | 242 | ;;;###autoload |
a2535589 JA |
243 | (defun insert-rectangle (rectangle) |
244 | "Insert text of RECTANGLE with upper left corner at point. | |
573f9b32 RS |
245 | RECTANGLE's first line is inserted at point, its second |
246 | line is inserted at a point vertically under point, etc. | |
23317eac RS |
247 | RECTANGLE should be a list of strings. |
248 | After this command, the mark is at the upper left corner | |
249 | and point is at the lower right corner." | |
a2535589 JA |
250 | (let ((lines rectangle) |
251 | (insertcolumn (current-column)) | |
252 | (first t)) | |
23317eac | 253 | (push-mark) |
a2535589 JA |
254 | (while lines |
255 | (or first | |
256 | (progn | |
257 | (forward-line 1) | |
258 | (or (bolp) (insert ?\n)) | |
b9e81d0a | 259 | (move-to-column insertcolumn t))) |
a2535589 | 260 | (setq first nil) |
afa0467f | 261 | (insert-for-yank (car lines)) |
a2535589 JA |
262 | (setq lines (cdr lines))))) |
263 | ||
f9f9507e | 264 | ;;;###autoload |
e417c66f | 265 | (defun open-rectangle (start end &optional fill) |
e037c34c DL |
266 | "Blank out the region-rectangle, shifting text right. |
267 | ||
268 | The text previously in the region is not overwritten by the blanks, | |
269 | but instead winds up to the right of the rectangle. | |
e417c66f | 270 | |
e037c34c | 271 | When called from a program the rectangle's corners are START and END. |
6cda144f JB |
272 | With a prefix (or a FILL) argument, fill with blanks even if there is |
273 | no text on the right side of the rectangle." | |
e037c34c | 274 | (interactive "*r\nP") |
e417c66f | 275 | (apply-on-rectangle 'open-rectangle-line start end fill) |
08ce70d1 | 276 | (goto-char start)) |
a2535589 | 277 | |
e417c66f | 278 | (defun open-rectangle-line (startcol endcol fill) |
b29b5c24 | 279 | (when (= (move-to-column startcol (if fill t 'coerce)) startcol) |
74be0ade DL |
280 | (unless (and (not fill) |
281 | (= (point) (point-at-eol))) | |
282 | (indent-to endcol)))) | |
e417c66f RS |
283 | |
284 | (defun delete-whitespace-rectangle-line (startcol endcol fill) | |
b29b5c24 | 285 | (when (= (move-to-column startcol (if fill t 'coerce)) startcol) |
e417c66f | 286 | (unless (= (point) (point-at-eol)) |
35f901fa | 287 | (delete-region (point) (progn (skip-syntax-forward " ") (point)))))) |
a2535589 | 288 | |
b3a4edce MR |
289 | ;;;###autoload |
290 | (defalias 'close-rectangle 'delete-whitespace-rectangle) ;; Old name | |
291 | ||
ecb079ed | 292 | ;;;###autoload |
e417c66f | 293 | (defun delete-whitespace-rectangle (start end &optional fill) |
ecb079ed RS |
294 | "Delete all whitespace following a specified column in each line. |
295 | The left edge of the rectangle specifies the position in each line | |
296 | at which whitespace deletion should begin. On each line in the | |
e417c66f | 297 | rectangle, all continuous whitespace starting at that column is deleted. |
ecb079ed | 298 | |
e037c34c | 299 | When called from a program the rectangle's corners are START and END. |
e417c66f | 300 | With a prefix (or a FILL) argument, also fill too short lines." |
e037c34c | 301 | (interactive "*r\nP") |
e417c66f RS |
302 | (apply-on-rectangle 'delete-whitespace-rectangle-line start end fill)) |
303 | ||
b9e81d0a | 304 | (defvar string-rectangle-history nil) |
197615f3 | 305 | (defun string-rectangle-line (startcol endcol string delete) |
b9e81d0a | 306 | (move-to-column startcol t) |
197615f3 DL |
307 | (if delete |
308 | (delete-rectangle-line startcol endcol nil)) | |
e417c66f | 309 | (insert string)) |
131ca136 | 310 | |
852eeeaf | 311 | ;;;###autoload |
35f901fa GM |
312 | (defun string-rectangle (start end string) |
313 | "Replace rectangle contents with STRING on each line. | |
314 | The length of STRING need not be the same as the rectangle width. | |
315 | ||
316 | Called from a program, takes three args; START, END and STRING." | |
b9e81d0a SM |
317 | (interactive |
318 | (progn (barf-if-buffer-read-only) | |
319 | (list | |
320 | (region-beginning) | |
321 | (region-end) | |
5b76833f | 322 | (read-string (format "String rectangle (default %s): " |
b9e81d0a SM |
323 | (or (car string-rectangle-history) "")) |
324 | nil 'string-rectangle-history | |
325 | (car string-rectangle-history))))) | |
197615f3 | 326 | (apply-on-rectangle 'string-rectangle-line start end string t)) |
852eeeaf | 327 | |
0c54cd99 | 328 | ;;;###autoload |
35f901fa GM |
329 | (defalias 'replace-rectangle 'string-rectangle) |
330 | ||
331 | ;;;###autoload | |
332 | (defun string-insert-rectangle (start end string) | |
333 | "Insert STRING on each line of region-rectangle, shifting text right. | |
334 | ||
335 | When called from a program, the rectangle's corners are START and END. | |
336 | The left edge of the rectangle specifies the column for insertion. | |
337 | This command does not delete or overwrite any existing text." | |
b9e81d0a SM |
338 | (interactive |
339 | (progn (barf-if-buffer-read-only) | |
340 | (list | |
341 | (region-beginning) | |
342 | (region-end) | |
5b76833f | 343 | (read-string (format "String insert rectangle (default %s): " |
b9e81d0a SM |
344 | (or (car string-rectangle-history) "")) |
345 | nil 'string-rectangle-history | |
346 | (car string-rectangle-history))))) | |
35f901fa GM |
347 | (apply-on-rectangle 'string-rectangle-line start end string nil)) |
348 | ||
f9f9507e | 349 | ;;;###autoload |
e417c66f | 350 | (defun clear-rectangle (start end &optional fill) |
e037c34c DL |
351 | "Blank out the region-rectangle. |
352 | The text previously in the region is overwritten with blanks. | |
e417c66f | 353 | |
e037c34c | 354 | When called from a program the rectangle's corners are START and END. |
e417c66f RS |
355 | With a prefix (or a FILL) argument, also fill with blanks the parts of the |
356 | rectangle which were empty." | |
e037c34c | 357 | (interactive "*r\nP") |
e417c66f RS |
358 | (apply-on-rectangle 'clear-rectangle-line start end fill)) |
359 | ||
360 | (defun clear-rectangle-line (startcol endcol fill) | |
7dfee029 | 361 | (let ((pt (point-at-eol))) |
b29b5c24 | 362 | (when (= (move-to-column startcol (if fill t 'coerce)) startcol) |
e417c66f RS |
363 | (if (and (not fill) |
364 | (<= (save-excursion (goto-char pt) (current-column)) endcol)) | |
365 | (delete-region (point) pt) | |
366 | ;; else | |
367 | (setq pt (point)) | |
b9e81d0a | 368 | (move-to-column endcol t) |
7dfee029 | 369 | (setq endcol (current-column)) |
e417c66f | 370 | (delete-region pt (point)) |
7dfee029 | 371 | (indent-to endcol))))) |
a2535589 | 372 | |
99f053cf JA |
373 | ;; Line numbers for `rectangle-number-line-callback'. |
374 | (defvar rectangle-number-line-counter) | |
375 | ||
376 | (defun rectangle-number-line-callback (start end format-string) | |
377 | (move-to-column start t) | |
378 | (insert (format format-string rectangle-number-line-counter)) | |
379 | (setq rectangle-number-line-counter | |
380 | (1+ rectangle-number-line-counter))) | |
381 | ||
382 | (defun rectange--default-line-number-format (start end start-at) | |
383 | (concat "%" | |
384 | (int-to-string (length (int-to-string (+ (count-lines start end) | |
385 | start-at)))) | |
386 | "d ")) | |
387 | ||
388 | ;;;###autoload | |
389 | (defun rectangle-number-lines (start end start-at &optional format) | |
390 | "Insert numbers in front of the region-rectangle. | |
391 | ||
392 | START-AT, if non-nil, should be a number from which to begin | |
393 | counting. FORMAT, if non-nil, should be a format string to pass | |
394 | to `format' along with the line count. When called interactively | |
395 | with a prefix argument, prompt for START-AT and FORMAT." | |
396 | (interactive | |
397 | (if current-prefix-arg | |
398 | (let* ((start (region-beginning)) | |
399 | (end (region-end)) | |
400 | (start-at (read-number "Number to count from: " 1))) | |
401 | (list start end start-at | |
402 | (read-string "Format string: " | |
403 | (rectange--default-line-number-format | |
404 | start end start-at)))) | |
405 | (list (region-beginning) (region-end) 1 nil))) | |
406 | (unless format | |
407 | (setq format (rectange--default-line-number-format start end start-at))) | |
408 | (let ((rectangle-number-line-counter start-at)) | |
409 | (apply-on-rectangle 'rectangle-number-line-callback | |
410 | start end format))) | |
411 | ||
08ce70d1 | 412 | (provide 'rect) |
6594deb0 ER |
413 | |
414 | ;;; rect.el ends here |