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