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