-;; Rectangle functions for GNU Emacs.
+;;; rect.el --- rectangle functions for GNU Emacs.
+
;; Copyright (C) 1985 Free Software Foundation, Inc.
+;; Maintainer: FSF
+;; Keywords: internal
+
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 1, or (at your option)
+;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;;; Commentary:
+
+;; This package provides the operations on rectangles that are ocumented
+;; in the Emacs manual.
+
+;;; Code:
(defun operate-on-rectangle (function start end coerce-tabs)
"Call FUNCTION for each line of rectangle with corners at START, END.
(forward-line 1)
(setq endlinepos (point-marker)))
(if (< endcol startcol)
- (let ((tem startcol))
- (setq startcol endcol endcol tem)))
+ (setq startcol (prog1 endcol (setq endcol startcol))))
(if (/= endcol startcol)
(save-excursion
(goto-char startlinepos)
(while (< (point) endlinepos)
(let (startpos begextra endextra)
- (move-to-column startcol)
- (and coerce-tabs
- (> (current-column) startcol)
- (rectangle-coerce-tab startcol))
+ (move-to-column startcol coerce-tabs)
(setq begextra (- (current-column) startcol))
(setq startpos (point))
- (move-to-column endcol)
- (if (> (current-column) endcol)
- (if coerce-tabs
- (rectangle-coerce-tab endcol)
- (forward-char -1)))
+ (move-to-column endcol coerce-tabs)
(setq endextra (- endcol (current-column)))
(if (< begextra 0)
(setq endextra (+ endextra begextra)
"Insert text of RECTANGLE with upper left corner at point.
RECTANGLE's first line is inserted at point, its second
line is inserted at a point vertically under point, etc.
-RECTANGLE should be a list of strings."
+RECTANGLE should be a list of strings.
+After this command, the mark is at the upper left corner
+and point is at the lower right corner."
(let ((lines rectangle)
(insertcolumn (current-column))
(first t))
+ (push-mark)
(while lines
(or first
(progn
(forward-line 1)
(or (bolp) (insert ?\n))
- (move-to-column insertcolumn)
- (if (> (current-column) insertcolumn)
- (rectangle-coerce-tab insertcolumn))
- (if (< (current-column) insertcolumn)
- (indent-to insertcolumn))))
+ (move-to-column insertcolumn t)))
(setq first nil)
(insert (car lines))
(setq lines (cdr lines)))))
(defun open-rectangle (start end)
"Blank out rectangle with corners at point and mark, shifting text right.
The text previously in the region is not overwritten by the blanks,
-but insted winds up to the right of the rectangle."
+but instead winds up to the right of the rectangle."
(interactive "r")
- (operate-on-rectangle 'open-rectangle-line start end nil))
+ (operate-on-rectangle 'open-rectangle-line start end nil)
+ (goto-char start))
(defun open-rectangle-line (startpos begextra endextra)
(let ((column (+ (current-column) begextra endextra)))
(skip-chars-forward " \t")
(setq column (+ column (- (current-column) ocol))))
(delete-region (point)
- (progn (skip-chars-backward " \t")
+ ;; Use skip-chars-backward's LIM argument to leave
+ ;; characters before STARTPOS undisturbed.
+ (progn (skip-chars-backward " \t" startpos)
(point)))
(indent-to column)))
+;;;###autoload
+(defun string-rectangle (start end string)
+ "Insert STRING on each line of the region-rectangle, shifting text right.
+The left edge of the rectangle specifies the column for insertion.
+This command does not delete or overwrite any existing text.
+
+Called from a program, takes three args; START, END and STRING."
+ (interactive "r\nsString rectangle: ")
+ (operate-on-rectangle 'string-rectangle-line start end nil)
+ (goto-char start))
+
+(defun string-rectangle-line (startpos begextra endextra)
+ (let ((column (+ (current-column) begextra endextra)))
+ (goto-char startpos)
+ (let ((ocol (current-column)))
+ (skip-chars-forward " \t")
+ (setq column (+ column (- (current-column) ocol))))
+ (delete-region (point)
+ ;; Use skip-chars-backward's LIM argument to leave
+ ;; characters before STARTPOS undisturbed.
+ (progn (skip-chars-backward " \t" startpos)
+ (point)))
+ (insert string)))
+
;;;###autoload
(defun clear-rectangle (start end)
"Blank out rectangle with corners at point and mark.
(point)))
(indent-to column)))
-(defun rectangle-coerce-tab (column)
- (let ((aftercol (current-column))
- (indent-tabs-mode nil))
- (delete-char -1)
- (indent-to aftercol)
- (backward-char (- aftercol column))))
+(provide 'rect)
+
+;;; rect.el ends here