4.4BSD/usr/src/contrib/emacs-18.57/lisp/rect.elc

(defun operate-on-rectangle (function start end coerce-tabs) "\
Call FUNCTION for each line of rectangle with corners at START, END.
If COERCE-TABS is non-nil, convert multi-column characters
that span the starting or ending columns on any line
to multiple spaces before calling FUNCTION.
FUNCTION is called with three arguments:
 position of start of segment of this line within the rectangle,
 number of columns that belong to rectangle but are before that position,
 number of columns that belong to rectangle but are after point.
Point is at the end of the segment of this line within the rectangle." (byte-code "ÌÌÌÌŠbˆi‰ˆÍ ˆ`‰)ˆŠ
bˆi‰ˆÎÏ!ˆÐ ‰)ˆ
Wƒ=
‰)‚>̈Ñ
\"ƒÊŠ	bˆ`W…ÆÌÌÌ	Ò!ˆ
…kiV…kÓ!ˆiZ‰ˆ`‰ˆÒ
!ˆi
Vƒ“
ƒ�Ó
!‚�ÔÕ!‚”̈
iZ‰	ˆÖWƒ±	\\	Ö‰‚²Ìˆ×	$+ˆÎÏ!ˆ‚J)‚Ë̈
Z,‡" [startcol startlinepos endcol endlinepos start end tem startpos begextra endextra coerce-tabs function nil beginning-of-line forward-line 1 point-marker /= move-to-column rectangle-coerce-tab forward-char -1 0 funcall] 15))

(defun delete-rectangle-line (startdelpos ignore ignore) (byte-code "Á`\"‡" [startdelpos delete-region] 3))

(defun delete-extract-rectangle-line (startdelpos begextra endextra) (byte-code "ŠÃ	
#)ˆÄ`\"‡" [startdelpos begextra endextra extract-rectangle-line delete-region] 4))

(defun extract-rectangle-line (startdelpos begextra endextra) (byte-code "È	`\"`	bˆÉÊ
Ã#…8iŠËÌ!ˆi)ZÍÎ`
Ï#OÐ!G`
Z\\ÑOQ‰)ˆ‚
ˆ
ÍV†CÍVƒTÐ
!Ð!Q‰‚UшB‰*‡" [line startdelpos end t width begextra endextra lines buffer-substring search-forward "	" forward-char -1 0 - 1 spaces-string nil] 12))

(defconst spaces-strings (quote ["" " " "  " "   " "    " "     " "      " "       " "        "]))

(defun spaces-string (n) (byte-code "ÃXƒ	H‚(ÄÃV…!Å
PÃZ‰ˆ‚ˆ
	HP)‡" [n spaces-strings val 8 "" "        "] 3))

(defun delete-rectangle (start end) "\
Delete (don't save) text in rectangle with point and mark as corners.
The same range of columns is deleted in each line
starting with the line where the region begins
and ending with the line where the region ends." (interactive "r") (byte-code "ÈÄÅ	Â$‡" [start end t nil operate-on-rectangle delete-rectangle-line] 5))

(defun delete-extract-rectangle (start end) "\
Return and delete contents of rectangle with corners at START and END.
Value is list of strings, one for each line of the rectangle." (byte-code "ÄÅÆ	
Ã$ˆÇ!)‡" [lines start end t nil operate-on-rectangle delete-extract-rectangle-line nreverse] 5))

(defun extract-rectangle (start end) "\
Return contents of rectangle with corners at START and END.
Value is list of strings, one for each line of the rectangle." (byte-code "ÃÄÅ	
Ã$ˆÆ!)‡" [lines start end nil operate-on-rectangle extract-rectangle-line nreverse] 5))

(defvar killed-rectangle nil "\
Rectangle for yank-rectangle to insert.")

(defun kill-rectangle (start end) "\
Delete rectangle with corners at point and mark; save as last killed one.
Calling from program, supply two args START and END, buffer positions.
But in programs you might prefer to use delete-extract-rectangle." (interactive "r") (byte-code "ÈÄ	
\"‰‡" [killed-rectangle start end nil delete-extract-rectangle] 3))

(defun yank-rectangle nil "\
Yank the last killed rectangle with upper left corner at point." (interactive) (byte-code "ÁˆÂ!‡" [killed-rectangle nil insert-rectangle] 2))

(defun insert-rectangle (rectangle) "\
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." (byte-code "	iÄ…H†7ÆÇ!ˆn†ÈcˆÉ
!ˆi
Vƒ)Ê
!‚*ňi
Wƒ6
j‚7ňʼnˆ@cˆA‰ˆ‚+‡" [lines rectangle insertcolumn first t nil forward-line 1 10 move-to-column rectangle-coerce-tab] 6))

(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." (interactive "r") (byte-code "ˆÃÄ	Â$‡" [start end nil operate-on-rectangle open-rectangle-line] 5))

(defun open-rectangle-line (startpos begextra endextra) (byte-code "Åi	
#bˆiÆÇ!ˆiZ\\‰)ˆÈ`ÉÇ!ˆ`\"ˆj)‡" [column begextra endextra startpos ocol + skip-chars-forward " 	" delete-region skip-chars-backward] 6))

(defun clear-rectangle (start end) "\
Blank out rectangle with corners at point and mark.
The text previously in the region is overwritten by the blanks." (interactive "r") (byte-code "ÈÄÅ	Â$‡" [start end t nil operate-on-rectangle clear-rectangle-line] 5))

(defun clear-rectangle-line (startpos begextra endextra) (byte-code "ÃÄ!ˆi	\\Å`
bˆÆÄ!ˆ`\"ˆj)‡" [column endextra startpos skip-chars-forward " 	" delete-region skip-chars-backward] 5))

(defun rectangle-coerce-tab (column) (byte-code "iÂÄÅ!ˆjˆÆZ!*‡" [aftercol indent-tabs-mode nil column delete-char -1 backward-char] 4))