(toggle-truncate-lines): When turning off truncation,
[bpt/emacs.git] / lisp / textmodes / picture.el
CommitLineData
55535639 1;;; picture.el --- "Picture mode" -- editing using quarter-plane screen model
6594deb0 2
8f1204db 3;; Copyright (C) 1985, 1994 Free Software Foundation, Inc.
3a801d0c 4
e5167999
ER
5;; Author: K. Shane Hartman
6;; Maintainer: FSF
82168689 7;; Keywords: convenience wp
695d13c7
BP
8
9;; This file is part of GNU Emacs.
10
11;; GNU Emacs is free software; you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
e5167999 13;; the Free Software Foundation; either version 2, or (at your option)
695d13c7
BP
14;; any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
b578f267
EN
22;; along with GNU Emacs; see the file COPYING. If not, write to the
23;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24;; Boston, MA 02111-1307, USA.
695d13c7 25
edbd2f74
ER
26;;; Commentary:
27
eaae8106 28;; This code provides the picture-mode commands documented in the Emacs
edbd2f74
ER
29;; manual. The screen is treated as a semi-infinite quarter-plane with
30;; support for rectangle operations and `etch-a-sketch' character
31;; insertion in any of eight directions.
32
e5167999 33;;; Code:
695d13c7 34
d1ebc62e 35(defgroup picture nil
381194d0 36 "Picture mode --- editing using quarter-plane screen model."
d1ebc62e
SE
37 :prefix "picture-"
38 :group 'editing)
39
40(defcustom picture-rectangle-ctl ?+
41 "*Character `picture-draw-rectangle' uses for top left corners."
42 :type 'character
43 :group 'picture)
44(defcustom picture-rectangle-ctr ?+
45 "*Character `picture-draw-rectangle' uses for top right corners."
46 :type 'character
47 :group 'picture)
48(defcustom picture-rectangle-cbr ?+
49 "*Character `picture-draw-rectangle' uses for bottom right corners."
50 :type 'character
51 :group 'picture)
52(defcustom picture-rectangle-cbl ?+
53 "*Character `picture-draw-rectangle' uses for bottom left corners."
54 :type 'character
55 :group 'picture)
56(defcustom picture-rectangle-v ?|
57 "*Character `picture-draw-rectangle' uses for vertical lines."
58 :type 'character
59 :group 'picture)
60(defcustom picture-rectangle-h ?-
61 "*Character `picture-draw-rectangle' uses for horizontal lines."
62 :type 'character
63 :group 'picture)
64
695d13c7 65
695d13c7
BP
66;; Picture Movement Commands
67
2697c1f3
KH
68;; When a cursor is on a wide-column character (e.g. Chinese,
69;; Japanese, Korean), this variable tells the desired current column
70;; which may be different from (current-column).
71(defvar picture-desired-column 0)
72
73;; If the value of picture-desired-column is far from the current
74;; column, or if the arg ADJUST-TO-CURRENT is non-nil, set it to the
75;; current column. Return the current column.
76(defun picture-update-desired-column (adjust-to-current)
77 (let ((current-column (current-column)))
78 (if (or adjust-to-current
79 (< picture-desired-column (1- current-column))
80 (> picture-desired-column (1+ current-column)))
81 (setq picture-desired-column current-column))
82 current-column))
83
ca9c7579
ER
84(defun picture-beginning-of-line (&optional arg)
85 "Position point at the beginning of the line.
86With ARG not nil, move forward ARG - 1 lines first.
87If scan reaches end of buffer, stop there without error."
88 (interactive "P")
89 (if arg (forward-line (1- (prefix-numeric-value arg))))
90 (beginning-of-line)
5f6a0375 91 (setq picture-desired-column 0))
ca9c7579 92
695d13c7
BP
93(defun picture-end-of-line (&optional arg)
94 "Position point after last non-blank character on current line.
95With ARG not nil, move forward ARG - 1 lines first.
96If scan reaches end of buffer, stop there without error."
97 (interactive "P")
98 (if arg (forward-line (1- (prefix-numeric-value arg))))
99 (beginning-of-line)
ca9c7579 100 (skip-chars-backward " \t" (prog1 (point) (end-of-line)))
5f6a0375 101 (setq picture-desired-column (current-column)))
695d13c7 102
bac8c2e7 103(defun picture-forward-column (arg &optional interactive)
695d13c7
BP
104 "Move cursor right, making whitespace if necessary.
105With argument, move that many columns."
bac8c2e7 106 (interactive "p\nd")
4855897e
RS
107 (let (deactivate-mark)
108 (picture-update-desired-column interactive)
109 (setq picture-desired-column (max 0 (+ picture-desired-column arg)))
110 (let ((current-column (move-to-column picture-desired-column t)))
111 (if (and (> current-column picture-desired-column)
112 (< arg 0))
113 ;; It seems that we have just tried to move to the right
114 ;; column of a multi-column character.
115 (forward-char -1)))))
695d13c7 116
bac8c2e7 117(defun picture-backward-column (arg &optional interactive)
695d13c7
BP
118 "Move cursor left, making whitespace if necessary.
119With argument, move that many columns."
bac8c2e7
RS
120 (interactive "p\nd")
121 (picture-update-desired-column interactive)
ad8fb8ae 122 (picture-forward-column (- arg)))
695d13c7
BP
123
124(defun picture-move-down (arg)
125 "Move vertically down, making whitespace if necessary.
126With argument, move that many lines."
127 (interactive "p")
4855897e
RS
128 (let (deactivate-mark)
129 (picture-update-desired-column nil)
130 (picture-newline arg)
131 (let ((current-column (move-to-column picture-desired-column t)))
132 (if (> current-column picture-desired-column)
133 (forward-char -1)))))
695d13c7 134
99b3bc61 135(defvar picture-vertical-step 0
695d13c7
BP
136 "Amount to move vertically after text character in Picture mode.")
137
99b3bc61 138(defvar picture-horizontal-step 1
695d13c7
BP
139 "Amount to move horizontally after text character in Picture mode.")
140
141(defun picture-move-up (arg)
142 "Move vertically up, making whitespace if necessary.
143With argument, move that many lines."
144 (interactive "p")
2697c1f3 145 (picture-update-desired-column nil)
695d13c7
BP
146 (picture-move-down (- arg)))
147
148(defun picture-movement-right ()
149 "Move right after self-inserting character in Picture mode."
150 (interactive)
151 (picture-set-motion 0 1))
152
153(defun picture-movement-left ()
154 "Move left after self-inserting character in Picture mode."
155 (interactive)
156 (picture-set-motion 0 -1))
157
158(defun picture-movement-up ()
159 "Move up after self-inserting character in Picture mode."
160 (interactive)
161 (picture-set-motion -1 0))
162
163(defun picture-movement-down ()
164 "Move down after self-inserting character in Picture mode."
165 (interactive)
166 (picture-set-motion 1 0))
167
2697c1f3
KH
168(defun picture-movement-nw (&optional arg)
169 "Move up and left after self-inserting character in Picture mode.
170With prefix argument, move up and two-column left."
171 (interactive "P")
172 (picture-set-motion -1 (if arg -2 -1)))
695d13c7 173
2697c1f3
KH
174(defun picture-movement-ne (&optional arg)
175 "Move up and right after self-inserting character in Picture mode.
176With prefix argument, move up and two-column right."
177 (interactive "P")
178 (picture-set-motion -1 (if arg 2 1)))
695d13c7 179
2697c1f3
KH
180(defun picture-movement-sw (&optional arg)
181 "Move down and left after self-inserting character in Picture mode.
182With prefix argument, move down and two-column left."
183 (interactive "P")
184 (picture-set-motion 1 (if arg -2 -1)))
695d13c7 185
2697c1f3
KH
186(defun picture-movement-se (&optional arg)
187 "Move down and right after self-inserting character in Picture mode.
188With prefix argument, move down and two-column right."
189 (interactive "P")
190 (picture-set-motion 1 (if arg 2 1)))
695d13c7
BP
191
192(defun picture-set-motion (vert horiz)
193 "Set VERTICAL and HORIZONTAL increments for movement in Picture mode.
194The mode line is updated to reflect the current direction."
195 (setq picture-vertical-step vert
196 picture-horizontal-step horiz)
197 (setq mode-name
198 (format "Picture:%s"
2697c1f3
KH
199 (nth (+ 2 (% horiz 3) (* 5 (1+ (% vert 2))))
200 '(wnw nw up ne ene Left left none right Right
201 wsw sw down se ese))))
00dbaf0a 202 (force-mode-line-update)
695d13c7
BP
203 (message ""))
204
205(defun picture-move ()
206 "Move in direction of `picture-vertical-step' and `picture-horizontal-step'."
2697c1f3
KH
207 (if (/= picture-vertical-step 0)
208 (picture-move-down picture-vertical-step))
209 (if (/= picture-horizontal-step 0)
210 (picture-forward-column picture-horizontal-step)))
695d13c7
BP
211
212(defun picture-motion (arg)
213 "Move point in direction of current picture motion in Picture mode.
214With ARG do it that many times. Useful for delineating rectangles in
215conjunction with diagonal picture motion.
216Do \\[command-apropos] picture-movement to see commands which control motion."
217 (interactive "p")
218 (picture-move-down (* arg picture-vertical-step))
219 (picture-forward-column (* arg picture-horizontal-step)))
220
221(defun picture-motion-reverse (arg)
222 "Move point in direction opposite of current picture motion in Picture mode.
223With ARG do it that many times. Useful for delineating rectangles in
224conjunction with diagonal picture motion.
225Do \\[command-apropos] `picture-movement' to see commands which control motion."
226 (interactive "p")
227 (picture-motion (- arg)))
228
229\f
230;; Picture insertion and deletion.
231
d792910f 232(defun picture-insert (ch arg)
2697c1f3
KH
233 (let* ((width (char-width ch))
234 ;; We must be sure that the succeeding insertion won't delete
235 ;; the just inserted character.
236 (picture-horizontal-step
237 (if (and (= picture-vertical-step 0)
238 (> width 1)
239 (< (abs picture-horizontal-step) 2))
240 (* picture-horizontal-step 2)
241 picture-horizontal-step)))
242 (while (> arg 0)
243 (setq arg (1- arg))
244 (if (/= picture-desired-column (current-column))
5ed5b2c2 245 (move-to-column picture-desired-column t))
2697c1f3
KH
246 (let ((col (+ picture-desired-column width)))
247 (or (eolp)
248 (let ((pos (point)))
5ed5b2c2 249 (move-to-column col t)
2697c1f3
KH
250 (delete-region pos (point)))))
251 (insert ch)
252 (forward-char -1)
253 (picture-move))))
d792910f 254
695d13c7
BP
255(defun picture-self-insert (arg)
256 "Insert this character in place of character previously at the cursor.
257The cursor then moves in the direction you previously specified
258with the commands `picture-movement-right', `picture-movement-up', etc.
259Do \\[command-apropos] `picture-movement' to see those commands."
260 (interactive "p")
2697c1f3 261 (picture-update-desired-column (not (eq this-command last-command)))
d792910f 262 (picture-insert last-command-event arg)) ; Always a character in this case.
695d13c7
BP
263
264(defun picture-clear-column (arg)
265 "Clear out ARG columns after point without moving."
266 (interactive "p")
2697c1f3
KH
267 (let* ((original-col (current-column))
268 (target-col (max 0 (+ original-col arg)))
269 pos)
5ed5b2c2 270 (move-to-column target-col t)
2697c1f3
KH
271 (setq pos (point))
272 (move-to-column original-col)
273 (delete-region pos (point))
695d13c7 274 (save-excursion
2697c1f3
KH
275 (indent-to (max target-col original-col))))
276 (setq picture-desired-column (current-column)))
695d13c7
BP
277
278(defun picture-backward-clear-column (arg)
279 "Clear out ARG columns before point, moving back over them."
280 (interactive "p")
281 (picture-clear-column (- arg)))
282
283(defun picture-clear-line (arg)
284 "Clear out rest of line; if at end of line, advance to next line.
285Cleared-out line text goes into the kill ring, as do newlines that are
286advanced over. With argument, clear out (and save in kill ring) that
287many lines."
288 (interactive "P")
289 (if arg
290 (progn
291 (setq arg (prefix-numeric-value arg))
292 (kill-line arg)
293 (newline (if (> arg 0) arg (- arg))))
294 (if (looking-at "[ \t]*$")
295 (kill-ring-save (point) (progn (forward-line 1) (point)))
296 (kill-region (point) (progn (end-of-line) (point))))))
297
298(defun picture-newline (arg)
299 "Move to the beginning of the following line.
300With argument, moves that many lines (up, if negative argument);
301always moves to the beginning of a line."
302 (interactive "p")
303 (if (< arg 0)
304 (forward-line arg)
305 (while (> arg 0)
306 (end-of-line)
307 (if (eobp) (newline) (forward-char 1))
5f6a0375 308 (setq arg (1- arg)))))
695d13c7
BP
309
310(defun picture-open-line (arg)
311 "Insert an empty line after the current line.
312With positive argument insert that many lines."
313 (interactive "p")
314 (save-excursion
315 (end-of-line)
5f6a0375 316 (open-line arg)))
695d13c7
BP
317
318(defun picture-duplicate-line ()
319 "Insert a duplicate of the current line, below it."
320 (interactive)
321 (save-excursion
322 (let ((contents
323 (buffer-substring
324 (progn (beginning-of-line) (point))
325 (progn (picture-newline 1) (point)))))
326 (forward-line -1)
327 (insert contents))))
328
5c927015
RS
329;; Like replace-match, but overwrites.
330(defun picture-replace-match (newtext fixedcase literal)
331 (let (ocolumn change pos)
332 (goto-char (setq pos (match-end 0)))
333 (setq ocolumn (current-column))
334 ;; Make the replacement and undo it, to see how it changes the length.
335 (let ((buffer-undo-list nil)
336 list1)
337 (replace-match newtext fixedcase literal)
338 (setq change (- (current-column) ocolumn))
339 (setq list1 buffer-undo-list)
340 (while list1
341 (setq list1 (primitive-undo 1 list1))))
342 (goto-char pos)
343 (if (> change 0)
344 (delete-region (point)
345 (progn
d792910f 346 (move-to-column (+ change (current-column)) t)
5c927015
RS
347 (point))))
348 (replace-match newtext fixedcase literal)
349 (if (< change 0)
350 (insert-char ?\ (- change)))))
695d13c7
BP
351\f
352;; Picture Tabs
353
d1ebc62e
SE
354(defcustom picture-tab-chars "!-~"
355 "*A character set which controls behavior of commands.
695d13c7
BP
356\\[picture-set-tab-stops] and \\[picture-tab-search]. It is NOT a
357regular expression, any regexp special characters will be quoted.
358It defines a set of \"interesting characters\" to look for when setting
359\(or searching for) tab stops, initially \"!-~\" (all printing characters).
360For example, suppose that you are editing a table which is formatted thus:
361| foo | bar + baz | 23 *
362| bubbles | and + etc | 97 *
363and that `picture-tab-chars' is \"|+*\". Then invoking
364\\[picture-set-tab-stops] on either of the previous lines would result
365in the following tab stops
366 : : : :
367Another example - \"A-Za-z0-9\" would produce the tab stops
368 : : : :
369
370Note that if you want the character `-' to be in the set, it must be
371included in a range or else appear in a context where it cannot be
372taken for indicating a range (e.g. \"-A-Z\" declares the set to be the
373letters `A' through `Z' and the character `-'). If you want the
374character `\\' in the set it must be preceded by itself: \"\\\\\".
375
376The command \\[picture-tab-search] is defined to move beneath (or to) a
d1ebc62e
SE
377character belonging to this set independent of the tab stops list."
378 :type 'string
379 :group 'picture)
695d13c7
BP
380
381(defun picture-set-tab-stops (&optional arg)
382 "Set value of `tab-stop-list' according to context of this line.
383This controls the behavior of \\[picture-tab]. A tab stop is set at
384every column occupied by an \"interesting character\" that is preceded
385by whitespace. Interesting characters are defined by the variable
386`picture-tab-chars', see its documentation for an example of usage.
387With ARG, just (re)set `tab-stop-list' to its default value. The tab
388stops computed are displayed in the minibuffer with `:' at each stop."
389 (interactive "P")
390 (save-excursion
391 (let (tabs)
392 (if arg
393 (setq tabs (default-value 'tab-stop-list))
394 (let ((regexp (concat "[ \t]+[" (regexp-quote picture-tab-chars) "]")))
395 (beginning-of-line)
396 (let ((bol (point)))
397 (end-of-line)
398 (while (re-search-backward regexp bol t)
399 (skip-chars-forward " \t")
400 (setq tabs (cons (current-column) tabs)))
401 (if (null tabs)
55535639 402 (error "No characters in set %s on this line"
695d13c7
BP
403 (regexp-quote picture-tab-chars))))))
404 (setq tab-stop-list tabs)
405 (let ((blurb (make-string (1+ (nth (1- (length tabs)) tabs)) ?\ )))
406 (while tabs
407 (aset blurb (car tabs) ?:)
408 (setq tabs (cdr tabs)))
409 (message blurb)))))
410
411(defun picture-tab-search (&optional arg)
412 "Move to column beneath next interesting char in previous line.
413With ARG move to column occupied by next interesting character in this
414line. The character must be preceded by whitespace.
415\"interesting characters\" are defined by variable `picture-tab-chars'.
416If no such character is found, move to beginning of line."
417 (interactive "P")
418 (let ((target (current-column)))
419 (save-excursion
420 (if (and (not arg)
421 (progn
422 (beginning-of-line)
423 (skip-chars-backward
424 (concat "^" (regexp-quote picture-tab-chars))
425 (point-min))
426 (not (bobp))))
427 (move-to-column target))
428 (if (re-search-forward
429 (concat "[ \t]+[" (regexp-quote picture-tab-chars) "]")
430 (save-excursion (end-of-line) (point))
431 'move)
432 (setq target (1- (current-column)))
433 (setq target nil)))
434 (if target
d792910f 435 (move-to-column target t)
695d13c7
BP
436 (beginning-of-line))))
437
438(defun picture-tab (&optional arg)
439 "Tab transparently (just move point) to next tab stop.
440With prefix arg, overwrite the traversed text with spaces. The tab stop
441list can be changed by \\[picture-set-tab-stops] and \\[edit-tab-stops].
442See also documentation for variable `picture-tab-chars'."
443 (interactive "P")
444 (let* ((opoint (point)))
445 (move-to-tab-stop)
446 (if arg
447 (let (indent-tabs-mode
448 (column (current-column)))
449 (delete-region opoint (point))
450 (indent-to column)))))
451\f
452;; Picture Rectangles
453
238b647a 454(defvar picture-killed-rectangle nil
695d13c7
BP
455 "Rectangle killed or copied by \\[picture-clear-rectangle] in Picture mode.
456The contents can be retrieved by \\[picture-yank-rectangle]")
457
458(defun picture-clear-rectangle (start end &optional killp)
459 "Clear and save rectangle delineated by point and mark.
460The rectangle is saved for yanking by \\[picture-yank-rectangle] and replaced
461with whitespace. The previously saved rectangle, if any, is lost. With
462prefix argument, the rectangle is actually killed, shifting remaining text."
463 (interactive "r\nP")
464 (setq picture-killed-rectangle (picture-snarf-rectangle start end killp)))
465
466(defun picture-clear-rectangle-to-register (start end register &optional killp)
467 "Clear rectangle delineated by point and mark into REGISTER.
468The rectangle is saved in REGISTER and replaced with whitespace. With
469prefix argument, the rectangle is actually killed, shifting remaining text."
470 (interactive "r\ncRectangle to register: \nP")
471 (set-register register (picture-snarf-rectangle start end killp)))
472
473(defun picture-snarf-rectangle (start end &optional killp)
474 (let ((column (current-column))
475 (indent-tabs-mode nil))
476 (prog1 (save-excursion
477 (if killp
478 (delete-extract-rectangle start end)
479 (prog1 (extract-rectangle start end)
480 (clear-rectangle start end))))
d792910f 481 (move-to-column column t))))
695d13c7
BP
482
483(defun picture-yank-rectangle (&optional insertp)
484 "Overlay rectangle saved by \\[picture-clear-rectangle]
485The rectangle is positioned with upper left corner at point, overwriting
486existing text. With prefix argument, the rectangle is inserted instead,
487shifting existing text. Leaves mark at one corner of rectangle and
488point at the other (diagonally opposed) corner."
489 (interactive "P")
490 (if (not (consp picture-killed-rectangle))
55535639 491 (error "No rectangle saved")
695d13c7
BP
492 (picture-insert-rectangle picture-killed-rectangle insertp)))
493
2ee658c3
RS
494(defun picture-yank-at-click (click arg)
495 "Insert the last killed rectangle at the position clicked on.
496Also move point to one end of the text thus inserted (normally the end).
497Prefix arguments are interpreted as with \\[yank].
498If `mouse-yank-at-point' is non-nil, insert at point
499regardless of where you click."
500 (interactive "e\nP")
501 (or mouse-yank-at-point (mouse-set-point click))
502 (picture-yank-rectangle arg))
503
695d13c7
BP
504(defun picture-yank-rectangle-from-register (register &optional insertp)
505 "Overlay rectangle saved in REGISTER.
506The rectangle is positioned with upper left corner at point, overwriting
507existing text. With prefix argument, the rectangle is
508inserted instead, shifting existing text. Leaves mark at one corner
509of rectangle and point at the other (diagonally opposed) corner."
510 (interactive "cRectangle from register: \nP")
511 (let ((rectangle (get-register register)))
512 (if (not (consp rectangle))
55535639 513 (error "Register %c does not contain a rectangle" register)
695d13c7
BP
514 (picture-insert-rectangle rectangle insertp))))
515
516(defun picture-insert-rectangle (rectangle &optional insertp)
517 "Overlay RECTANGLE with upper left corner at point.
518Optional argument INSERTP, if non-nil causes RECTANGLE to be inserted.
519Leaves the region surrounding the rectangle."
520 (let ((indent-tabs-mode nil))
521 (if (not insertp)
522 (save-excursion
523 (delete-rectangle (point)
524 (progn
525 (picture-forward-column (length (car rectangle)))
526 (picture-move-down (1- (length rectangle)))
527 (point)))))
528 (push-mark)
529 (insert-rectangle rectangle)))
530
d792910f
RS
531(defun picture-current-line ()
532 "Return the vertical position of point. Top line is 1."
533 (+ (count-lines (point-min) (point))
534 (if (= (current-column) 0) 1 0)))
535
536(defun picture-draw-rectangle (start end)
537 "Draw a rectangle around region."
538 (interactive "*r") ; start will be less than end
539 (let* ((sl (picture-current-line))
540 (sc (current-column))
541 (pvs picture-vertical-step)
542 (phs picture-horizontal-step)
543 (c1 (progn (goto-char start) (current-column)))
544 (r1 (picture-current-line))
545 (c2 (progn (goto-char end) (current-column)))
546 (r2 (picture-current-line))
547 (right (max c1 c2))
548 (left (min c1 c2))
549 (top (min r1 r2))
550 (bottom (max r1 r2)))
551 (goto-line top)
5ed5b2c2 552 (move-to-column left t)
2697c1f3 553 (picture-update-desired-column t)
d792910f
RS
554
555 (picture-movement-right)
556 (picture-insert picture-rectangle-ctl 1)
2697c1f3 557 (picture-insert picture-rectangle-h (- right picture-desired-column))
d792910f
RS
558
559 (picture-movement-down)
560 (picture-insert picture-rectangle-ctr 1)
561 (picture-insert picture-rectangle-v (- bottom (picture-current-line)))
562
563 (picture-movement-left)
564 (picture-insert picture-rectangle-cbr 1)
2697c1f3 565 (picture-insert picture-rectangle-h (- picture-desired-column left))
d792910f
RS
566
567 (picture-movement-up)
568 (picture-insert picture-rectangle-cbl 1)
569 (picture-insert picture-rectangle-v (- (picture-current-line) top))
570
571 (picture-set-motion pvs phs)
572 (goto-line sl)
573 (move-to-column sc t)))
574
695d13c7
BP
575\f
576;; Picture Keymap, entry and exit points.
577
2137e978 578(defvar picture-mode-map nil)
695d13c7 579
ca9c7579
ER
580(defun picture-substitute (oldfun newfun)
581 (substitute-key-definition oldfun newfun picture-mode-map global-map))
582
695d13c7 583(if (not picture-mode-map)
0ad0f28f 584 (progn
2697c1f3 585 (setq picture-mode-map (make-keymap))
0ad0f28f 586 (picture-substitute 'self-insert-command 'picture-self-insert)
2ae00b00
RS
587 (picture-substitute 'completion-separator-self-insert-command
588 'picture-self-insert)
589 (picture-substitute 'completion-separator-self-insert-autofilling
590 'picture-self-insert)
ca9c7579
ER
591 (picture-substitute 'forward-char 'picture-forward-column)
592 (picture-substitute 'backward-char 'picture-backward-column)
593 (picture-substitute 'delete-char 'picture-clear-column)
47bad81c 594 ;; There are two possibilities for what is normally on DEL.
ca9c7579 595 (picture-substitute 'backward-delete-char-untabify 'picture-backward-clear-column)
47bad81c 596 (picture-substitute 'delete-backward-char 'picture-backward-clear-column)
ca9c7579
ER
597 (picture-substitute 'kill-line 'picture-clear-line)
598 (picture-substitute 'open-line 'picture-open-line)
599 (picture-substitute 'newline 'picture-newline)
0ad0f28f 600 (picture-substitute 'newline-and-indent 'picture-duplicate-line)
ca9c7579
ER
601 (picture-substitute 'next-line 'picture-move-down)
602 (picture-substitute 'previous-line 'picture-move-up)
603 (picture-substitute 'beginning-of-line 'picture-beginning-of-line)
604 (picture-substitute 'end-of-line 'picture-end-of-line)
605
695d13c7 606 (define-key picture-mode-map "\C-c\C-d" 'delete-char)
695d13c7
BP
607 (define-key picture-mode-map "\e\t" 'picture-toggle-tab-state)
608 (define-key picture-mode-map "\t" 'picture-tab)
609 (define-key picture-mode-map "\e\t" 'picture-tab-search)
610 (define-key picture-mode-map "\C-c\t" 'picture-set-tab-stops)
611 (define-key picture-mode-map "\C-c\C-k" 'picture-clear-rectangle)
612 (define-key picture-mode-map "\C-c\C-w" 'picture-clear-rectangle-to-register)
613 (define-key picture-mode-map "\C-c\C-y" 'picture-yank-rectangle)
614 (define-key picture-mode-map "\C-c\C-x" 'picture-yank-rectangle-from-register)
d792910f 615 (define-key picture-mode-map "\C-c\C-r" 'picture-draw-rectangle)
695d13c7
BP
616 (define-key picture-mode-map "\C-c\C-c" 'picture-mode-exit)
617 (define-key picture-mode-map "\C-c\C-f" 'picture-motion)
618 (define-key picture-mode-map "\C-c\C-b" 'picture-motion-reverse)
619 (define-key picture-mode-map "\C-c<" 'picture-movement-left)
620 (define-key picture-mode-map "\C-c>" 'picture-movement-right)
621 (define-key picture-mode-map "\C-c^" 'picture-movement-up)
622 (define-key picture-mode-map "\C-c." 'picture-movement-down)
623 (define-key picture-mode-map "\C-c`" 'picture-movement-nw)
624 (define-key picture-mode-map "\C-c'" 'picture-movement-ne)
625 (define-key picture-mode-map "\C-c/" 'picture-movement-sw)
626 (define-key picture-mode-map "\C-c\\" 'picture-movement-se)))
627
d1ebc62e 628(defcustom picture-mode-hook nil
ca9c7579 629 "If non-nil, its value is called on entry to Picture mode.
d1ebc62e
SE
630Picture mode is invoked by the command \\[picture-mode]."
631 :type 'hook
632 :group 'picture)
695d13c7 633
c4fc49b6
RS
634(defvar picture-mode-old-local-map)
635(defvar picture-mode-old-mode-name)
636(defvar picture-mode-old-major-mode)
b9911289 637(defvar picture-mode-old-truncate-lines)
c4fc49b6 638
7229064d 639;;;###autoload
ca9c7579 640(defun picture-mode ()
695d13c7
BP
641 "Switch to Picture mode, in which a quarter-plane screen model is used.
642Printing characters replace instead of inserting themselves with motion
643afterwards settable by these commands:
644 C-c < Move left after insertion.
645 C-c > Move right after insertion.
646 C-c ^ Move up after insertion.
647 C-c . Move down after insertion.
648 C-c ` Move northwest (nw) after insertion.
649 C-c ' Move northeast (ne) after insertion.
650 C-c / Move southwest (sw) after insertion.
651 C-c \\ Move southeast (se) after insertion.
2697c1f3
KH
652 C-u C-c ` Move westnorthwest (wnw) after insertion.
653 C-u C-c ' Move eastnortheast (ene) after insertion.
654 C-u C-c / Move westsouthwest (wsw) after insertion.
655 C-u C-c \\ Move eastsoutheast (ese) after insertion.
695d13c7
BP
656The current direction is displayed in the mode line. The initial
657direction is right. Whitespace is inserted and tabs are changed to
658spaces when required by movement. You can move around in the buffer
659with these commands:
ca9c7579
ER
660 \\[picture-move-down] Move vertically to SAME column in previous line.
661 \\[picture-move-up] Move vertically to SAME column in next line.
662 \\[picture-end-of-line] Move to column following last non-whitespace character.
663 \\[picture-forward-column] Move right inserting spaces if required.
664 \\[picture-backward-column] Move left changing tabs to spaces if required.
695d13c7
BP
665 C-c C-f Move in direction of current picture motion.
666 C-c C-b Move in opposite direction of current picture motion.
667 Return Move to beginning of next line.
668You can edit tabular text with these commands:
669 M-Tab Move to column beneath (or at) next interesting character.
670 `Indents' relative to a previous line.
671 Tab Move to next stop in tab stop list.
672 C-c Tab Set tab stops according to context of this line.
673 With ARG resets tab stops to default (global) value.
674 See also documentation of variable picture-tab-chars
675 which defines \"interesting character\". You can manually
676 change the tab stop list with command \\[edit-tab-stops].
677You can manipulate text with these commands:
678 C-d Clear (replace) ARG columns after point without moving.
679 C-c C-d Delete char at point - the command normally assigned to C-d.
ca9c7579
ER
680 \\[picture-backward-clear-column] Clear (replace) ARG columns before point, moving back over them.
681 \\[picture-clear-line] Clear ARG lines, advancing over them. The cleared
695d13c7 682 text is saved in the kill ring.
ca9c7579 683 \\[picture-open-line] Open blank line(s) beneath current line.
695d13c7
BP
684You can manipulate rectangles with these commands:
685 C-c C-k Clear (or kill) a rectangle and save it.
686 C-c C-w Like C-c C-k except rectangle is saved in named register.
687 C-c C-y Overlay (or insert) currently saved rectangle at point.
688 C-c C-x Like C-c C-y except rectangle is taken from named register.
d792910f 689 C-c C-r Draw a rectangular box around mark and point.
695d13c7
BP
690 \\[copy-rectangle-to-register] Copies a rectangle to a register.
691 \\[advertised-undo] Can undo effects of rectangle overlay commands
692 commands if invoked soon enough.
693You can return to the previous mode with:
694 C-c C-c Which also strips trailing whitespace from every line.
695 Stripping is suppressed by supplying an argument.
696
e444e0d6 697Entry to this mode calls the value of `picture-mode-hook' if non-nil.
695d13c7
BP
698
699Note that Picture mode commands will work outside of Picture mode, but
700they are not defaultly assigned to keys."
701 (interactive)
ca9c7579 702 (if (eq major-mode 'picture-mode)
55535639 703 (error "You are already editing a picture")
e444e0d6 704 (set (make-local-variable 'picture-mode-old-local-map) (current-local-map))
695d13c7 705 (use-local-map picture-mode-map)
e444e0d6
SM
706 (set (make-local-variable 'picture-mode-old-mode-name) mode-name)
707 (set (make-local-variable 'picture-mode-old-major-mode) major-mode)
ca9c7579 708 (setq major-mode 'picture-mode)
e444e0d6
SM
709 (set (make-local-variable 'picture-killed-rectangle) nil)
710 (set (make-local-variable 'tab-stop-list) (default-value 'tab-stop-list))
711 (set (make-local-variable 'picture-tab-chars)
712 (default-value 'picture-tab-chars))
695d13c7
BP
713 (make-local-variable 'picture-vertical-step)
714 (make-local-variable 'picture-horizontal-step)
e444e0d6 715 (set (make-local-variable 'picture-mode-old-truncate-lines) truncate-lines)
ca9c7579 716 (setq truncate-lines t)
695d13c7 717 (picture-set-motion 0 1)
ca9c7579 718
e0dad66e
RS
719 ;; edit-picture-hook is what we used to run, picture-mode-hook is in doc.
720 (run-hooks 'edit-picture-hook 'picture-mode-hook)
d55235bb
KH
721 (message "Type %s in this buffer to return it to %s mode."
722 (substitute-command-keys "\\[picture-mode-exit]")
723 picture-mode-old-mode-name)))
695d13c7 724
6503cec3 725;;;###autoload
ca9c7579 726(defalias 'edit-picture 'picture-mode)
695d13c7
BP
727
728(defun picture-mode-exit (&optional nostrip)
2137e978 729 "Undo `picture-mode' and return to previous major mode.
695d13c7
BP
730With no argument strips whitespace from end of every line in Picture buffer
731 otherwise just return to previous mode."
732 (interactive "P")
ca9c7579 733 (if (not (eq major-mode 'picture-mode))
55535639 734 (error "You aren't editing a Picture")
eaae8106 735 (if (not nostrip) (delete-trailing-whitespace))
695d13c7
BP
736 (setq mode-name picture-mode-old-mode-name)
737 (use-local-map picture-mode-old-local-map)
738 (setq major-mode picture-mode-old-major-mode)
739 (kill-local-variable 'tab-stop-list)
b9911289 740 (setq truncate-lines picture-mode-old-truncate-lines)
00dbaf0a 741 (force-mode-line-update)))
695d13c7 742
49116ac0
JB
743(provide 'picture)
744
6594deb0 745;;; picture.el ends here