home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Simtel MSDOS 1992 September
/
Simtel20_Sept92.cdr
/
msdos
/
editor
/
me_cd.arc
/
PICTURE.MUT
< prev
next >
Wrap
Lisp/Scheme
|
1988-09-07
|
24KB
|
720 lines
;; "Picture mode" -- editing using quarter-plane screen model.
;; Copyright (C) 1985 Free Software Foundation, Inc.
;; Principal author K. Shane Hartman
;; Converted to Mutt 6/88 C Durland
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;; Utilities ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Eliminate whitespace at ends of lines.
(defun remove-trailing-whitespace
{
(arg-prefix 9)(set-mark)
(beginning-of-buffer)
(re-query-replace '\ +$' "")
(arg-prefix 9)(exchange-dot-and-mark)
(msg "Removed trailing whitespace")
})
; move to the next tab stop in the tabs list
(defun tab-to-tab-stop (int num-tabs) (array byte tabs 1)
{
(int i col)
(col (current-column))
(for (i 0) (and (< i num-tabs)(>= col (tabs i))) (+= i 1) ())
(if (< i num-tabs) { (to-col (i (tabs i))) i } col)
})
(include asc.mut)
(include me.h)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;; Picture Movement Commands ;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Move to column in current line.
;; Differs from move-to-column in that it creates or modifies whitespace
;; if necessary to attain exactly the specified column.
(defun move-to-column-force (int column) HIDDEN
{
(current-column column) (to-col column)
})
;; Move forward n lines, creating new ones if needed
(defun pforward-line (int n) HIDDEN
{
(int oo)
(oo (overstrike))(overstrike 1)
(arg-prefix n)(newline)
(overstrike oo)
})
;; Position point after last non-blank character on current line.
;; With ARG not nil, move forward ARG - 1 lines first.
;; If scan reaches end of buffer, stop there without error.
(defun picture-end-of-line
{
(if (arg-flag) (forward-line (- (arg-prefix) 1)))
(end-of-line)
(if (previous-character)
{
(while (isspace) (previous-character))
(next-character)
})
})
;; Move cursor right, making whitespace if necessary.
;; With argument, move that many columns.
(defun picture-forward-column
{
(move-to-column-force (+ (current-column) (arg-prefix)))
})
;; Move cursor left, making whitespace if necessary.
;; With argument, move that many columns.
(defun picture-backward-column
{
(move-to-column-force (- (current-column) (arg-prefix)))
})
;; Move vertically down, making whitespace if necessary.
;; With argument, move that many lines.
(defun picture-move-down
{
(int col)
(col (current-column))
(pforward-line (arg-prefix))
(move-to-column-force col)
})
;; Move vertically up, making whitespace if necessary.
;; With argument, move that many lines.
(defun picture-move-up
{
(int col n)
(n (arg-prefix))
(col (current-column))
(while (>= (-= n 1) 0)
(if (not (forward-line -1)) ; at top of buffer
{ (beginning-of-buffer)(open-line) })
)
(move-to-column-force col)
})
;; Amount to move vertically after text character in Picture mode.
(int picture-vertical-step)
;; Amount to move horizontally after text character in Picture mode.
(int picture-horizontal-step)
;; Set VERTICAL and HORIZONTAL increments for movement in Picture mode.
;; The mode line is updated to reflect the current direction.
(defun picture-set-motion (int vert horiz) HIDDEN
{
(picture-vertical-step vert)
(picture-horizontal-step horiz)
; (setq mode-name
; (format "Picture:%s"
; (car (nthcdr (+ 1 (% horiz 2) (* 3 (1+ (% vert 2))))
; '(nw up ne left none right sw down se)))))
(msg "Picture: "
(switch (+ 1 horiz (* 3 (+ 1 vert)))
0 "NW"
1 "up"
2 "NE"
3 "left"
4 "none"
5 "right"
6 "SW"
7 "down"
8 "SE"
)
)
})
;; Move right after self-inserting character in Picture mode.
(defun picture-movement-right { (picture-set-motion 0 1) })
;; Move left after self-inserting character in Picture mode.
(defun picture-movement-left { (picture-set-motion 0 -1) })
;; Move up after self-inserting character in Picture mode.
(defun picture-movement-up { (picture-set-motion -1 0) })
;; Move down after self-inserting character in Picture mode.
(defun picture-movement-down { (picture-set-motion 1 0) })
;; Move up and left after self-inserting character in Picture mode.
(defun picture-movement-nw { (picture-set-motion -1 -1) })
;; Move up and right after self-inserting character in Picture mode.
(defun picture-movement-ne { (picture-set-motion -1 1) })
;; Move down and left after self-inserting character in Picture mode.
(defun picture-movement-sw { (picture-set-motion 1 -1) })
;; Move down and right after self-inserting character in Picture mode.
(defun picture-movement-se { (picture-set-motion 1 1) })
;; Move in direction of picture-vertical-step and picture-horizontal-step.
;; With ARG do it that many times.
;; Useful for delineating rectangles in conjunction with diagonal
;; picture motion.
;; Do apropos picture-movement to see commands which control motion.
(defun picture-move
{
(int col)
(col (+ (current-column) (* picture-horizontal-step (arg-prefix))))
(case
(< picture-vertical-step 0) (picture-move-up)
(> picture-vertical-step 0) (picture-move-down)
)
(move-to-column-force col)
})
;; Move point in direction opposite of current picture motion in Picture mode.
;; With ARG do it that many times.
;; Useful for delineating rectangles in conjunction with diagonal
;; picture motion.
;; Do apropos picture-movement to see commands which control motion.
(defun picture-move-reverse
{
(*= picture-vertical-step -1)(*= picture-horizontal-step -1)
(picture-move)
(*= picture-vertical-step -1)(*= picture-horizontal-step -1)
})
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;; Picture insertion and deletion ;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Insert character in place of character previously at the cursor.
;; The cursor then moves in the direction previously specified
;; with the picture-movement- commands.
;; Do apropos picture-movement to see those commands.
(defun picture-insert (string c)(int n) HIDDEN
{
(int i)
(i n)
(while (> i 0)
{
(-= i 1)
(move-to-column-force (+ 1 (current-column))) ; break up any tabs
(delete-previous-character)
(insert-text c)
(previous-character)
(arg-prefix 1)(picture-move)
})
})
(defun picture-self-insert
{
(string key 10)
(picture-insert (asc (key-pressed) key) (arg-prefix))
})
;; Clear out ARG columns after point without moving.
(defun picture-clear-column
{
(int col)
(set-mark)(msg "")
(col (current-column (+ (current-column) (arg-prefix))))
(erase-region)(to-col col)
(exchange-dot-and-mark)
})
;; Clear out ARG columns before point, moving back over them.
(defun picture-backward-clear-column
{
(if (== 1 (current-column)) (done)) ; no op if at begining of line
(move-to-column-force (- (current-column) (arg-prefix)))
(picture-clear-column)
})
;; Clear out rest of line; if at end of line, advance to next line.
;; Cleared-out line text goes into the kill ring, as do
;; newlines that are advanced over.
;; With argument, clear out (and save in kill ring) that many lines.
(defun picture-clear-line
{
(int n)
(if (arg-flag)
{
(arg-prefix (n (arg-prefix))) (kill-line)
(arg-prefix n)(newline)
}
{
(if (looking-at '.+$')(kill-line))
(append-to-register 0 "^J") ; tack a newline to end of killbuffer
(forward-line 1)
}
)
})
;; Move to the beginning of the following line.
;; With argument, moves that many lines (up, if negative argument).
;; Always moves to the beginning of a line.
(defun picture-newline
{
(int n)
(if (< (n (arg-prefix)) 0) ; negative arg => move up
(forward-line n)
(pforward-line n)
)
})
;; Insert an empty line after the current line.
;; With positive argument insert that many lines.
(defun picture-open-line
{
(int n)
(n (arg-prefix))
(arg-prefix 9)(set-mark)
(end-of-line)(arg-prefix n)(open-line)
(arg-prefix 9)(exchange-dot-and-mark)
(msg "")
})
;; Insert a duplicate of the current line, below it.
(defun picture-duplicate-line
{
(int col)
(col (current-column))
(beginning-of-line)(clear-register 0)
(arg-prefix 1)(kill-line)
(yank)(yank)
(forward-line -2)(current-column col)
})
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;; Picture Tabs ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; A character set which controls behavior of commands
;; (picture-set-tab-stops) and (picture-tab-search). It is NOT a
;; regular expression, any regexp special characters will be quoted.
;; It defines a set of "interesting characters" to look for when setting
;; (or searching for) tab stops, initially "!-~" (all printing characters).
;; For example, suppose that you are editing a table which is formatted thus:
;; | foo | bar + baz | 23 *
;; | bubbles | and + etc | 97 *
;; and that picture-tab-chars is "|+*". Then invoking
;; [picture-set-tab-stops] on either of the previous lines would result
;; in the following tab stops:
;; : : : :
;; Another example - "A-Za-z0-9" would produce the tab stops
;; : : : :
;; Note that if you want the character `-' to be in the set, it must be
;; included in a range or else appear in a context where it cannot be
;; taken for indicating a range (e.g. "-A-Z" declares the set to be the
;; letters `A' through `Z' and the character `-'). If you want the
;; character `\' in the set it must be preceded by itself: "\\".
;; The command (picture-tab-search) is defined to move beneath (or to) a
;; character belonging to this set independent of the tab stops list.
(const default-pic-tab-chars '-!~|')
(string picture-tab-chars 50)
(array byte pic-tabs 70)
(int num-pic-tabs)
;; Set value of tab-stop-list according to context of this line.
;; This controls the behavior of (picture-tab). A tab stop
;; is set at every column occupied by an "interesting character" that is
;; preceded by whitespace. Interesting characters are defined by the
;; variable picture-tab-chars, see its documentation for an example
;; of usage.
;; With ARG, just (re)set tab-stop-list to its default value.
;; The tab stops computed are displayed in the minibuffer with `:' at
;; each stop.
(defun sleeze-ball (array byte str 1) HIDDEN
{
(int i)
(for (i 0) (< i num-pic-tabs)(+= i 1) (str (- (pic-tabs i) 1) 0x3A)) ; ":"
str
})
(defun picture-set-tab-stops
{
(int i)
(string regexp 90)
;(if arg (setq tabs (default-value 'tab-stop-list))
(set-mark)
(regexp (concat '\ +[' picture-tab-chars "]"))
(beginning-of-line)
(for (num-pic-tabs 0)
(and (re-search-forward regexp)
(== DOT-ON-SAME-LINE-AS-MARK (compare-dot-and-mark)))
(+= num-pic-tabs 1)
(pic-tabs num-pic-tabs (- (current-column) 1))
;; ??? (skip-chars-forward " \t")
)
(exchange-dot-and-mark)
(if (== 0 num-pic-tabs)
{
(msg "No characters in set " picture-tab-chars " on this line.")
(done)
})
(msg (sleeze-ball " "))
})
;; Move to column beneath next interesting char in previous line.
;; The cursor stays in the current line.
;; With ARG move to column occupied by next interesting character in this
;; line. The character must be preceded by whitespace.
;; "Interesting characters" are defined by variable picture-tab-chars.
;; If no such character is found, move to beginning of line.
(defun picture-tab-search
{
(int i)
(string regexp 90)
(set-mark)(msg "")
(regexp (concat '\ +[' picture-tab-chars "]"))
(if (arg-flag)
{
(if (and (re-search-forward regexp)
(== DOT-ON-SAME-LINE-AS-MARK (compare-dot-and-mark)))
{ (previous-character)(done) })
}
{
(i (current-column))
(while TRUE ; look for non blank line
{
(if (forward-line -1)
{
(if (looking-at '^\ *$') (continue) ; blank line
(break) ; non blank line
)
})
(goto done) ; hit top of buffer
})
(current-column i)
(if (and (re-search-forward regexp)
(== DOT-ABOVE-MARK (compare-dot-and-mark)))
{
(i (current-column))
(exchange-dot-and-mark)
(move-to-column-force (- i 1))
(done)
})
})
(label done)
(exchange-dot-and-mark)(beginning-of-line)
})
;; Tab transparently (move) to next tab stop.
;; With ARG overwrite the traversed text with spaces.
;; The tab stop list can be changed by (picture-set-tab-stops) and
;; (edit-tab-stops).
;; See also documentation for variable picture-tab-chars.
(defun picture-tab
{
(int target)
(set-mark)(msg "")
(target (tab-to-tab-stop num-pic-tabs pic-tabs))
(erase-region)
(move-to-column-force target)
(if (arg-flag) { (erase-region)(to-col target) })
})
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;; Picture Rectangles ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Rectangle killed or copied by (picture-clear-rectangle) in Picture mode.
;; The contents can be retrieved by (picture-yank-rectangle)
(const picture-killed-rectangle 1)
;; Clear and save rectangle delineated by point and mark.
;; The rectangle is saved for yanking by picture-yank-rectangle and replaced
;; with whitespace. The previously saved rectangle, if any, is lost.
;; With prefix argument, the rectangle is actually killed, shifting remaining
;; text.
(defun picture-clear-rectangle
{
(copy-rectangle picture-killed-rectangle)(erase-rectangle (arg-flag))
})
;; Clear rectangle delineated by point and mark into REGISTER.
;; The rectangle is saved in REGISTER and replaced with whitespace.
;; With prefix argument, the rectangle is actually killed, shifting remaining
;; text.
(defun picture-clear-rectangle-to-register
{
(int n)
(n (atoi (ask "Rectangle to register: ")))
(copy-rectangle n) (erase-rectangle (arg-flag))
})
;; Overlay RECTANGLE with upper left corner at point.
;; Optional argument INSERTP, if non-nil causes RECTANGLE to be inserted.
;; Leaves the region surrounding the rectangle.
(defun picture-insert-rectangle (int rectangle) (bool insert) HIDDEN
{
(byte type)(int width height)(INT size)
(int col)
(register-stats rectangle (loc type))
(if (!= type 1) { (msg "Not a rectangle.") (done) })
(if (not insert)
{
(set-mark)(msg "")(col (current-column)) ; set mark at upper left column
; put dot as close as possible to lower right column
(forward-line (- height 1))(move-to-column-force (+ col width))
(erase-rectangle TRUE)
})
(insert-register rectangle)
})
;; Overlay rectangle saved by picture-clear-rectangle.
;; The rectangle is positioned with upper left corner at point, overwriting
;; existing text. With prefix argument, the rectangle is inserted instead,
;; shifting existing text. Leaves mark at one corner of rectangle and
;; point at the other (diagonally opposed) corner.
(defun picture-yank-rectangle
{
(picture-insert-rectangle picture-killed-rectangle (arg-flag))
})
;; Overlay rectangle saved in REGISTER.
;; The rectangle is positioned with upper left corner at point, overwriting
;; existing text.
;; With prefix argument, the rectangle is inserted instead, shifting existing text.
;; Leaves mark at one corner of rectangle and point at the other
;; (diagonally opposed) corner.
(defun picture-yank-rectangle-from-register
{
(int n)
(n (atoi (ask "Rectangle from register: ")))
(picture-insert-rectangle n (arg-flag))
})
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;; Misc goodies ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(const
UPPER-LEFT-CORNER "." UPPER-EDGE "-" UPPER-RIGHT-CORNER "."
LOWER-LEFT-CORNER "`" LOWER-EDGE "-" LOWER-RIGHT-CORNER "'"
LEFT-SIDE "|" RIGHT-SIDE "|"
)
;; Draw a box around the region-rectangle
(defun picture-box
{
(byte type)(int ulcol width height)(INT size)
(region-stats (loc type))
;; move dot to upper left corner of box
(if (== type MARK-ABOVE-DOT) (exchange-dot-and-mark))
(move-to-column-force ulcol)
(if (or (< (-= width 1) 1)(< (-= height 2) 1))
{ (msg "Box too small")(done) })
;; draw top of box
(picture-movement-right)
(picture-insert UPPER-LEFT-CORNER 1)(picture-insert UPPER-EDGE width)
;; draw right side of box
(picture-movement-down)
(picture-insert UPPER-RIGHT-CORNER 1)(picture-insert RIGHT-SIDE height)
;; draw bottom of box
(picture-movement-left)
(picture-insert LOWER-RIGHT-CORNER 1)(picture-insert LOWER-EDGE width)
;; draw left side of box
(picture-movement-up)
(picture-insert LOWER-LEFT-CORNER 1)(picture-insert LEFT-SIDE height)
;; finished
(picture-movement-right)
})
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;; Picture Keymap, entry and exit points ;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun pic-keymap HIDDEN
{
(int i)
(string str 10)
(prefix-key 2 "C-C")
(for (i 0x20) (< i 0x7F) (+= i 1)
(bind-local-key "picture-self-insert" (asc i str)))
(bind-local-key "picture-forward-column" "C-f")
(bind-local-key "picture-backward-column" "C-b")
(bind-local-key "picture-clear-column" "C-d")
(bind-local-key "delete-character" "C-cC-d")
(bind-local-key "picture-backward-clear-column" "C-H")
(bind-local-key "picture-clear-line" "C-k")
(bind-local-key "picture-open-line" "C-o")
(bind-local-key "picture-newline" "C-m")
(bind-local-key "picture-move-down" "C-n")
(bind-local-key "picture-move-up" "C-p")
(bind-local-key "picture-end-of-line" "C-e")
(bind-local-key "picture-duplicate-line" "C-j")
(bind-local-key "picture-tab" "C-I")
(bind-local-key "picture-tab-search" "M-C-I")
(bind-local-key "picture-set-tab-stops" "C-cC-i")
(bind-local-key "picture-mode-exit" "C-cC-c")
(bind-local-key "picture-move" "C-cC-f")
(bind-local-key "picture-move-reverse" "C-cC-b")
(bind-local-key "picture-movement-left" "C-c<")
(bind-local-key "picture-movement-right" "C-c>")
(bind-local-key "picture-movement-up" 'C-c^')
(bind-local-key "picture-movement-down" "C-c.")
(bind-local-key "picture-movement-nw" "C-c`")
(bind-local-key "picture-movement-ne" "C-c'")
(bind-local-key "picture-movement-sw" "C-c/")
(bind-local-key "picture-movement-se" "C-c\\")
(bind-local-key "picture-clear-rectangle" "C-cC-k")
(bind-local-key "picture-clear-rectangle-to-register" "C-cC-w")
(bind-local-key "picture-yank-rectangle" "C-cC-y")
(bind-local-key "picture-yank-rectangle-from-register" "C-cC-x")
})
(defun pic-unkeymap HIDDEN
{
(int i)
(string str 10)
(prefix-key 2 "S-")
(for (i 0x20) (< i 0x7F) (+= i 1)
(bind-local-key "" (asc i str)))
(bind-local-key "" "C-f")
(bind-local-key "" "C-b")
(bind-local-key "" "C-d")
(bind-local-key "" "C-cC-d")
(bind-local-key "" "C-H")
(bind-local-key "" "C-k")
(bind-local-key "" "C-o")
(bind-local-key "" "C-m")
(bind-local-key "" "C-j")
(bind-local-key "" "C-n")
(bind-local-key "" "C-p")
(bind-local-key "" "C-e")
(bind-local-key "" "C-I")
(bind-local-key "" "M-C-I")
(bind-local-key "" "C-cC-i")
(bind-local-key "" "C-cC-c")
(bind-local-key "" "C-cC-f")
(bind-local-key "" "C-cC-b")
(bind-local-key "" "C-c<")
(bind-local-key "" "C-c>")
(bind-local-key "" 'C-c^')
(bind-local-key "" "C-c.")
(bind-local-key "" "C-c`")
(bind-local-key "" "C-c'")
(bind-local-key "" "C-c/")
(bind-local-key "" "C-c\\")
(bind-local-key "" "C-cC-k")
(bind-local-key "" "C-cC-w")
(bind-local-key "" "C-cC-y")
(bind-local-key "" "C-cC-x")
})
;; Switch to Picture mode, in which a quarter-plane screen model is used.
;; Printing characters replace instead of inserting themselves with motion
;; afterwards settable by these commands:
;; C-c < Move left after insertion.
;; C-c > Move right after insertion.
;; C-c ^ Move up after insertion.
;; C-c . Move down after insertion.
;; C-c ` Move northwest (nw) after insertion.
;; C-c ' Move northeast (ne) after insertion.
;; C-c / Move southwest (sw) after insertion.
;; C-c \ Move southeast (se) after insertion.
;; The current direction is displayed in the mode line. The initial
;; direction is right. Whitespace is inserted and tabs are changed to
;; spaces when required by movement. You can move around in the buffer
;; with these commands:
;; C-p Move vertically to SAME column in previous line.
;; C-n Move vertically to SAME column in next line.
;; C-e Move to column following last non-whitespace character.
;; C-f Move right inserting spaces if required.
;; C-b Move left changing tabs to spaces if required.
;; C-c C-f Move in direction of current picture motion.
;; C-c C-b Move in opposite direction of current picture motion.
;; Return Move to beginning of next line.
;; You can edit tabular text with these commands:
;; M-Tab Move to column beneath (or at) next interesting character.
;; `Indents' relative to a previous line.
;; Tab Move to next stop in tab stop list.
;; C-c Tab Set tab stops according to context of this line.
;; With ARG resets tab stops to default (global) value.
;; See also documentation of variable picture-tab-chars
;; which defines "interesting character". You can manually
;; change the tab stop list with command [edit-tab-stops].
;; You can manipulate text with these commands:
;; C-d Clear (replace) ARG columns after point without moving.
;; C-c C-d Delete char at point - the command normally assigned to C-d.
;; Delete Clear (replace) ARG columns before point, moving back over them.
;; C-k Clear ARG lines, advancing over them. The cleared
;; text is saved in the kill ring.
;; C-o Open blank line(s) beneath current line.
;; You can manipulate rectangles with these commands:
;; C-c C-k Clear (or kill) a rectangle and save it.
;; C-c C-w Like C-c C-k except rectangle is saved in named register.
;; C-c C-y Overlay (or insert) currently saved rectangle at point.
;; C-c C-x Like C-c C-y except rectangle is taken from named register.
;; You can return to the previous mode with:
;; C-c C-c Which also strips trailing whitespace from every line.
;; Stripping is suppressed by supplying an argument.
;; Note that Picture mode commands will work outside of Picture mode, but
;; they are not defaultly assigned to keys.
(defun edit-picture
{
; (if (eq major-mode 'edit-picture)
; (error "You are already editing a Picture.")
(picture-set-motion 0 1)
(picture-tab-chars default-pic-tab-chars)
(num-pic-tabs 0)
(pic-keymap)
(msg "Picture mode")
})
;; Undo edit-picture and return to previous major mode.
;; With no argument strips whitespace from end of every line in Picture
;; buffer otherwise just return to previous mode.
(defun picture-mode-exit
; (if (not (eq major-mode 'edit-picture))
; (error "You aren't editing a Picture.")
; (if (not nostrip) (picture-clean))
{
(pic-unkeymap)
(remove-trailing-whitespace)
(msg "Picture done")
})