(calendar-print-french-date,diary-french-date):

[gnu-emacs] / lisp / rect.el

diff --git a/lisp/rect.el b/lisp/rect.el
index 99e698f2810b50c4bb6b2f870798699d623f8c08..60a94877bbc3eaa5532927a483e9def40f00f7dc 100644 (file)
--- a/lisp/rect.el
+++ b/lisp/rect.el
@@ -21,6 +21,11 @@
 ;; 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)
@@ -45,30 +50,21 @@ Point is at the end of the segment of this line within the rectangle."
      (forward-line 1)
      (setq endlinepos (point-marker)))
     (if (< endcol startcol)
-       (let ((tem startcol))
-         (setq startcol endcol endcol tem)))
-    (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))
-            (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)))
-            (setq endextra (- endcol (current-column)))
-            (if (< begextra 0)
-                (setq endextra (+ endextra begextra)
-                      begextra 0))
-            (funcall function startpos begextra endextra))
-          (forward-line 1))))
+       (setq startcol (prog1 endcol (setq 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)))
     (- endcol startcol)))
 
 (defun delete-rectangle-line (startdelpos ignore ignore)
@@ -167,11 +163,7 @@ and point is at the lower right corner."
          (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)))))
@@ -180,20 +172,50 @@ and point is at the lower right corner."
 (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)))
+  ;; 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)
+  (goto-char start))
+
+(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)
-                   (progn (skip-chars-backward " \t")
-                         (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)
@@ -204,19 +226,17 @@ 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)))
 
-(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