annotate lisp/rect.el @ 20047:735f0cdfc5b9

(winner-change-fun): Don't use pushnew.
author Karl Heuer <kwzh@gnu.org>
date Wed, 15 Oct 1997 22:41:09 +0000
parents d8478556c7f0
children 8576d32229fc
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
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
4fd40bd394fe Update copyright.
Karl Heuer <kwzh@gnu.org>
parents: 5787
diff changeset
3 ;; Copyright (C) 1985, 1994 Free Software Foundation, Inc.
845
213978acbc1e entered into RCS
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 814
diff changeset
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
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
8 ;; This file is part of GNU Emacs.
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
9
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
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
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
13 ;; any later version.
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
14
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
15 ;; GNU Emacs is distributed in the hope that it will be useful,
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
18 ;; GNU General Public License for more details.
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
19
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
20 ;; You should have received a copy of the GNU General Public License
14169
83f275dcd93a Update FSF's address.
Erik Naggum <erik@naggum.no>
parents: 9877
diff changeset
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
83f275dcd93a Update FSF's address.
Erik Naggum <erik@naggum.no>
parents: 9877
diff changeset
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
83f275dcd93a Update FSF's address.
Erik Naggum <erik@naggum.no>
parents: 9877
diff changeset
23 ;; Boston, MA 02111-1307, USA.
36
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
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
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
31
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
32 (defun operate-on-rectangle (function start end coerce-tabs)
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
33 "Call FUNCTION for each line of rectangle with corners at START, END.
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
34 If COERCE-TABS is non-nil, convert multi-column characters
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
35 that span the starting or ending columns on any line
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
36 to multiple spaces before calling FUNCTION.
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
37 FUNCTION is called with three arguments:
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
38 position of start of segment of this line within the rectangle,
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
39 number of columns that belong to rectangle but are before that position,
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
40 number of columns that belong to rectangle but are after point.
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
41 Point is at the end of the segment of this line within the rectangle."
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
42 (let (startcol startlinepos endcol endlinepos)
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
43 (save-excursion
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
44 (goto-char start)
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
45 (setq startcol (current-column))
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
46 (beginning-of-line)
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
47 (setq startlinepos (point)))
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
48 (save-excursion
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
49 (goto-char end)
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
50 (setq endcol (current-column))
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
51 (forward-line 1)
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
52 (setq endlinepos (point-marker)))
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
53 (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
54 (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
55 (save-excursion
bef3a67ac893 (string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents: 2637
diff changeset
56 (goto-char startlinepos)
bef3a67ac893 (string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents: 2637
diff changeset
57 (while (< (point) endlinepos)
bef3a67ac893 (string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents: 2637
diff changeset
58 (let (startpos begextra endextra)
bef3a67ac893 (string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents: 2637
diff changeset
59 (move-to-column startcol coerce-tabs)
bef3a67ac893 (string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents: 2637
diff changeset
60 (setq begextra (- (current-column) startcol))
bef3a67ac893 (string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents: 2637
diff changeset
61 (setq startpos (point))
bef3a67ac893 (string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents: 2637
diff changeset
62 (move-to-column endcol coerce-tabs)
19732
d8478556c7f0 (operate-on-rectangle): If we overshoot when looking for endcol, back up.
Richard M. Stallman <rms@gnu.org>
parents: 14169
diff changeset
63 ;; 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
64 ;; 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
65 (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
66 (backward-char 1))
5787
bef3a67ac893 (string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents: 2637
diff changeset
67 (setq endextra (- endcol (current-column)))
bef3a67ac893 (string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents: 2637
diff changeset
68 (if (< begextra 0)
bef3a67ac893 (string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents: 2637
diff changeset
69 (setq endextra (+ endextra begextra)
bef3a67ac893 (string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents: 2637
diff changeset
70 begextra 0))
bef3a67ac893 (string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents: 2637
diff changeset
71 (funcall function startpos begextra endextra))
bef3a67ac893 (string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents: 2637
diff changeset
72 (forward-line 1)))
36
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
73 (- endcol startcol)))
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
74
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
75 (defun delete-rectangle-line (startdelpos ignore ignore)
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
76 (delete-region startdelpos (point)))
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
77
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
78 (defun delete-extract-rectangle-line (startdelpos begextra endextra)
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
79 (save-excursion
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
80 (extract-rectangle-line startdelpos begextra endextra))
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
81 (delete-region startdelpos (point)))
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
82
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
83 (defun extract-rectangle-line (startdelpos begextra endextra)
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
84 (let ((line (buffer-substring startdelpos (point)))
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
85 (end (point)))
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
86 (goto-char startdelpos)
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
87 (while (search-forward "\t" end t)
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
88 (let ((width (- (current-column)
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
89 (save-excursion (forward-char -1)
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
90 (current-column)))))
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
91 (setq line (concat (substring line 0 (- (point) end 1))
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
92 (spaces-string width)
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
93 (substring line (+ (length line) (- (point) end)))))))
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
94 (if (or (> begextra 0) (> endextra 0))
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
95 (setq line (concat (spaces-string begextra)
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
96 line
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
97 (spaces-string endextra))))
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
98 (setq lines (cons line lines))))
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
99
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
100 (defconst spaces-strings
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
101 '["" " " " " " " " " " " " " " " " "])
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
102
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
103 (defun spaces-string (n)
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
104 (if (<= n 8) (aref spaces-strings n)
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
105 (let ((val ""))
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
106 (while (> n 8)
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
107 (setq val (concat " " val)
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
108 n (- n 8)))
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
109 (concat val (aref spaces-strings n)))))
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
110
258
1e0bc00dca7a *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 242
diff changeset
111 ;;;###autoload
36
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
112 (defun delete-rectangle (start end)
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
113 "Delete (don't save) text in rectangle with point and mark as corners.
242
5647f2040009 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 36
diff changeset
114 The same range of columns is deleted in each line starting with the line
5647f2040009 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 36
diff changeset
115 where the region begins and ending with the line where the region ends."
36
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
116 (interactive "r")
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
117 (operate-on-rectangle 'delete-rectangle-line start end t))
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
118
258
1e0bc00dca7a *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 242
diff changeset
119 ;;;###autoload
36
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
120 (defun delete-extract-rectangle (start end)
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
121 "Delete contents of rectangle and return it as a list of strings.
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
122 Arguments START and END are the corners of the rectangle.
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
123 The value is list of strings, one for each line of the rectangle."
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
124 (let (lines)
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
125 (operate-on-rectangle 'delete-extract-rectangle-line
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
126 start end t)
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
127 (nreverse lines)))
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
128
258
1e0bc00dca7a *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 242
diff changeset
129 ;;;###autoload
36
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
130 (defun extract-rectangle (start end)
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
131 "Return contents of rectangle with corners at START and END.
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
132 Value is list of strings, one for each line of the rectangle."
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
133 (let (lines)
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
134 (operate-on-rectangle 'extract-rectangle-line start end nil)
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
135 (nreverse lines)))
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
136
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
137 (defvar killed-rectangle nil
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
138 "Rectangle for yank-rectangle to insert.")
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
139
258
1e0bc00dca7a *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 242
diff changeset
140 ;;;###autoload
36
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
141 (defun kill-rectangle (start end)
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
142 "Delete rectangle with corners at point and mark; save as last killed one.
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
143 Calling from program, supply two args START and END, buffer positions.
242
5647f2040009 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 36
diff changeset
144 But in programs you might prefer to use `delete-extract-rectangle'."
36
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
145 (interactive "r")
9242
493c74aab5a0 (kill-rectangle): In read-only buffer, do record
Richard M. Stallman <rms@gnu.org>
parents: 7298
diff changeset
146 (if buffer-read-only
493c74aab5a0 (kill-rectangle): In read-only buffer, do record
Richard M. Stallman <rms@gnu.org>
parents: 7298
diff changeset
147 (progn
493c74aab5a0 (kill-rectangle): In read-only buffer, do record
Richard M. Stallman <rms@gnu.org>
parents: 7298
diff changeset
148 (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
149 (barf-if-buffer-read-only)))
36
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
150 (setq killed-rectangle (delete-extract-rectangle start end)))
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
151
258
1e0bc00dca7a *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 242
diff changeset
152 ;;;###autoload
36
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
153 (defun yank-rectangle ()
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
154 "Yank the last killed rectangle with upper left corner at point."
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
155 (interactive)
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
156 (insert-rectangle killed-rectangle))
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
157
258
1e0bc00dca7a *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 242
diff changeset
158 ;;;###autoload
36
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
159 (defun insert-rectangle (rectangle)
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
160 "Insert text of RECTANGLE with upper left corner at point.
242
5647f2040009 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 36
diff changeset
161 RECTANGLE's first line is inserted at point, its second
5647f2040009 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 36
diff changeset
162 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
163 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
164 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
165 and point is at the lower right corner."
36
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
166 (let ((lines rectangle)
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
167 (insertcolumn (current-column))
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
168 (first t))
1542
724b443e445d (insert-rectangle): Put mark at upper left corner.
Richard M. Stallman <rms@gnu.org>
parents: 845
diff changeset
169 (push-mark)
36
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
170 (while lines
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
171 (or first
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
172 (progn
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
173 (forward-line 1)
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
174 (or (bolp) (insert ?\n))
1619
6147d2164331 * rect.el (operate-on-rectangle): Use move-to-column's FORCE
Jim Blandy <jimb@redhat.com>
parents: 1542
diff changeset
175 (move-to-column insertcolumn t)))
36
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
176 (setq first nil)
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
177 (insert (car lines))
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
178 (setq lines (cdr lines)))))
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
179
258
1e0bc00dca7a *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 242
diff changeset
180 ;;;###autoload
36
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
181 (defun open-rectangle (start end)
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
182 "Blank out rectangle with corners at point and mark, shifting text right.
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
183 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
184 but instead winds up to the right of the rectangle."
36
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
185 (interactive "r")
1619
6147d2164331 * rect.el (operate-on-rectangle): Use move-to-column's FORCE
Jim Blandy <jimb@redhat.com>
parents: 1542
diff changeset
186 (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
187 (goto-char start))
36
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
188
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
189 (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
190 ;; Column where rectangle ends.
bef3a67ac893 (string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents: 2637
diff changeset
191 (let ((endcol (+ (current-column) endextra))
bef3a67ac893 (string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents: 2637
diff changeset
192 whitewidth)
36
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
193 (goto-char startpos)
5787
bef3a67ac893 (string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents: 2637
diff changeset
194 ;; Column where rectangle begins.
bef3a67ac893 (string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents: 2637
diff changeset
195 (let ((begcol (- (current-column) begextra)))
36
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
196 (skip-chars-forward " \t")
5787
bef3a67ac893 (string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents: 2637
diff changeset
197 ;; 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
198 (setq whitewidth (- (current-column) begcol)))
bef3a67ac893 (string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents: 2637
diff changeset
199 ;; 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
200 (delete-region startpos (point))
bef3a67ac893 (string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents: 2637
diff changeset
201 ;; 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
202 (indent-to (+ endcol whitewidth))))
36
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
203
258
1e0bc00dca7a *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 242
diff changeset
204 ;;;###autoload
2637
45ecb9b4a6da (string-rectangle): Renamed from fill-rectangle.
Richard M. Stallman <rms@gnu.org>
parents: 2380
diff changeset
205 (defun string-rectangle (start end string)
45ecb9b4a6da (string-rectangle): Renamed from fill-rectangle.
Richard M. Stallman <rms@gnu.org>
parents: 2380
diff changeset
206 "Insert STRING on each line of the region-rectangle, shifting text right.
45ecb9b4a6da (string-rectangle): Renamed from fill-rectangle.
Richard M. Stallman <rms@gnu.org>
parents: 2380
diff changeset
207 The left edge of the rectangle specifies the column for insertion.
45ecb9b4a6da (string-rectangle): Renamed from fill-rectangle.
Richard M. Stallman <rms@gnu.org>
parents: 2380
diff changeset
208 This command does not delete or overwrite any existing text.
45ecb9b4a6da (string-rectangle): Renamed from fill-rectangle.
Richard M. Stallman <rms@gnu.org>
parents: 2380
diff changeset
209
45ecb9b4a6da (string-rectangle): Renamed from fill-rectangle.
Richard M. Stallman <rms@gnu.org>
parents: 2380
diff changeset
210 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
211 (interactive "r\nsString rectangle: ")
9877
689bcdba1d40 (string-rectangle): Don't set point.
Richard M. Stallman <rms@gnu.org>
parents: 9242
diff changeset
212 (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
213
2637
45ecb9b4a6da (string-rectangle): Renamed from fill-rectangle.
Richard M. Stallman <rms@gnu.org>
parents: 2380
diff changeset
214 (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
215 (let (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
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 ;; 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
218 (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
219 (skip-chars-forward " \t")
5787
bef3a67ac893 (string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents: 2637
diff changeset
220 (setq whitespace (- (current-column) ocol)))
bef3a67ac893 (string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents: 2637
diff changeset
221 ;; Delete the following whitespace.
bef3a67ac893 (string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents: 2637
diff changeset
222 (delete-region startpos (point))
bef3a67ac893 (string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents: 2637
diff changeset
223 ;; Insert the desired string.
bef3a67ac893 (string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents: 2637
diff changeset
224 (insert string)
bef3a67ac893 (string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents: 2637
diff changeset
225 ;; 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
226 (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
227
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
228 ;;;###autoload
36
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
229 (defun clear-rectangle (start end)
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
230 "Blank out rectangle with corners at point and mark.
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
231 The text previously in the region is overwritten by the blanks.
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
232 When called from a program, requires two args which specify the corners."
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
233 (interactive "r")
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
234 (operate-on-rectangle 'clear-rectangle-line start end t))
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
235
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
236 (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
237 ;; Find end of whitespace after the rectangle.
36
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
238 (skip-chars-forward " \t")
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
239 (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
240 ;; Delete the text in the rectangle, and following whitespace.
36
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
241 (delete-region (point)
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
242 (progn (goto-char startpos)
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
243 (skip-chars-backward " \t")
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
244 (point)))
5787
bef3a67ac893 (string-rectangle): Make operate-on-rectangle convert tabs.
Richard M. Stallman <rms@gnu.org>
parents: 2637
diff changeset
245 ;; Reindent out to same column that we were at.
36
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
246 (indent-to column)))
9697c13298e5 Initial revision
Joseph Arceneaux <jla@gnu.org>
parents:
diff changeset
247
1619
6147d2164331 * rect.el (operate-on-rectangle): Use move-to-column's FORCE
Jim Blandy <jimb@redhat.com>
parents: 1542
diff changeset
248 (provide 'rect)
659
505130d1ddf8 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 258
diff changeset
249
505130d1ddf8 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 258
diff changeset
250 ;;; rect.el ends here