(ada-case-keyword, ada-auto-case, ada-krunch-args,

[bpt/emacs.git] / lisp / rect.el

diff --git a/lisp/rect.el b/lisp/rect.el
index e440904..3864934 100644 (file)
--- a/lisp/rect.el
+++ b/lisp/rect.el
@@ -1,6 +1,6 @@
 ;;; rect.el --- rectangle functions for GNU Emacs.
 
-;; Copyright (C) 1985 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1994 Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
 ;; Keywords: internal
@@ -51,21 +51,20 @@ Point is at the end of the segment of this line within the rectangle."
      (setq endlinepos (point-marker)))
     (if (< endcol startcol)
        (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 coerce-tabs)
-            (setq begextra (- (current-column) startcol))
-            (setq startpos (point))
-            (move-to-column endcol coerce-tabs)
-            (setq endextra (- endcol (current-column)))
-            (if (< begextra 0)
-                (setq endextra (+ endextra begextra)
-                      begextra 0))
-            (funcall function startpos begextra endextra))
-          (forward-line 1))))
+    (save-excursion
+     (goto-char startlinepos)
+     (while (< (point) endlinepos)
+       (let (startpos begextra endextra)
+        (move-to-column startcol coerce-tabs)
+        (setq begextra (- (current-column) startcol))
+        (setq startpos (point))
+        (move-to-column endcol coerce-tabs)
+        (setq endextra (- endcol (current-column)))
+        (if (< begextra 0)
+            (setq endextra (+ endextra begextra)
+                  begextra 0))
+        (funcall function startpos begextra endextra))
+       (forward-line 1)))
     (- endcol startcol)))
 
 (defun delete-rectangle-line (startdelpos ignore ignore)
@@ -139,6 +138,10 @@ Value is list of strings, one for each line of the rectangle."
 Calling from program, supply two args START and END, buffer positions.
 But in programs you might prefer to use `delete-extract-rectangle'."
   (interactive "r")
+  (if buffer-read-only
+      (progn
+       (setq killed-rectangle (extract-rectangle start end))
+       (barf-if-buffer-read-only)))
   (setq killed-rectangle (delete-extract-rectangle start end)))
 
 ;;;###autoload
@@ -179,17 +182,43 @@ but instead winds up to the right of the rectangle."
   (goto-char start))
 
 (defun open-rectangle-line (startpos begextra endextra)
-  (let ((column (+ (current-column) begextra endextra)))
+  ;; Column where rectangle ends.
+  (let ((endcol (+ (current-column) endextra))
+       whitewidth)
+    (goto-char startpos)
+    ;; Column where rectangle begins.
+    (let ((begcol (- (current-column) begextra)))
+      (skip-chars-forward " \t")
+      ;; Width of whitespace to be deleted and recreated.
+      (setq whitewidth (- (current-column) begcol)))
+    ;; Delete the whitespace following the start column.
+    (delete-region startpos (point))
+    ;; Open the desired width, plus same amount of whitespace we just deleted.
+    (indent-to (+ endcol whitewidth))))
+
+;;;###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 t))
+
+(defun string-rectangle-line (startpos begextra endextra)
+  (let (whitespace)
     (goto-char startpos)
+    ;; Compute horizontal width of following whitespace.
     (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)))
-    (indent-to column)))
+      (setq whitespace (- (current-column) ocol)))
+    ;; Delete the following whitespace.
+    (delete-region startpos (point))
+    ;; Insert the desired string.
+    (insert string)
+    ;; Insert the same width of whitespace that we had before.
+    (indent-to (+ (current-column) whitespace))))
 
 ;;;###autoload
 (defun clear-rectangle (start end)
@@ -200,12 +229,15 @@ When called from a program, requires two args which specify the corners."
   (operate-on-rectangle 'clear-rectangle-line start end t))
 
 (defun clear-rectangle-line (startpos begextra endextra)
+  ;; Find end of whitespace after the rectangle.
   (skip-chars-forward " \t")
   (let ((column (+ (current-column) endextra)))
+    ;; Delete the text in the rectangle, and following whitespace.
     (delete-region (point)
                    (progn (goto-char startpos)
                          (skip-chars-backward " \t")
                          (point)))
+    ;; Reindent out to same column that we were at.
     (indent-to column)))
 
 (provide 'rect)