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