Function: array-fill-rectangle

array-fill-rectangle is an interactive and byte-compiled function defined in array.el.gz.

Signature

(array-fill-rectangle)

Documentation

Copy the field at mark into every cell between mark and point.

Key Bindings

Source Code

;; Defined in /usr/src/emacs/lisp/array.el.gz
(defun array-fill-rectangle ()
  "Copy the field at mark into every cell between mark and point."
  (interactive)
  ;; Bind arguments.
  (array-update-buffer-position)
  (let ((p-row (or (array-current-row)
		   (error "Cursor is not in a valid array cell")))
	(p-column (or (array-current-column)
		      (error "Cursor is not in a valid array cell")))
	(m-row
	 (save-excursion
	   (exchange-point-and-mark)
	   (array-update-buffer-position)
	   (or (array-current-row)
	       (error "Mark is not in a valid array cell"))))
	(m-column
	 (save-excursion
	   (exchange-point-and-mark)
	   (array-update-buffer-position)
	   (or (array-current-column)
	       (error "Mark is not in a valid array cell")))))
    (message "Working...")
    (let ((top-row (min m-row p-row))
	  (bottom-row (max m-row p-row))
	  (left-column (min m-column p-column))
	  (right-column (max m-column p-column)))
      ;; Do the first row.
      (let ((array-copy-string
	     (save-excursion
	       (array-move-to-cell m-row m-column)
	       (array-update-buffer-position)
	       (array-field-string))))
	(array-copy-to-cell top-row left-column)
	(array-update-array-position top-row left-column)
	(array-update-buffer-position)
	(array-copy-to-column right-column))
      ;; Do the rest of the rows.
      (array-move-to-cell top-row left-column)
      (let ((array-copy-string
	     (buffer-substring
	      (point)
	      (save-excursion
		(array-move-to-cell top-row right-column)
		(setq array-buffer-column (current-column))
		(array-end-of-field t)
		(point))))
	    (this-row top-row))
	(while (/= this-row bottom-row)
	  (setq this-row (1+ this-row))
	  (array-move-to-cell this-row left-column)
	  (let ((inhibit-quit t))
	    (delete-region
	     (point)
	     (save-excursion
	       (array-move-to-cell this-row right-column)
	       (setq array-buffer-column (current-column))
	       (array-end-of-field t)
	       (point)))
	    (insert array-copy-string)))))
    (message "Working...done")
    (array-goto-cell p-row p-column)))