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