Mercurial > hg > xemacs-beta

comparison lisp/rect.el @ 424:11054d720c21 r21-2-20

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-20
author cvs
date Mon, 13 Aug 2007 11:26:11 +0200
parents 95016f13131a
children
comparison
equal deleted inserted replaced
423:28d9c139be4c 424:11054d720c21
24 24
25 ;;; Synched up with: to be incorporated in a forthcoming GNU Emacs 25 ;;; Synched up with: to be incorporated in a forthcoming GNU Emacs
26 26
27 ;;; Commentary: 27 ;;; Commentary:
28 28
29 ;; This package provides the operations on rectangles that are ocumented 29 ;; This package provides the operations on rectangles that are documented
30 ;; in the XEmacs Reference Manual. 30 ;; in the XEmacs Reference Manual.
31 31
32 ;; ### NOTE: this file has been almost completely rewritten by Didier Verna 32 ;; ### NOTE: this file has been almost completely rewritten by Didier Verna
33 ;; <verna@inf.enst.fr>, Jul 99. The purpose of this rewrite is to be less 33 ;; <verna@inf.enst.fr>, Jul 99. The purpose of this rewrite is to be less
34 ;; intrusive and fill lines with whitespaces only when needed. A few functions 34 ;; intrusive and fill lines with whitespaces only when needed. A few functions
84 (forward-line 1))) 84 (forward-line 1)))
85 (- endcol startcol))) 85 (- endcol startcol)))
86 86
87 ;; The replacement for `operate-on-rectangle' -- dv 87 ;; The replacement for `operate-on-rectangle' -- dv
88 (defun apply-on-rectangle (function start end &rest args) 88 (defun apply-on-rectangle (function start end &rest args)
89 "Call FUNCTION for each line of rectangle with corners at START, END. 89 "Call FUNCTION for each line of rectangle with corners at START and END.
90 FUNCTION is called with two arguments: the start and end columns of the 90 FUNCTION is called with two arguments: the start and end columns of the
91 rectangle, plus ARGS extra arguments. Point is at the beginning of line when 91 rectangle, plus ARGS extra arguments. Point is at the beginning of line
92 the function is called." 92 when the function is called."
93 (let (startcol startpt endcol endpt) 93 (let (startcol startpt endcol endpt)
94 (save-excursion 94 (save-excursion
95 (goto-char start) 95 (goto-char start)
96 (setq startcol (current-column)) 96 (setq startcol (current-column))
97 (beginning-of-line) 97 (beginning-of-line)
132 n (- n 8))) 132 n (- n 8)))
133 (concat val (aref spaces-strings n))))) 133 (concat val (aref spaces-strings n)))))
134 134
135 ;;;###autoload 135 ;;;###autoload
136 (defvar killed-rectangle nil 136 (defvar killed-rectangle nil
137 "Rectangle for yank-rectangle to insert.") 137 "Rectangle for `yank-rectangle' to insert.")
138 138
139 ;;;###autoload 139 ;;;###autoload
140 (defun kill-rectangle (start end &optional fill) 140 (defun kill-rectangle (start end &optional fill)
141 "Delete the rectangle with corners at point and mark (START and END when 141 "Delete the region-rectangle and save it as the last killed one.
142 called from a program) and save it as the last killed one. You might prefer to 142 You might prefer to use `delete-extract-rectangle' from a program.
143 use `delete-extract-rectangle' from a program. 143
144 144 When called from a program, the rectangle's corners are START and END.
145 With a prefix (or a FILL) argument, also fill lines where nothing has to be 145 With a prefix (or FILL) argument, also fill lines where nothing has to be
146 deleted." 146 deleted."
147 (interactive "r\nP") 147 (interactive "*r\nP")
148 (when buffer-read-only 148 (when buffer-read-only
149 (setq killed-rectangle (extract-rectangle start end)) 149 (setq killed-rectangle (extract-rectangle start end))
150 (barf-if-buffer-read-only)) 150 (barf-if-buffer-read-only))
151 (setq killed-rectangle (delete-extract-rectangle start end fill))) 151 (setq killed-rectangle (delete-extract-rectangle start end fill)))
152 152
153 ;;;###autoload 153 ;;;###autoload
154 (defun delete-rectangle (start end &optional fill) 154 (defun delete-rectangle (start end &optional fill)
155 "Delete (don't save) text in rectangle with corners at point and mark (START 155 "Delete the text in the region-rectangle without saving it.
156 and END when called from a program). The same range of columns is deleted in 156 The same range of columns is deleted in each line starting with the line
157 each line starting with the line where the region begins and ending with the 157 where the region begins and ending with the line where the region ends.
158 line where the region ends. 158
159 159 When called from a program, the rectangle's corners are START and END.
160 With a prefix (or a FILL) argument, also fill lines where nothing has to be 160 With a prefix (or FILL) argument, also fill lines where nothing has to be
161 deleted." 161 deleted."
162 (interactive "r\nP") 162 (interactive "*r\nP")
163 (apply-on-rectangle 'delete-rectangle-line start end fill)) 163 (apply-on-rectangle 'delete-rectangle-line start end fill))
164 164
165 (defun delete-rectangle-line (startcol endcol fill) 165 (defun delete-rectangle-line (startcol endcol fill)
166 (let ((pt (point-at-eol))) 166 (let ((pt (point-at-eol)))
167 (when (= (move-to-column startcol (or fill 'coerce)) startcol) 167 (when (= (move-to-column startcol (or fill 'coerce)) startcol)
238 238
239 ;; This function is untouched --dv 239 ;; This function is untouched --dv
240 ;;;###autoload 240 ;;;###autoload
241 (defun yank-rectangle () 241 (defun yank-rectangle ()
242 "Yank the last killed rectangle with upper left corner at point." 242 "Yank the last killed rectangle with upper left corner at point."
243 (interactive) 243 (interactive "*")
244 (insert-rectangle killed-rectangle)) 244 (insert-rectangle killed-rectangle))
245 245
246 ;; This function is untouched --dv 246 ;; This function is untouched --dv
247 ;;;###autoload 247 ;;;###autoload
248 (defun insert-rectangle (rectangle) 248 (defun insert-rectangle (rectangle)
266 (insert (car lines)) 266 (insert (car lines))
267 (setq lines (cdr lines))))) 267 (setq lines (cdr lines)))))
268 268
269 ;;;###autoload 269 ;;;###autoload
270 (defun open-rectangle (start end &optional fill) 270 (defun open-rectangle (start end &optional fill)
271 "Blank out rectangle with corners at point and mark (START and END when 271 "Blank out the region-rectangle, shifting text right.
272 called from a program), shifting text right. The text previously in the region 272
273 is not overwritten by the blanks, but instead winds up to the right of the 273 When called from a program, the rectangle's corners are START and END.
274 rectangle. 274 With a prefix (or FILL) argument, fill with blanks even if there is no text
275
276 With a prefix (or a FILL) argument, fill with blanks even if there is no text
277 on the right side of the rectangle." 275 on the right side of the rectangle."
278 (interactive "r\nP") 276 (interactive "*r\nP")
279 (apply-on-rectangle 'open-rectangle-line start end fill) 277 (apply-on-rectangle 'open-rectangle-line start end fill)
280 (goto-char start)) 278 (goto-char start))
281 279
282 (defun open-rectangle-line (startcol endcol fill) 280 (defun open-rectangle-line (startcol endcol fill)
283 (let (spaces) 281 (let (spaces)
287 (indent-to endcol))) 285 (indent-to endcol)))
288 )) 286 ))
289 287
290 ;;;###autoload 288 ;;;###autoload
291 (defun string-rectangle (start end string) 289 (defun string-rectangle (start end string)
292 "Insert STRING on each line of the rectangle with corners at point and mark 290 "Insert STRING on each line of the region-rectangle, shifting text right.
293 (START and END when called from a program), shifting text right. The left edge 291 The left edge of the rectangle specifies the column for insertion. This
294 of the rectangle specifies the column for insertion. This command does not 292 command does not delete or overwrite any existing text.
295 delete or overwrite any existing text." 293
296 (interactive "r\nsString rectangle: ") 294 When called from a program, the rectangle's corners are START and END."
295 (interactive "*r\nsString rectangle: ")
297 (apply-on-rectangle 'string-rectangle-line start end string)) 296 (apply-on-rectangle 'string-rectangle-line start end string))
298 297
299 (defun string-rectangle-line (startcol endcol string) 298 (defun string-rectangle-line (startcol endcol string)
300 (move-to-column startcol t) 299 (move-to-column startcol t)
301 (insert string)) 300 (insert string))
302 301
303 ;;;###autoload 302 ;;;###autoload
304 (defun clear-rectangle (start end &optional fill) 303 (defun clear-rectangle (start end &optional fill)
305 "Blank out the rectangle with corners at point and mark (START and END when 304 "Blank out the region-rectangle.
306 called from a program). The text previously in the region is overwritten with 305 The text previously in the region is overwritten with blanks.
307 blanks. 306
308 307 When called from a program, the rectangle's corners are START and END.
309 With a prefix (or a FILL) argument, also fill with blanks the parts of the 308 With a prefix (or FILL) argument, also fill with blanks the parts of the
310 rectangle which were empty." 309 rectangle which were empty."
311 (interactive "r\nP") 310 (interactive "*r\nP")
312 (apply-on-rectangle 'clear-rectangle-line start end fill)) 311 (apply-on-rectangle 'clear-rectangle-line start end fill))
313 312
314 (defun clear-rectangle-line (startcol endcol fill) 313 (defun clear-rectangle-line (startcol endcol fill)
315 (let ((pt (point-at-eol)) 314 (let ((pt (point-at-eol))
316 spaces) 315 spaces)