Mercurial > emacs
annotate lisp/rect.el @ 33969:96d72c104f9a raeburn-tag-5-for-export
Add hints to `automatic-hscrolling' to doc strings.
author | Gerd Moellmann <gerd@gnu.org> |
---|---|
date | Tue, 28 Nov 2000 16:50:40 +0000 |
parents | 22ed3ce37a4c |
children | d5ed9aa37aa2 |
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 |
25168
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
3 ;; Copyright (C) 1985, 1999 Free Software Foundation, Inc. |
845 | 4 |
25168
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
5 ;; Maintainer: Didier Verna <verna@inf.enst.fr> |
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 |
25379
167c69238538
Add/fix various doc strings. Add `*' to all the interactive specs.
Dave Love <fx@gnu.org>
parents:
25291
diff
changeset
|
27 ;; This package provides the operations on rectangles that are documented |
2308
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 |
25168
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
30 ;; ### NOTE: this file has been almost completely rewritten by Didier Verna |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
31 ;; <verna@inf.enst.fr> in July 1999. The purpose of this rewrite is to be less |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
32 ;; intrusive and fill lines with whitespaces only when needed. A few functions |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
33 ;; are untouched though, as noted above their definition. |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
34 |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
35 |
789
71d052f72ac1
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
659
diff
changeset
|
36 ;;; Code: |
36 | 37 |
23757
717a33da04a1
(move-to-column-force): New function.
Kenichi Handa <handa@m17n.org>
parents:
23641
diff
changeset
|
38 ;;;###autoload |
25168
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
39 (defun move-to-column-force (column &optional flag) |
23757
717a33da04a1
(move-to-column-force): New function.
Kenichi Handa <handa@m17n.org>
parents:
23641
diff
changeset
|
40 "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
|
41 If COLUMN is within a multi-column character, replace it by |
25168
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
42 spaces and tab. |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
43 |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
44 As for `move-to-column', passing anything but nil or t in FLAG will move to |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
45 the desired column only if the line is long enough." |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
46 (let ((col (move-to-column column (or flag t)))) |
23757
717a33da04a1
(move-to-column-force): New function.
Kenichi Handa <handa@m17n.org>
parents:
23641
diff
changeset
|
47 (if (> col column) |
717a33da04a1
(move-to-column-force): New function.
Kenichi Handa <handa@m17n.org>
parents:
23641
diff
changeset
|
48 (let (pos) |
717a33da04a1
(move-to-column-force): New function.
Kenichi Handa <handa@m17n.org>
parents:
23641
diff
changeset
|
49 (delete-char -1) |
717a33da04a1
(move-to-column-force): New function.
Kenichi Handa <handa@m17n.org>
parents:
23641
diff
changeset
|
50 (insert-char ? (- column (current-column))) |
717a33da04a1
(move-to-column-force): New function.
Kenichi Handa <handa@m17n.org>
parents:
23641
diff
changeset
|
51 (setq pos (point)) |
717a33da04a1
(move-to-column-force): New function.
Kenichi Handa <handa@m17n.org>
parents:
23641
diff
changeset
|
52 (indent-to col) |
717a33da04a1
(move-to-column-force): New function.
Kenichi Handa <handa@m17n.org>
parents:
23641
diff
changeset
|
53 (goto-char pos))) |
717a33da04a1
(move-to-column-force): New function.
Kenichi Handa <handa@m17n.org>
parents:
23641
diff
changeset
|
54 column)) |
717a33da04a1
(move-to-column-force): New function.
Kenichi Handa <handa@m17n.org>
parents:
23641
diff
changeset
|
55 |
25168
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
56 ;; not used any more --dv |
22213
84c3c863f0bd
(string-rectangle-string): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
22205
diff
changeset
|
57 ;; extract-rectangle-line stores lines into this list |
84c3c863f0bd
(string-rectangle-string): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
22205
diff
changeset
|
58 ;; 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
|
59 (defvar operate-on-rectangle-lines) |
84c3c863f0bd
(string-rectangle-string): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
22205
diff
changeset
|
60 |
30283
70a7936c29c5
(open-rectangle-line): Remove unused let.
Dave Love <fx@gnu.org>
parents:
28078
diff
changeset
|
61 ;; ### NOTE: this function is untouched, but not used anymore apart from |
25168
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
62 ;; `delete-whitespace-rectangle'. `apply-on-rectangle' is used instead. --dv |
36 | 63 (defun operate-on-rectangle (function start end coerce-tabs) |
64 "Call FUNCTION for each line of rectangle with corners at START, END. | |
65 If COERCE-TABS is non-nil, convert multi-column characters | |
66 that span the starting or ending columns on any line | |
67 to multiple spaces before calling FUNCTION. | |
68 FUNCTION is called with three arguments: | |
69 position of start of segment of this line within the rectangle, | |
70 number of columns that belong to rectangle but are before that position, | |
71 number of columns that belong to rectangle but are after point. | |
72 Point is at the end of the segment of this line within the rectangle." | |
73 (let (startcol startlinepos endcol endlinepos) | |
74 (save-excursion | |
75 (goto-char start) | |
76 (setq startcol (current-column)) | |
77 (beginning-of-line) | |
78 (setq startlinepos (point))) | |
79 (save-excursion | |
80 (goto-char end) | |
81 (setq endcol (current-column)) | |
82 (forward-line 1) | |
83 (setq endlinepos (point-marker))) | |
84 (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
|
85 (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
|
86 (save-excursion |
bef3a67ac893
(string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents:
2637
diff
changeset
|
87 (goto-char startlinepos) |
bef3a67ac893
(string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents:
2637
diff
changeset
|
88 (while (< (point) endlinepos) |
bef3a67ac893
(string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents:
2637
diff
changeset
|
89 (let (startpos begextra endextra) |
23757
717a33da04a1
(move-to-column-force): New function.
Kenichi Handa <handa@m17n.org>
parents:
23641
diff
changeset
|
90 (if coerce-tabs |
717a33da04a1
(move-to-column-force): New function.
Kenichi Handa <handa@m17n.org>
parents:
23641
diff
changeset
|
91 (move-to-column-force startcol) |
717a33da04a1
(move-to-column-force): New function.
Kenichi Handa <handa@m17n.org>
parents:
23641
diff
changeset
|
92 (move-to-column startcol)) |
5787
bef3a67ac893
(string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents:
2637
diff
changeset
|
93 (setq begextra (- (current-column) startcol)) |
bef3a67ac893
(string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents:
2637
diff
changeset
|
94 (setq startpos (point)) |
23757
717a33da04a1
(move-to-column-force): New function.
Kenichi Handa <handa@m17n.org>
parents:
23641
diff
changeset
|
95 (if coerce-tabs |
717a33da04a1
(move-to-column-force): New function.
Kenichi Handa <handa@m17n.org>
parents:
23641
diff
changeset
|
96 (move-to-column-force endcol) |
717a33da04a1
(move-to-column-force): New function.
Kenichi Handa <handa@m17n.org>
parents:
23641
diff
changeset
|
97 (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
|
98 ;; 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
|
99 ;; 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
|
100 (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
|
101 (backward-char 1)) |
5787
bef3a67ac893
(string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents:
2637
diff
changeset
|
102 (setq endextra (- endcol (current-column))) |
bef3a67ac893
(string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents:
2637
diff
changeset
|
103 (if (< begextra 0) |
bef3a67ac893
(string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents:
2637
diff
changeset
|
104 (setq endextra (+ endextra begextra) |
bef3a67ac893
(string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents:
2637
diff
changeset
|
105 begextra 0)) |
bef3a67ac893
(string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents:
2637
diff
changeset
|
106 (funcall function startpos begextra endextra)) |
bef3a67ac893
(string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents:
2637
diff
changeset
|
107 (forward-line 1))) |
36 | 108 (- endcol startcol))) |
109 | |
25168
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
110 ;; The replacement for `operate-on-rectangle' -- dv |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
111 (defun apply-on-rectangle (function start end &rest args) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
112 "Call FUNCTION for each line of rectangle with corners at START, END. |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
113 FUNCTION is called with two arguments: the start and end columns of the |
25379
167c69238538
Add/fix various doc strings. Add `*' to all the interactive specs.
Dave Love <fx@gnu.org>
parents:
25291
diff
changeset
|
114 rectangle, plus ARGS extra arguments. Point is at the beginning of line when |
25168
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
115 the function is called." |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
116 (let (startcol startpt endcol endpt) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
117 (save-excursion |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
118 (goto-char start) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
119 (setq startcol (current-column)) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
120 (beginning-of-line) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
121 (setq startpt (point)) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
122 (goto-char end) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
123 (setq endcol (current-column)) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
124 (forward-line 1) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
125 (setq endpt (point-marker)) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
126 ;; ensure the start column is the left one. |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
127 (if (< endcol startcol) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
128 (let ((col startcol)) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
129 (setq startcol endcol endcol col))) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
130 ;; start looping over lines |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
131 (goto-char startpt) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
132 (while (< (point) endpt) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
133 (apply function startcol endcol args) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
134 (forward-line 1))) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
135 )) |
36 | 136 |
25168
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
137 (defun delete-rectangle-line (startcol endcol fill) |
25291
d9fa9f9ceb21
(delete-rectangle-line): Use line-end-position.
Karl Heuer <kwzh@gnu.org>
parents:
25168
diff
changeset
|
138 (let ((pt (line-end-position))) |
25168
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
139 (when (= (move-to-column-force startcol (or fill 'coerce)) startcol) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
140 (if (and (not fill) (<= pt endcol)) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
141 (delete-region (point) pt) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
142 ;; else |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
143 (setq pt (point)) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
144 (move-to-column-force endcol) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
145 (delete-region pt (point)))) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
146 )) |
36 | 147 |
25168
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
148 (defun delete-extract-rectangle-line (startcol endcol lines fill) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
149 (let ((pt (point-at-eol))) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
150 (if (< (move-to-column-force startcol (or fill 'coerce)) startcol) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
151 (setcdr lines (cons (spaces-string (- endcol startcol)) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
152 (cdr lines))) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
153 ;; else |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
154 (setq pt (point)) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
155 (move-to-column-force endcol) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
156 (setcdr lines (cons (buffer-substring pt (point)) (cdr lines))) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
157 (delete-region pt (point))) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
158 )) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
159 |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
160 ;; ### NOTE: this is actually the only function that needs to do complicated |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
161 ;; stuff like what's happening in `operate-on-rectangle', because the buffer |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
162 ;; might be read-only. --dv |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
163 (defun extract-rectangle-line (startcol endcol lines) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
164 (let (start end begextra endextra line) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
165 (move-to-column startcol) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
166 (setq start (point) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
167 begextra (- (current-column) startcol)) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
168 (move-to-column endcol) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
169 (setq end (point) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
170 endextra (- endcol (current-column))) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
171 (setq line (buffer-substring start (point))) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
172 (if (< begextra 0) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
173 (setq endextra (+ endextra begextra) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
174 begextra 0)) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
175 (if (< endextra 0) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
176 (setq endextra 0)) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
177 (goto-char start) |
36 | 178 (while (search-forward "\t" end t) |
179 (let ((width (- (current-column) | |
180 (save-excursion (forward-char -1) | |
181 (current-column))))) | |
182 (setq line (concat (substring line 0 (- (point) end 1)) | |
183 (spaces-string width) | |
25168
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
184 (substring line (+ (length line) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
185 (- (point) end))))))) |
36 | 186 (if (or (> begextra 0) (> endextra 0)) |
187 (setq line (concat (spaces-string begextra) | |
188 line | |
189 (spaces-string endextra)))) | |
25168
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
190 (setcdr lines (cons line (cdr lines))))) |
36 | 191 |
192 (defconst spaces-strings | |
193 '["" " " " " " " " " " " " " " " " "]) | |
194 | |
25168
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
195 ;; this one is untouched --dv |
36 | 196 (defun spaces-string (n) |
197 (if (<= n 8) (aref spaces-strings n) | |
198 (let ((val "")) | |
199 (while (> n 8) | |
200 (setq val (concat " " val) | |
201 n (- n 8))) | |
202 (concat val (aref spaces-strings n))))) | |
203 | |
258 | 204 ;;;###autoload |
25168
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
205 (defun delete-rectangle (start end &optional fill) |
25379
167c69238538
Add/fix various doc strings. Add `*' to all the interactive specs.
Dave Love <fx@gnu.org>
parents:
25291
diff
changeset
|
206 "Delete (don't save) text in the region-rectangle. |
167c69238538
Add/fix various doc strings. Add `*' to all the interactive specs.
Dave Love <fx@gnu.org>
parents:
25291
diff
changeset
|
207 The same range of columns is deleted in each line starting with the |
167c69238538
Add/fix various doc strings. Add `*' to all the interactive specs.
Dave Love <fx@gnu.org>
parents:
25291
diff
changeset
|
208 line where the region begins and ending with the line where the region |
167c69238538
Add/fix various doc strings. Add `*' to all the interactive specs.
Dave Love <fx@gnu.org>
parents:
25291
diff
changeset
|
209 ends. |
25168
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
210 |
25379
167c69238538
Add/fix various doc strings. Add `*' to all the interactive specs.
Dave Love <fx@gnu.org>
parents:
25291
diff
changeset
|
211 When called from a program the rectangle's corners are START and END. |
167c69238538
Add/fix various doc strings. Add `*' to all the interactive specs.
Dave Love <fx@gnu.org>
parents:
25291
diff
changeset
|
212 With a prefix (or a FILL) argument, also fill lines where nothing has |
167c69238538
Add/fix various doc strings. Add `*' to all the interactive specs.
Dave Love <fx@gnu.org>
parents:
25291
diff
changeset
|
213 to be deleted." |
167c69238538
Add/fix various doc strings. Add `*' to all the interactive specs.
Dave Love <fx@gnu.org>
parents:
25291
diff
changeset
|
214 (interactive "*r\nP") |
25168
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
215 (apply-on-rectangle 'delete-rectangle-line start end fill)) |
36 | 216 |
258 | 217 ;;;###autoload |
25168
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
218 (defun delete-extract-rectangle (start end &optional fill) |
25380
b5ef1f54a2ca
(delete-extract-rectangle): Doc fix from verna.
Dave Love <fx@gnu.org>
parents:
25379
diff
changeset
|
219 "Delete the contents of the rectangle with corners at START and END. |
25379
167c69238538
Add/fix various doc strings. Add `*' to all the interactive specs.
Dave Love <fx@gnu.org>
parents:
25291
diff
changeset
|
220 Return it as a list of strings, one for each line of the rectangle. |
25168
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
221 |
25379
167c69238538
Add/fix various doc strings. Add `*' to all the interactive specs.
Dave Love <fx@gnu.org>
parents:
25291
diff
changeset
|
222 When called from a program the rectangle's corners are START and END. |
25168
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
223 With an optional FILL argument, also fill lines where nothing has to be |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
224 deleted." |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
225 (let ((lines (list nil))) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
226 (apply-on-rectangle 'delete-extract-rectangle-line start end lines fill) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
227 (nreverse (cdr lines)))) |
36 | 228 |
258 | 229 ;;;###autoload |
36 | 230 (defun extract-rectangle (start end) |
25379
167c69238538
Add/fix various doc strings. Add `*' to all the interactive specs.
Dave Love <fx@gnu.org>
parents:
25291
diff
changeset
|
231 "Return the contents of the rectangle with corners at START and END. |
167c69238538
Add/fix various doc strings. Add `*' to all the interactive specs.
Dave Love <fx@gnu.org>
parents:
25291
diff
changeset
|
232 Return it as a list of strings, one for each line of the rectangle." |
25168
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
233 (let ((lines (list nil))) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
234 (apply-on-rectangle 'extract-rectangle-line start end lines) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
235 (nreverse (cdr lines)))) |
36 | 236 |
237 (defvar killed-rectangle nil | |
25379
167c69238538
Add/fix various doc strings. Add `*' to all the interactive specs.
Dave Love <fx@gnu.org>
parents:
25291
diff
changeset
|
238 "Rectangle for `yank-rectangle' to insert.") |
36 | 239 |
258 | 240 ;;;###autoload |
25168
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
241 (defun kill-rectangle (start end &optional fill) |
25379
167c69238538
Add/fix various doc strings. Add `*' to all the interactive specs.
Dave Love <fx@gnu.org>
parents:
25291
diff
changeset
|
242 "Delete the region-rectangle and save it as the last killed one. |
167c69238538
Add/fix various doc strings. Add `*' to all the interactive specs.
Dave Love <fx@gnu.org>
parents:
25291
diff
changeset
|
243 |
167c69238538
Add/fix various doc strings. Add `*' to all the interactive specs.
Dave Love <fx@gnu.org>
parents:
25291
diff
changeset
|
244 When called from a program the rectangle's corners are START and END. |
167c69238538
Add/fix various doc strings. Add `*' to all the interactive specs.
Dave Love <fx@gnu.org>
parents:
25291
diff
changeset
|
245 You might prefer to use `delete-extract-rectangle' from a program. |
36 | 246 |
25168
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
247 With a prefix (or a FILL) argument, also fill lines where nothing has to be |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
248 deleted." |
25379
167c69238538
Add/fix various doc strings. Add `*' to all the interactive specs.
Dave Love <fx@gnu.org>
parents:
25291
diff
changeset
|
249 (interactive "*r\nP") |
25168
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
250 (when buffer-read-only |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
251 (setq killed-rectangle (extract-rectangle start end)) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
252 (barf-if-buffer-read-only)) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
253 (setq killed-rectangle (delete-extract-rectangle start end fill))) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
254 |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
255 ;; this one is untouched --dv |
258 | 256 ;;;###autoload |
36 | 257 (defun yank-rectangle () |
258 "Yank the last killed rectangle with upper left corner at point." | |
25379
167c69238538
Add/fix various doc strings. Add `*' to all the interactive specs.
Dave Love <fx@gnu.org>
parents:
25291
diff
changeset
|
259 (interactive "*") |
36 | 260 (insert-rectangle killed-rectangle)) |
261 | |
25168
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
262 ;; this one is untoutched --dv |
258 | 263 ;;;###autoload |
36 | 264 (defun insert-rectangle (rectangle) |
265 "Insert text of RECTANGLE with upper left corner at point. | |
242 | 266 RECTANGLE's first line is inserted at point, its second |
267 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
|
268 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
|
269 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
|
270 and point is at the lower right corner." |
36 | 271 (let ((lines rectangle) |
272 (insertcolumn (current-column)) | |
273 (first t)) | |
1542
724b443e445d
(insert-rectangle): Put mark at upper left corner.
Richard M. Stallman <rms@gnu.org>
parents:
845
diff
changeset
|
274 (push-mark) |
36 | 275 (while lines |
276 (or first | |
277 (progn | |
278 (forward-line 1) | |
279 (or (bolp) (insert ?\n)) | |
23757
717a33da04a1
(move-to-column-force): New function.
Kenichi Handa <handa@m17n.org>
parents:
23641
diff
changeset
|
280 (move-to-column-force insertcolumn))) |
36 | 281 (setq first nil) |
282 (insert (car lines)) | |
283 (setq lines (cdr lines))))) | |
284 | |
258 | 285 ;;;###autoload |
25168
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
286 (defun open-rectangle (start end &optional fill) |
25379
167c69238538
Add/fix various doc strings. Add `*' to all the interactive specs.
Dave Love <fx@gnu.org>
parents:
25291
diff
changeset
|
287 "Blank out the region-rectangle, shifting text right. |
25168
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
288 |
25379
167c69238538
Add/fix various doc strings. Add `*' to all the interactive specs.
Dave Love <fx@gnu.org>
parents:
25291
diff
changeset
|
289 The text previously in the region is not overwritten by the blanks, |
167c69238538
Add/fix various doc strings. Add `*' to all the interactive specs.
Dave Love <fx@gnu.org>
parents:
25291
diff
changeset
|
290 but instead winds up to the right of the rectangle. |
167c69238538
Add/fix various doc strings. Add `*' to all the interactive specs.
Dave Love <fx@gnu.org>
parents:
25291
diff
changeset
|
291 |
167c69238538
Add/fix various doc strings. Add `*' to all the interactive specs.
Dave Love <fx@gnu.org>
parents:
25291
diff
changeset
|
292 When called from a program the rectangle's corners are START and END. |
25168
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
293 With a prefix (or a FILL) argument, fill with blanks even if there is no text |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
294 on the right side of the rectangle." |
25379
167c69238538
Add/fix various doc strings. Add `*' to all the interactive specs.
Dave Love <fx@gnu.org>
parents:
25291
diff
changeset
|
295 (interactive "*r\nP") |
25168
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
296 (apply-on-rectangle 'open-rectangle-line start end fill) |
1619
6147d2164331
* rect.el (operate-on-rectangle): Use move-to-column's FORCE
Jim Blandy <jimb@redhat.com>
parents:
1542
diff
changeset
|
297 (goto-char start)) |
36 | 298 |
25168
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
299 (defun open-rectangle-line (startcol endcol fill) |
30283
70a7936c29c5
(open-rectangle-line): Remove unused let.
Dave Love <fx@gnu.org>
parents:
28078
diff
changeset
|
300 (when (= (move-to-column-force startcol (or fill 'coerce)) startcol) |
70a7936c29c5
(open-rectangle-line): Remove unused let.
Dave Love <fx@gnu.org>
parents:
28078
diff
changeset
|
301 (unless (and (not fill) |
70a7936c29c5
(open-rectangle-line): Remove unused let.
Dave Love <fx@gnu.org>
parents:
28078
diff
changeset
|
302 (= (point) (point-at-eol))) |
70a7936c29c5
(open-rectangle-line): Remove unused let.
Dave Love <fx@gnu.org>
parents:
28078
diff
changeset
|
303 (indent-to endcol)))) |
25168
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
304 |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
305 (defun delete-whitespace-rectangle-line (startcol endcol fill) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
306 (when (= (move-to-column-force startcol (or fill 'coerce)) startcol) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
307 (unless (= (point) (point-at-eol)) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
308 (delete-region (point) (progn (skip-syntax-forward " ") (point)))) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
309 )) |
36 | 310 |
23812
baf00f643ccf
(delete-whitespace-rectangle): Mark for autoload.
Andreas Schwab <schwab@suse.de>
parents:
23757
diff
changeset
|
311 ;;;###autoload (defalias 'close-rectangle 'delete-whitespace-rectangle) ;; Old name |
258 | 312 ;;;###autoload |
25168
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
313 (defun delete-whitespace-rectangle (start end &optional fill) |
22205
8576d32229fc
(close-rectangle): New command.
Richard M. Stallman <rms@gnu.org>
parents:
19732
diff
changeset
|
314 "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
|
315 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
|
316 at which whitespace deletion should begin. On each line in the |
25168
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
317 rectangle, all continuous whitespace starting at that column is deleted. |
22205
8576d32229fc
(close-rectangle): New command.
Richard M. Stallman <rms@gnu.org>
parents:
19732
diff
changeset
|
318 |
25379
167c69238538
Add/fix various doc strings. Add `*' to all the interactive specs.
Dave Love <fx@gnu.org>
parents:
25291
diff
changeset
|
319 When called from a program the rectangle's corners are START and END. |
25168
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
320 With a prefix (or a FILL) argument, also fill too short lines." |
25379
167c69238538
Add/fix various doc strings. Add `*' to all the interactive specs.
Dave Love <fx@gnu.org>
parents:
25291
diff
changeset
|
321 (interactive "*r\nP") |
25168
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
322 (apply-on-rectangle 'delete-whitespace-rectangle-line start end fill)) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
323 |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
324 ;; not used any more --dv |
22213
84c3c863f0bd
(string-rectangle-string): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
22205
diff
changeset
|
325 ;; 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
|
326 ;; to string-rectangle-line. |
84c3c863f0bd
(string-rectangle-string): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
22205
diff
changeset
|
327 (defvar string-rectangle-string) |
22205
8576d32229fc
(close-rectangle): New command.
Richard M. Stallman <rms@gnu.org>
parents:
19732
diff
changeset
|
328 |
8576d32229fc
(close-rectangle): New command.
Richard M. Stallman <rms@gnu.org>
parents:
19732
diff
changeset
|
329 ;;;###autoload |
2637
45ecb9b4a6da
(string-rectangle): Renamed from fill-rectangle.
Richard M. Stallman <rms@gnu.org>
parents:
2380
diff
changeset
|
330 (defun string-rectangle (start end string) |
25379
167c69238538
Add/fix various doc strings. Add `*' to all the interactive specs.
Dave Love <fx@gnu.org>
parents:
25291
diff
changeset
|
331 "Insert STRING on each line of the region-rectangle, shifting text right. |
167c69238538
Add/fix various doc strings. Add `*' to all the interactive specs.
Dave Love <fx@gnu.org>
parents:
25291
diff
changeset
|
332 |
167c69238538
Add/fix various doc strings. Add `*' to all the interactive specs.
Dave Love <fx@gnu.org>
parents:
25291
diff
changeset
|
333 When called from a program the rectangle's corners are START and END. |
167c69238538
Add/fix various doc strings. Add `*' to all the interactive specs.
Dave Love <fx@gnu.org>
parents:
25291
diff
changeset
|
334 The left edge of the rectangle specifies the column for insertion. |
167c69238538
Add/fix various doc strings. Add `*' to all the interactive specs.
Dave Love <fx@gnu.org>
parents:
25291
diff
changeset
|
335 This command does not delete or overwrite any existing text." |
167c69238538
Add/fix various doc strings. Add `*' to all the interactive specs.
Dave Love <fx@gnu.org>
parents:
25291
diff
changeset
|
336 (interactive "*r\nsString rectangle: ") |
33807
22ed3ce37a4c
(string-rectangle): Don't test delete-selection-mode.
Dave Love <fx@gnu.org>
parents:
33772
diff
changeset
|
337 ;; XEmacs tests `pending-delete-mode' here, and replaces the |
22ed3ce37a4c
(string-rectangle): Don't test delete-selection-mode.
Dave Love <fx@gnu.org>
parents:
33772
diff
changeset
|
338 ;; rectangle if that's on. Using `delete-selection-mode' here would |
22ed3ce37a4c
(string-rectangle): Don't test delete-selection-mode.
Dave Love <fx@gnu.org>
parents:
33772
diff
changeset
|
339 ;; only be useful if `mark-even-if-inactive' is on since otherwise |
22ed3ce37a4c
(string-rectangle): Don't test delete-selection-mode.
Dave Love <fx@gnu.org>
parents:
33772
diff
changeset
|
340 ;; we need the mark to be active, given the interactive spec, and |
22ed3ce37a4c
(string-rectangle): Don't test delete-selection-mode.
Dave Love <fx@gnu.org>
parents:
33772
diff
changeset
|
341 ;; then we'd always delete. Maybe revisit this and consider testing |
22ed3ce37a4c
(string-rectangle): Don't test delete-selection-mode.
Dave Love <fx@gnu.org>
parents:
33772
diff
changeset
|
342 ;; `mark-even-if-inactive' too? |
22ed3ce37a4c
(string-rectangle): Don't test delete-selection-mode.
Dave Love <fx@gnu.org>
parents:
33772
diff
changeset
|
343 (apply-on-rectangle 'string-rectangle-line start end string nil)) |
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
|
344 |
33772
4787f33fe54f
(string-rectangle): Revert last change.
Dave Love <fx@gnu.org>
parents:
33750
diff
changeset
|
345 (defun string-rectangle-line (startcol endcol string delete) |
25168
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
346 (move-to-column-force startcol) |
33772
4787f33fe54f
(string-rectangle): Revert last change.
Dave Love <fx@gnu.org>
parents:
33750
diff
changeset
|
347 (if delete |
4787f33fe54f
(string-rectangle): Revert last change.
Dave Love <fx@gnu.org>
parents:
33750
diff
changeset
|
348 (delete-rectangle-line startcol endcol nil)) |
25168
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
349 (insert string)) |
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
|
350 |
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
|
351 ;;;###autoload |
28078
99865d22cc31
2000-09-01 Didier Verna <didier@xemacs.org>
Dave Love <fx@gnu.org>
parents:
25380
diff
changeset
|
352 (defun replace-rectangle (start end string) |
99865d22cc31
2000-09-01 Didier Verna <didier@xemacs.org>
Dave Love <fx@gnu.org>
parents:
25380
diff
changeset
|
353 "Like `string-rectangle', but replace the original region." |
99865d22cc31
2000-09-01 Didier Verna <didier@xemacs.org>
Dave Love <fx@gnu.org>
parents:
25380
diff
changeset
|
354 (interactive "*r\nsString rectangle: ") |
33772
4787f33fe54f
(string-rectangle): Revert last change.
Dave Love <fx@gnu.org>
parents:
33750
diff
changeset
|
355 (apply-on-rectangle 'string-rectangle-line start end string t)) |
28078
99865d22cc31
2000-09-01 Didier Verna <didier@xemacs.org>
Dave Love <fx@gnu.org>
parents:
25380
diff
changeset
|
356 |
99865d22cc31
2000-09-01 Didier Verna <didier@xemacs.org>
Dave Love <fx@gnu.org>
parents:
25380
diff
changeset
|
357 ;;;###autoload |
25168
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
358 (defun clear-rectangle (start end &optional fill) |
25379
167c69238538
Add/fix various doc strings. Add `*' to all the interactive specs.
Dave Love <fx@gnu.org>
parents:
25291
diff
changeset
|
359 "Blank out the region-rectangle. |
167c69238538
Add/fix various doc strings. Add `*' to all the interactive specs.
Dave Love <fx@gnu.org>
parents:
25291
diff
changeset
|
360 The text previously in the region is overwritten with blanks. |
25168
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
361 |
25379
167c69238538
Add/fix various doc strings. Add `*' to all the interactive specs.
Dave Love <fx@gnu.org>
parents:
25291
diff
changeset
|
362 When called from a program the rectangle's corners are START and END. |
25168
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
363 With a prefix (or a FILL) argument, also fill with blanks the parts of the |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
364 rectangle which were empty." |
25379
167c69238538
Add/fix various doc strings. Add `*' to all the interactive specs.
Dave Love <fx@gnu.org>
parents:
25291
diff
changeset
|
365 (interactive "*r\nP") |
25168
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
366 (apply-on-rectangle 'clear-rectangle-line start end fill)) |
36 | 367 |
25168
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
368 (defun clear-rectangle-line (startcol endcol fill) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
369 (let ((pt (point-at-eol)) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
370 spaces) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
371 (when (= (move-to-column-force startcol (or fill 'coerce)) startcol) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
372 (if (and (not fill) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
373 (<= (save-excursion (goto-char pt) (current-column)) endcol)) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
374 (delete-region (point) pt) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
375 ;; else |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
376 (setq pt (point)) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
377 (move-to-column-force endcol) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
378 (setq spaces (- (point) pt)) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
379 (delete-region pt (point)) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
380 (indent-to (+ (current-column) spaces)))) |
0fbd51325497
All functions rewritten, except when noted above
Richard M. Stallman <rms@gnu.org>
parents:
23812
diff
changeset
|
381 )) |
36 | 382 |
1619
6147d2164331
* rect.el (operate-on-rectangle): Use move-to-column's FORCE
Jim Blandy <jimb@redhat.com>
parents:
1542
diff
changeset
|
383 (provide 'rect) |
659
505130d1ddf8
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
258
diff
changeset
|
384 |
505130d1ddf8
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
258
diff
changeset
|
385 ;;; rect.el ends here |