Mercurial > emacs
annotate lisp/rect.el @ 24008:1d70b06238e8
(prefer-coding-system): Call set-coding-priority, so that the internal
array of priorities is also updated.
author | Eli Zaretskii <eliz@gnu.org> |
---|---|
date | Wed, 06 Jan 1999 10:32:34 +0000 |
parents | baf00f643ccf |
children | 0fbd51325497 |
rev | line source |
---|---|
659
505130d1ddf8
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
258
diff
changeset
|
1 ;;; rect.el --- rectangle functions for GNU Emacs. |
505130d1ddf8
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
258
diff
changeset
|
2 |
7298 | 3 ;; Copyright (C) 1985, 1994 Free Software Foundation, Inc. |
845 | 4 |
789
71d052f72ac1
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
659
diff
changeset
|
5 ;; Maintainer: FSF |
814
38b2499cb3e9
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
807
diff
changeset
|
6 ;; Keywords: internal |
789
71d052f72ac1
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
659
diff
changeset
|
7 |
36 | 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 | |
807
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
789
diff
changeset
|
12 ;; the Free Software Foundation; either version 2, or (at your option) |
36 | 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 | |
14169 | 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. | |
36 | 24 |
2308
f287613dfc28
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
1619
diff
changeset
|
25 ;;; Commentary: |
f287613dfc28
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
1619
diff
changeset
|
26 |
f287613dfc28
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
1619
diff
changeset
|
27 ;; This package provides the operations on rectangles that are ocumented |
f287613dfc28
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
1619
diff
changeset
|
28 ;; in the Emacs manual. |
f287613dfc28
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
1619
diff
changeset
|
29 |
789
71d052f72ac1
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
659
diff
changeset
|
30 ;;; Code: |
36 | 31 |
23757
717a33da04a1
(move-to-column-force): New function.
Kenichi Handa <handa@m17n.org>
parents:
23641
diff
changeset
|
32 ;;;###autoload |
717a33da04a1
(move-to-column-force): New function.
Kenichi Handa <handa@m17n.org>
parents:
23641
diff
changeset
|
33 (defun move-to-column-force (column) |
717a33da04a1
(move-to-column-force): New function.
Kenichi Handa <handa@m17n.org>
parents:
23641
diff
changeset
|
34 "Move point to column COLUMN rigidly in the current line. |
717a33da04a1
(move-to-column-force): New function.
Kenichi Handa <handa@m17n.org>
parents:
23641
diff
changeset
|
35 If COLUMN is within a multi-column character, replace it by |
717a33da04a1
(move-to-column-force): New function.
Kenichi Handa <handa@m17n.org>
parents:
23641
diff
changeset
|
36 spaces and tab." |
717a33da04a1
(move-to-column-force): New function.
Kenichi Handa <handa@m17n.org>
parents:
23641
diff
changeset
|
37 (let ((col (move-to-column column t))) |
717a33da04a1
(move-to-column-force): New function.
Kenichi Handa <handa@m17n.org>
parents:
23641
diff
changeset
|
38 (if (> col column) |
717a33da04a1
(move-to-column-force): New function.
Kenichi Handa <handa@m17n.org>
parents:
23641
diff
changeset
|
39 (let (pos) |
717a33da04a1
(move-to-column-force): New function.
Kenichi Handa <handa@m17n.org>
parents:
23641
diff
changeset
|
40 (delete-char -1) |
717a33da04a1
(move-to-column-force): New function.
Kenichi Handa <handa@m17n.org>
parents:
23641
diff
changeset
|
41 (insert-char ? (- column (current-column))) |
717a33da04a1
(move-to-column-force): New function.
Kenichi Handa <handa@m17n.org>
parents:
23641
diff
changeset
|
42 (setq pos (point)) |
717a33da04a1
(move-to-column-force): New function.
Kenichi Handa <handa@m17n.org>
parents:
23641
diff
changeset
|
43 (indent-to col) |
717a33da04a1
(move-to-column-force): New function.
Kenichi Handa <handa@m17n.org>
parents:
23641
diff
changeset
|
44 (goto-char pos))) |
717a33da04a1
(move-to-column-force): New function.
Kenichi Handa <handa@m17n.org>
parents:
23641
diff
changeset
|
45 column)) |
717a33da04a1
(move-to-column-force): New function.
Kenichi Handa <handa@m17n.org>
parents:
23641
diff
changeset
|
46 |
22213
84c3c863f0bd
(string-rectangle-string): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
22205
diff
changeset
|
47 ;; extract-rectangle-line stores lines into this list |
84c3c863f0bd
(string-rectangle-string): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
22205
diff
changeset
|
48 ;; to accumulate them for extract-rectangle and delete-extract-rectangle. |
84c3c863f0bd
(string-rectangle-string): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
22205
diff
changeset
|
49 (defvar operate-on-rectangle-lines) |
84c3c863f0bd
(string-rectangle-string): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
22205
diff
changeset
|
50 |
36 | 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) | |
1619
6147d2164331
* rect.el (operate-on-rectangle): Use move-to-column's FORCE
Jim Blandy <jimb@redhat.com>
parents:
1542
diff
changeset
|
73 (setq startcol (prog1 endcol (setq endcol startcol)))) |
5787
bef3a67ac893
(string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents:
2637
diff
changeset
|
74 (save-excursion |
bef3a67ac893
(string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents:
2637
diff
changeset
|
75 (goto-char startlinepos) |
bef3a67ac893
(string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents:
2637
diff
changeset
|
76 (while (< (point) endlinepos) |
bef3a67ac893
(string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents:
2637
diff
changeset
|
77 (let (startpos begextra endextra) |
23757
717a33da04a1
(move-to-column-force): New function.
Kenichi Handa <handa@m17n.org>
parents:
23641
diff
changeset
|
78 (if coerce-tabs |
717a33da04a1
(move-to-column-force): New function.
Kenichi Handa <handa@m17n.org>
parents:
23641
diff
changeset
|
79 (move-to-column-force startcol) |
717a33da04a1
(move-to-column-force): New function.
Kenichi Handa <handa@m17n.org>
parents:
23641
diff
changeset
|
80 (move-to-column startcol)) |
5787
bef3a67ac893
(string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents:
2637
diff
changeset
|
81 (setq begextra (- (current-column) startcol)) |
bef3a67ac893
(string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents:
2637
diff
changeset
|
82 (setq startpos (point)) |
23757
717a33da04a1
(move-to-column-force): New function.
Kenichi Handa <handa@m17n.org>
parents:
23641
diff
changeset
|
83 (if coerce-tabs |
717a33da04a1
(move-to-column-force): New function.
Kenichi Handa <handa@m17n.org>
parents:
23641
diff
changeset
|
84 (move-to-column-force endcol) |
717a33da04a1
(move-to-column-force): New function.
Kenichi Handa <handa@m17n.org>
parents:
23641
diff
changeset
|
85 (move-to-column endcol)) |
19732
d8478556c7f0
(operate-on-rectangle): If we overshoot when looking for endcol, back up.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
86 ;; If we overshot, move back one character |
d8478556c7f0
(operate-on-rectangle): If we overshoot when looking for endcol, back up.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
87 ;; so that endextra will be positive. |
d8478556c7f0
(operate-on-rectangle): If we overshoot when looking for endcol, back up.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
88 (if (and (not coerce-tabs) (> (current-column) endcol)) |
d8478556c7f0
(operate-on-rectangle): If we overshoot when looking for endcol, back up.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
89 (backward-char 1)) |
5787
bef3a67ac893
(string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents:
2637
diff
changeset
|
90 (setq endextra (- endcol (current-column))) |
bef3a67ac893
(string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents:
2637
diff
changeset
|
91 (if (< begextra 0) |
bef3a67ac893
(string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents:
2637
diff
changeset
|
92 (setq endextra (+ endextra begextra) |
bef3a67ac893
(string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents:
2637
diff
changeset
|
93 begextra 0)) |
bef3a67ac893
(string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents:
2637
diff
changeset
|
94 (funcall function startpos begextra endextra)) |
bef3a67ac893
(string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents:
2637
diff
changeset
|
95 (forward-line 1))) |
36 | 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)))) | |
22213
84c3c863f0bd
(string-rectangle-string): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
22205
diff
changeset
|
121 (setq operate-on-rectangle-lines (cons line operate-on-rectangle-lines)))) |
36 | 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 | |
258 | 134 ;;;###autoload |
36 | 135 (defun delete-rectangle (start end) |
136 "Delete (don't save) text in rectangle with point and mark as corners. | |
242 | 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." | |
36 | 139 (interactive "r") |
140 (operate-on-rectangle 'delete-rectangle-line start end t)) | |
141 | |
258 | 142 ;;;###autoload |
36 | 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." | |
22213
84c3c863f0bd
(string-rectangle-string): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
22205
diff
changeset
|
147 (let (operate-on-rectangle-lines) |
36 | 148 (operate-on-rectangle 'delete-extract-rectangle-line |
149 start end t) | |
22213
84c3c863f0bd
(string-rectangle-string): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
22205
diff
changeset
|
150 (nreverse operate-on-rectangle-lines))) |
36 | 151 |
258 | 152 ;;;###autoload |
36 | 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." | |
22213
84c3c863f0bd
(string-rectangle-string): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
22205
diff
changeset
|
156 (let (operate-on-rectangle-lines) |
36 | 157 (operate-on-rectangle 'extract-rectangle-line start end nil) |
22213
84c3c863f0bd
(string-rectangle-string): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
22205
diff
changeset
|
158 (nreverse operate-on-rectangle-lines))) |
36 | 159 |
160 (defvar killed-rectangle nil | |
161 "Rectangle for yank-rectangle to insert.") | |
162 | |
258 | 163 ;;;###autoload |
36 | 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. | |
242 | 167 But in programs you might prefer to use `delete-extract-rectangle'." |
36 | 168 (interactive "r") |
9242
493c74aab5a0
(kill-rectangle): In read-only buffer, do record
Richard M. Stallman <rms@gnu.org>
parents:
7298
diff
changeset
|
169 (if buffer-read-only |
493c74aab5a0
(kill-rectangle): In read-only buffer, do record
Richard M. Stallman <rms@gnu.org>
parents:
7298
diff
changeset
|
170 (progn |
493c74aab5a0
(kill-rectangle): In read-only buffer, do record
Richard M. Stallman <rms@gnu.org>
parents:
7298
diff
changeset
|
171 (setq killed-rectangle (extract-rectangle start end)) |
493c74aab5a0
(kill-rectangle): In read-only buffer, do record
Richard M. Stallman <rms@gnu.org>
parents:
7298
diff
changeset
|
172 (barf-if-buffer-read-only))) |
36 | 173 (setq killed-rectangle (delete-extract-rectangle start end))) |
174 | |
258 | 175 ;;;###autoload |
36 | 176 (defun yank-rectangle () |
177 "Yank the last killed rectangle with upper left corner at point." | |
178 (interactive) | |
179 (insert-rectangle killed-rectangle)) | |
180 | |
258 | 181 ;;;###autoload |
36 | 182 (defun insert-rectangle (rectangle) |
183 "Insert text of RECTANGLE with upper left corner at point. | |
242 | 184 RECTANGLE's first line is inserted at point, its second |
185 line is inserted at a point vertically under point, etc. | |
1542
724b443e445d
(insert-rectangle): Put mark at upper left corner.
Richard M. Stallman <rms@gnu.org>
parents:
845
diff
changeset
|
186 RECTANGLE should be a list of strings. |
724b443e445d
(insert-rectangle): Put mark at upper left corner.
Richard M. Stallman <rms@gnu.org>
parents:
845
diff
changeset
|
187 After this command, the mark is at the upper left corner |
724b443e445d
(insert-rectangle): Put mark at upper left corner.
Richard M. Stallman <rms@gnu.org>
parents:
845
diff
changeset
|
188 and point is at the lower right corner." |
36 | 189 (let ((lines rectangle) |
190 (insertcolumn (current-column)) | |
191 (first t)) | |
1542
724b443e445d
(insert-rectangle): Put mark at upper left corner.
Richard M. Stallman <rms@gnu.org>
parents:
845
diff
changeset
|
192 (push-mark) |
36 | 193 (while lines |
194 (or first | |
195 (progn | |
196 (forward-line 1) | |
197 (or (bolp) (insert ?\n)) | |
23757
717a33da04a1
(move-to-column-force): New function.
Kenichi Handa <handa@m17n.org>
parents:
23641
diff
changeset
|
198 (move-to-column-force insertcolumn))) |
36 | 199 (setq first nil) |
200 (insert (car lines)) | |
201 (setq lines (cdr lines))))) | |
202 | |
258 | 203 ;;;###autoload |
36 | 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, | |
1619
6147d2164331
* rect.el (operate-on-rectangle): Use move-to-column's FORCE
Jim Blandy <jimb@redhat.com>
parents:
1542
diff
changeset
|
207 but instead winds up to the right of the rectangle." |
36 | 208 (interactive "r") |
1619
6147d2164331
* rect.el (operate-on-rectangle): Use move-to-column's FORCE
Jim Blandy <jimb@redhat.com>
parents:
1542
diff
changeset
|
209 (operate-on-rectangle 'open-rectangle-line start end nil) |
6147d2164331
* rect.el (operate-on-rectangle): Use move-to-column's FORCE
Jim Blandy <jimb@redhat.com>
parents:
1542
diff
changeset
|
210 (goto-char start)) |
36 | 211 |
212 (defun open-rectangle-line (startpos begextra endextra) | |
5787
bef3a67ac893
(string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents:
2637
diff
changeset
|
213 ;; Column where rectangle ends. |
bef3a67ac893
(string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents:
2637
diff
changeset
|
214 (let ((endcol (+ (current-column) endextra)) |
bef3a67ac893
(string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents:
2637
diff
changeset
|
215 whitewidth) |
36 | 216 (goto-char startpos) |
5787
bef3a67ac893
(string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents:
2637
diff
changeset
|
217 ;; Column where rectangle begins. |
bef3a67ac893
(string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents:
2637
diff
changeset
|
218 (let ((begcol (- (current-column) begextra))) |
23757
717a33da04a1
(move-to-column-force): New function.
Kenichi Handa <handa@m17n.org>
parents:
23641
diff
changeset
|
219 (if (> begextra 0) |
717a33da04a1
(move-to-column-force): New function.
Kenichi Handa <handa@m17n.org>
parents:
23641
diff
changeset
|
220 (move-to-column-force begcol)) |
36 | 221 (skip-chars-forward " \t") |
5787
bef3a67ac893
(string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents:
2637
diff
changeset
|
222 ;; Width of whitespace to be deleted and recreated. |
bef3a67ac893
(string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents:
2637
diff
changeset
|
223 (setq whitewidth (- (current-column) begcol))) |
bef3a67ac893
(string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents:
2637
diff
changeset
|
224 ;; Delete the whitespace following the start column. |
bef3a67ac893
(string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents:
2637
diff
changeset
|
225 (delete-region startpos (point)) |
bef3a67ac893
(string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents:
2637
diff
changeset
|
226 ;; Open the desired width, plus same amount of whitespace we just deleted. |
bef3a67ac893
(string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents:
2637
diff
changeset
|
227 (indent-to (+ endcol whitewidth)))) |
36 | 228 |
23812
baf00f643ccf
(delete-whitespace-rectangle): Mark for autoload.
Andreas Schwab <schwab@suse.de>
parents:
23757
diff
changeset
|
229 ;;;###autoload (defalias 'close-rectangle 'delete-whitespace-rectangle) ;; Old name |
258 | 230 ;;;###autoload |
23641
b13886e06eb2
(delete-whitespace-rectangle): close-rectangle renamed.
Karl Heuer <kwzh@gnu.org>
parents:
22369
diff
changeset
|
231 (defun delete-whitespace-rectangle (start end) |
22205
8576d32229fc
(close-rectangle): New command.
Richard M. Stallman <rms@gnu.org>
parents:
19732
diff
changeset
|
232 "Delete all whitespace following a specified column in each line. |
8576d32229fc
(close-rectangle): New command.
Richard M. Stallman <rms@gnu.org>
parents:
19732
diff
changeset
|
233 The left edge of the rectangle specifies the position in each line |
8576d32229fc
(close-rectangle): New command.
Richard M. Stallman <rms@gnu.org>
parents:
19732
diff
changeset
|
234 at which whitespace deletion should begin. On each line in the |
8576d32229fc
(close-rectangle): New command.
Richard M. Stallman <rms@gnu.org>
parents:
19732
diff
changeset
|
235 rectangle, all continuous whitespace starting at that column is deleted." |
8576d32229fc
(close-rectangle): New command.
Richard M. Stallman <rms@gnu.org>
parents:
19732
diff
changeset
|
236 (interactive "r") |
8576d32229fc
(close-rectangle): New command.
Richard M. Stallman <rms@gnu.org>
parents:
19732
diff
changeset
|
237 (operate-on-rectangle '(lambda (startpos begextra endextra) |
8576d32229fc
(close-rectangle): New command.
Richard M. Stallman <rms@gnu.org>
parents:
19732
diff
changeset
|
238 (save-excursion |
8576d32229fc
(close-rectangle): New command.
Richard M. Stallman <rms@gnu.org>
parents:
19732
diff
changeset
|
239 (goto-char startpos) |
8576d32229fc
(close-rectangle): New command.
Richard M. Stallman <rms@gnu.org>
parents:
19732
diff
changeset
|
240 (delete-region (point) |
8576d32229fc
(close-rectangle): New command.
Richard M. Stallman <rms@gnu.org>
parents:
19732
diff
changeset
|
241 (progn |
8576d32229fc
(close-rectangle): New command.
Richard M. Stallman <rms@gnu.org>
parents:
19732
diff
changeset
|
242 (skip-syntax-forward " ") |
8576d32229fc
(close-rectangle): New command.
Richard M. Stallman <rms@gnu.org>
parents:
19732
diff
changeset
|
243 (point))))) |
8576d32229fc
(close-rectangle): New command.
Richard M. Stallman <rms@gnu.org>
parents:
19732
diff
changeset
|
244 start end t)) |
8576d32229fc
(close-rectangle): New command.
Richard M. Stallman <rms@gnu.org>
parents:
19732
diff
changeset
|
245 |
22213
84c3c863f0bd
(string-rectangle-string): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
22205
diff
changeset
|
246 ;; string-rectangle uses this variable to pass the string |
84c3c863f0bd
(string-rectangle-string): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
22205
diff
changeset
|
247 ;; to string-rectangle-line. |
84c3c863f0bd
(string-rectangle-string): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
22205
diff
changeset
|
248 (defvar string-rectangle-string) |
22205
8576d32229fc
(close-rectangle): New command.
Richard M. Stallman <rms@gnu.org>
parents:
19732
diff
changeset
|
249 |
8576d32229fc
(close-rectangle): New command.
Richard M. Stallman <rms@gnu.org>
parents:
19732
diff
changeset
|
250 ;;;###autoload |
2637
45ecb9b4a6da
(string-rectangle): Renamed from fill-rectangle.
Richard M. Stallman <rms@gnu.org>
parents:
2380
diff
changeset
|
251 (defun string-rectangle (start end string) |
22369
6c4756ecd4a2
(string-rectangle-line): Delete the rectangle first.
Richard M. Stallman <rms@gnu.org>
parents:
22213
diff
changeset
|
252 "Replace rectangle contents with STRING on each line. |
6c4756ecd4a2
(string-rectangle-line): Delete the rectangle first.
Richard M. Stallman <rms@gnu.org>
parents:
22213
diff
changeset
|
253 The length of STRING need not be the same as the rectangle width. |
2637
45ecb9b4a6da
(string-rectangle): Renamed from fill-rectangle.
Richard M. Stallman <rms@gnu.org>
parents:
2380
diff
changeset
|
254 |
45ecb9b4a6da
(string-rectangle): Renamed from fill-rectangle.
Richard M. Stallman <rms@gnu.org>
parents:
2380
diff
changeset
|
255 Called from a program, takes three args; START, END and STRING." |
45ecb9b4a6da
(string-rectangle): Renamed from fill-rectangle.
Richard M. Stallman <rms@gnu.org>
parents:
2380
diff
changeset
|
256 (interactive "r\nsString rectangle: ") |
22213
84c3c863f0bd
(string-rectangle-string): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
22205
diff
changeset
|
257 (let ((string-rectangle-string string)) |
84c3c863f0bd
(string-rectangle-string): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
22205
diff
changeset
|
258 (operate-on-rectangle 'string-rectangle-line start end t))) |
2380
e67f6d2679e3
(fill-rectangle) Added. Inspired by Lynn Slater's insert-box package in LCD,
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2308
diff
changeset
|
259 |
2637
45ecb9b4a6da
(string-rectangle): Renamed from fill-rectangle.
Richard M. Stallman <rms@gnu.org>
parents:
2380
diff
changeset
|
260 (defun string-rectangle-line (startpos begextra endextra) |
5787
bef3a67ac893
(string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents:
2637
diff
changeset
|
261 (let (whitespace) |
22369
6c4756ecd4a2
(string-rectangle-line): Delete the rectangle first.
Richard M. Stallman <rms@gnu.org>
parents:
22213
diff
changeset
|
262 ;; Delete the width of the rectangle. |
6c4756ecd4a2
(string-rectangle-line): Delete the rectangle first.
Richard M. Stallman <rms@gnu.org>
parents:
22213
diff
changeset
|
263 (delete-region startpos (point)) |
5787
bef3a67ac893
(string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents:
2637
diff
changeset
|
264 ;; Compute horizontal width of following whitespace. |
2380
e67f6d2679e3
(fill-rectangle) Added. Inspired by Lynn Slater's insert-box package in LCD,
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2308
diff
changeset
|
265 (let ((ocol (current-column))) |
e67f6d2679e3
(fill-rectangle) Added. Inspired by Lynn Slater's insert-box package in LCD,
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2308
diff
changeset
|
266 (skip-chars-forward " \t") |
5787
bef3a67ac893
(string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents:
2637
diff
changeset
|
267 (setq whitespace (- (current-column) ocol))) |
bef3a67ac893
(string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents:
2637
diff
changeset
|
268 ;; Delete the following whitespace. |
bef3a67ac893
(string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents:
2637
diff
changeset
|
269 (delete-region startpos (point)) |
bef3a67ac893
(string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents:
2637
diff
changeset
|
270 ;; Insert the desired string. |
22213
84c3c863f0bd
(string-rectangle-string): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
22205
diff
changeset
|
271 (insert string-rectangle-string) |
5787
bef3a67ac893
(string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents:
2637
diff
changeset
|
272 ;; Insert the same width of whitespace that we had before. |
bef3a67ac893
(string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents:
2637
diff
changeset
|
273 (indent-to (+ (current-column) whitespace)))) |
2380
e67f6d2679e3
(fill-rectangle) Added. Inspired by Lynn Slater's insert-box package in LCD,
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2308
diff
changeset
|
274 |
e67f6d2679e3
(fill-rectangle) Added. Inspired by Lynn Slater's insert-box package in LCD,
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2308
diff
changeset
|
275 ;;;###autoload |
36 | 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) | |
5787
bef3a67ac893
(string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents:
2637
diff
changeset
|
284 ;; Find end of whitespace after the rectangle. |
36 | 285 (skip-chars-forward " \t") |
286 (let ((column (+ (current-column) endextra))) | |
5787
bef3a67ac893
(string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents:
2637
diff
changeset
|
287 ;; Delete the text in the rectangle, and following whitespace. |
36 | 288 (delete-region (point) |
289 (progn (goto-char startpos) | |
290 (skip-chars-backward " \t") | |
291 (point))) | |
5787
bef3a67ac893
(string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents:
2637
diff
changeset
|
292 ;; Reindent out to same column that we were at. |
36 | 293 (indent-to column))) |
294 | |
1619
6147d2164331
* rect.el (operate-on-rectangle): Use move-to-column's FORCE
Jim Blandy <jimb@redhat.com>
parents:
1542
diff
changeset
|
295 (provide 'rect) |
659
505130d1ddf8
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
258
diff
changeset
|
296 |
505130d1ddf8
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
258
diff
changeset
|
297 ;;; rect.el ends here |