;;; stolfi-rect.el --- additional rectangle functions for GNU Emacs.
;;; Last edited on 2000-04-06 16:18:52 by stolfi

;;; Defines the commands 
;;;
;;;   cut-rectangle - like kill-rectangle but fills 
;;;     old rectangle with blanks instead of deleting it.
;;;
;;;   paste-rectangle - like yank-rectangle but overwrites 
;;;     instead of inserting.
;;;
;;; Perhaps these commands should be merged with kill-rectangle and
;;; yank-rectangle, their behavior being activated when the
;;; "overwrite" mode is set in the buffer.

(require 'rect)

(defun clear-extract-rectangle-line (startdelpos begextra endextra)
  (save-excursion
    (extract-rectangle-line startdelpos begextra endextra))
  (clear-rectangle-line startdelpos begextra endextra))

;;;###autoload
(defun cut-rectangle (start end)
  "Clear rectangle with corners at point and mark; save as last killed one.
Like kill-rectangle except that text is blanked out instead of deleted.
Calling from program, supply two args START and END, buffer positions.
But in programs you might prefer to use `clear-extract-rectangle'."
  (interactive "r")
  (if buffer-read-only
      (progn
	(setq killed-rectangle (extract-rectangle start end))
	(barf-if-buffer-read-only)))
  (setq killed-rectangle (clear-extract-rectangle start end)))

;;;###autoload
(defun clear-extract-rectangle (start end)
  "Clear contents of rectangle and return it as a list of strings.
Arguments START and END are the corners of the rectangle.
The value is list of strings, one for each line of the rectangle."
  (let ((lines))
    (operate-on-rectangle 'clear-extract-rectangle-line
			  start end t)
    (nreverse lines)))

;;;###autoload
(defun paste-rectangle ()
  "Yank the last killed rectangle with upper left corner at point."
  (interactive)
  (overwrite-insert-rectangle killed-rectangle))

;;;###autoload
(defun overwrite-insert-rectangle (rectangle)
  "Insert text of RECTANGLE with upper left corner at point,
overwriting the current contents of the area covered by it.
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.
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 t)))
      (setq first nil)
      (let ((line (car lines)) (beg (point)))
        (move-to-column (+ insertcolumn (length line)) t)
        (delete-region beg (point))
        (insert line))
      (setq lines (cdr lines)))))

(provide 'stolfi-rect)