Lines Matching refs:picture
0 ;;; picture.el --- "Picture mode" -- editing using quarter-plane screen model
29 ;; This code provides the picture-mode commands documented in the Emacs
36 (defgroup picture nil
38 :prefix "picture-"
41 (defcustom picture-rectangle-ctl ?+
42 "*Character `picture-draw-rectangle' uses for top left corners."
44 :group 'picture)
45 (defcustom picture-rectangle-ctr ?+
46 "*Character `picture-draw-rectangle' uses for top right corners."
48 :group 'picture)
49 (defcustom picture-rectangle-cbr ?+
50 "*Character `picture-draw-rectangle' uses for bottom right corners."
52 :group 'picture)
53 (defcustom picture-rectangle-cbl ?+
54 "*Character `picture-draw-rectangle' uses for bottom left corners."
56 :group 'picture)
57 (defcustom picture-rectangle-v ?|
58 "*Character `picture-draw-rectangle' uses for vertical lines."
60 :group 'picture)
61 (defcustom picture-rectangle-h ?-
62 "*Character `picture-draw-rectangle' uses for horizontal lines."
64 :group 'picture)
72 (defvar picture-desired-column 0)
74 ;; If the value of picture-desired-column is far from the current
77 (defun picture-update-desired-column (adjust-to-current)
80 (< picture-desired-column (1- current-column))
81 (> picture-desired-column (1+ current-column)))
82 (setq picture-desired-column current-column))
85 (defun picture-beginning-of-line (&optional arg)
92 (setq picture-desired-column 0))
94 (defun picture-end-of-line (&optional arg)
102 (setq picture-desired-column (current-column)))
104 (defun picture-forward-column (arg &optional interactive)
109 (picture-update-desired-column interactive)
110 (setq picture-desired-column (max 0 (+ picture-desired-column arg)))
111 (let ((current-column (move-to-column picture-desired-column t)))
112 (if (and (> current-column picture-desired-column)
118 (defun picture-backward-column (arg &optional interactive)
122 (picture-update-desired-column interactive)
123 (picture-forward-column (- arg)))
125 (defun picture-move-down (arg)
130 (picture-update-desired-column nil)
131 (picture-newline arg)
132 (let ((current-column (move-to-column picture-desired-column t)))
133 (if (> current-column picture-desired-column)
136 (defvar picture-vertical-step 0
139 (defvar picture-horizontal-step 1
142 (defun picture-move-up (arg)
146 (picture-update-desired-column nil)
147 (picture-move-down (- arg)))
149 (defun picture-movement-right ()
152 (picture-set-motion 0 1))
154 (defun picture-movement-left ()
157 (picture-set-motion 0 -1))
159 (defun picture-movement-up ()
162 (picture-set-motion -1 0))
164 (defun picture-movement-down ()
167 (picture-set-motion 1 0))
169 (defun picture-movement-nw (&optional arg)
173 (picture-set-motion -1 (if arg -2 -1)))
175 (defun picture-movement-ne (&optional arg)
179 (picture-set-motion -1 (if arg 2 1)))
181 (defun picture-movement-sw (&optional arg)
185 (picture-set-motion 1 (if arg -2 -1)))
187 (defun picture-movement-se (&optional arg)
191 (picture-set-motion 1 (if arg 2 1)))
193 (defun picture-set-motion (vert horiz)
196 (setq picture-vertical-step vert
197 picture-horizontal-step horiz)
206 (defun picture-move ()
207 "Move in direction of `picture-vertical-step' and `picture-horizontal-step'."
208 (if (/= picture-vertical-step 0)
209 (picture-move-down picture-vertical-step))
210 (if (/= picture-horizontal-step 0)
211 (picture-forward-column picture-horizontal-step)))
213 (defun picture-motion (arg)
214 "Move point in direction of current picture motion in Picture mode.
216 conjunction with diagonal picture motion.
217 Do \\[command-apropos] picture-movement to see commands which control motion."
219 (picture-move-down (* arg picture-vertical-step))
220 (picture-forward-column (* arg picture-horizontal-step)))
222 (defun picture-motion-reverse (arg)
223 "Move point in direction opposite of current picture motion in Picture mode.
225 conjunction with diagonal picture motion.
226 Do \\[command-apropos] picture-movement to see commands which control motion."
228 (picture-motion (- arg)))
230 (defun picture-mouse-set-point (event)
238 (picture-forward-column (- x (current-column))))
240 (picture-move-down (- y current-row)))))
246 (defun picture-insert (ch arg)
250 (picture-horizontal-step
251 (if (and (= picture-vertical-step 0)
253 (< (abs picture-horizontal-step) 2))
254 (* picture-horizontal-step 2)
255 picture-horizontal-step)))
258 (if (/= picture-desired-column (current-column))
259 (move-to-column picture-desired-column t))
260 (let ((col (+ picture-desired-column width)))
267 (picture-move))))
269 (defun picture-self-insert (arg)
272 with the commands `picture-movement-right', `picture-movement-up', etc.
273 Do \\[command-apropos] `picture-movement' to see those commands."
275 (picture-update-desired-column (not (eq this-command last-command)))
276 (picture-insert last-command-event arg)) ; Always a character in this case.
278 (defun picture-clear-column (arg)
290 (setq picture-desired-column (current-column)))
292 (defun picture-backward-clear-column (arg)
295 (picture-clear-column (- arg)))
297 (defun picture-clear-line (arg)
312 (defun picture-newline (arg)
324 (defun picture-open-line (arg)
332 (defun picture-duplicate-line ()
339 (progn (picture-newline 1) (point)))))
344 (defun picture-replace-match (newtext fixedcase literal)
369 (defcustom picture-tab-chars "!-~"
371 \\[picture-set-tab-stops] and \\[picture-tab-search]. It is NOT a
378 and that `picture-tab-chars' is \"|+*\". Then invoking
379 \\[picture-set-tab-stops] on either of the previous lines would result
391 The command \\[picture-tab-search] is defined to move beneath (or to) a
394 :group 'picture)
396 (defun picture-set-tab-stops (&optional arg)
398 This controls the behavior of \\[picture-tab]. A tab stop is set at
401 `picture-tab-chars', see its documentation for an example of usage.
409 (let ((regexp (concat "[ \t]+[" (regexp-quote picture-tab-chars) "]")))
418 (regexp-quote picture-tab-chars))))))
426 (defun picture-tab-search (&optional arg)
430 \"interesting characters\" are defined by variable `picture-tab-chars'.
439 (concat "^" (regexp-quote picture-tab-chars))
444 (concat "[ \t]+[" (regexp-quote picture-tab-chars) "]")
453 (defun picture-tab (&optional arg)
456 list can be changed by \\[picture-set-tab-stops] and \\[edit-tab-stops].
457 See also documentation for variable `picture-tab-chars'."
470 (defvar picture-killed-rectangle nil
471 "Rectangle killed or copied by \\[picture-clear-rectangle] in Picture mode.
472 The contents can be retrieved by \\[picture-yank-rectangle]")
474 (defun picture-clear-rectangle (start end &optional killp)
476 The rectangle is saved for yanking by \\[picture-yank-rectangle] and replaced
480 (setq picture-killed-rectangle (picture-snarf-rectangle start end killp)))
482 (defun picture-clear-rectangle-to-register (start end register &optional killp)
487 (set-register register (picture-snarf-rectangle start end killp)))
489 (defun picture-snarf-rectangle (start end &optional killp)
499 (defun picture-yank-rectangle (&optional insertp)
500 "Overlay rectangle saved by \\[picture-clear-rectangle]
506 (if (not (consp picture-killed-rectangle))
508 (picture-insert-rectangle picture-killed-rectangle insertp)))
510 (defun picture-yank-at-click (click arg)
518 (picture-yank-rectangle arg))
520 (defun picture-yank-rectangle-from-register (register &optional insertp)
530 (picture-insert-rectangle rectangle insertp))))
532 (defun picture-insert-rectangle (rectangle &optional insertp)
541 (picture-forward-column (length (car rectangle)))
542 (picture-move-down (1- (length rectangle)))
547 (defun picture-current-line ()
552 (defun picture-draw-rectangle (start end)
555 (let* ((sl (picture-current-line))
557 (pvs picture-vertical-step)
558 (phs picture-horizontal-step)
560 (r1 (picture-current-line))
562 (r2 (picture-current-line))
569 (picture-update-desired-column t)
571 (picture-movement-right)
572 (picture-insert picture-rectangle-ctl 1)
573 (picture-insert picture-rectangle-h (- right picture-desired-column))
575 (picture-movement-down)
576 (picture-insert picture-rectangle-ctr 1)
577 (picture-insert picture-rectangle-v (- bottom (picture-current-line)))
579 (picture-movement-left)
580 (picture-insert picture-rectangle-cbr 1)
581 (picture-insert picture-rectangle-h (- picture-desired-column left))
583 (picture-movement-up)
584 (picture-insert picture-rectangle-cbl 1)
585 (picture-insert picture-rectangle-v (- (picture-current-line) top))
587 (picture-set-motion pvs phs)
595 (defvar picture-mode-map nil)
597 (defun picture-substitute (oldfun newfun)
598 (define-key picture-mode-map (vector 'remap oldfun) newfun))
600 (if (not picture-mode-map)
602 (setq picture-mode-map (make-keymap))
603 (picture-substitute 'self-insert-command 'picture-self-insert)
604 (picture-substitute 'completion-separator-self-insert-command
605 'picture-self-insert)
606 (picture-substitute 'completion-separator-self-insert-autofilling
607 'picture-self-insert)
608 (picture-substitute 'forward-char 'picture-forward-column)
609 (picture-substitute 'backward-char 'picture-backward-column)
610 (picture-substitute 'delete-char 'picture-clear-column)
612 (picture-substitute 'backward-delete-char-untabify 'picture-backward-clear-column)
613 (picture-substitute 'delete-backward-char 'picture-backward-clear-column)
614 (picture-substitute 'kill-line 'picture-clear-line)
615 (picture-substitute 'open-line 'picture-open-line)
616 (picture-substitute 'newline 'picture-newline)
617 (picture-substitute 'newline-and-indent 'picture-duplicate-line)
618 (picture-substitute 'next-line 'picture-move-down)
619 (picture-substitute 'previous-line 'picture-move-up)
620 (picture-substitute 'beginning-of-line 'picture-beginning-of-line)
621 (picture-substitute 'end-of-line 'picture-end-of-line)
622 (picture-substitute 'mouse-set-point 'picture-mouse-set-point)
624 (define-key picture-mode-map "\C-c\C-d" 'delete-char)
625 (define-key picture-mode-map "\e\t" 'picture-toggle-tab-state)
626 (define-key picture-mode-map "\t" 'picture-tab)
627 (define-key picture-mode-map "\e\t" 'picture-tab-search)
628 (define-key picture-mode-map "\C-c\t" 'picture-set-tab-stops)
629 (define-key picture-mode-map "\C-c\C-k" 'picture-clear-rectangle)
630 (define-key picture-mode-map "\C-c\C-w" 'picture-clear-rectangle-to-register)
631 (define-key picture-mode-map "\C-c\C-y" 'picture-yank-rectangle)
632 (define-key picture-mode-map "\C-c\C-x" 'picture-yank-rectangle-from-register)
633 (define-key picture-mode-map "\C-c\C-r" 'picture-draw-rectangle)
634 (define-key picture-mode-map "\C-c\C-c" 'picture-mode-exit)
635 (define-key picture-mode-map "\C-c\C-f" 'picture-motion)
636 (define-key picture-mode-map "\C-c\C-b" 'picture-motion-reverse)
637 (define-key picture-mode-map "\C-c<" 'picture-movement-left)
638 (define-key picture-mode-map "\C-c>" 'picture-movement-right)
639 (define-key picture-mode-map "\C-c^" 'picture-movement-up)
640 (define-key picture-mode-map "\C-c." 'picture-movement-down)
641 (define-key picture-mode-map "\C-c`" 'picture-movement-nw)
642 (define-key picture-mode-map "\C-c'" 'picture-movement-ne)
643 (define-key picture-mode-map "\C-c/" 'picture-movement-sw)
644 (define-key picture-mode-map "\C-c\\" 'picture-movement-se)
645 (define-key picture-mode-map [(control ?c) left] 'picture-movement-left)
646 (define-key picture-mode-map [(control ?c) right] 'picture-movement-right)
647 (define-key picture-mode-map [(control ?c) up] 'picture-movement-up)
648 (define-key picture-mode-map [(control ?c) down] 'picture-movement-down)
649 (define-key picture-mode-map [(control ?c) home] 'picture-movement-nw)
650 (define-key picture-mode-map [(control ?c) prior] 'picture-movement-ne)
651 (define-key picture-mode-map [(control ?c) end] 'picture-movement-sw)
652 (define-key picture-mode-map [(control ?c) next] 'picture-movement-se)))
654 (defcustom picture-mode-hook nil
656 Picture mode is invoked by the command \\[picture-mode]."
658 :group 'picture)
660 (defvar picture-mode-old-local-map)
661 (defvar picture-mode-old-mode-name)
662 (defvar picture-mode-old-major-mode)
663 (defvar picture-mode-old-truncate-lines)
666 (defun picture-mode ()
668 \\<picture-mode-map>
672 Move left after insertion: \\[picture-movement-left]
673 Move right after insertion: \\[picture-movement-right]
674 Move up after insertion: \\[picture-movement-up]
675 Move down after insertion: \\[picture-movement-down]
677 Move northwest (nw) after insertion: \\[picture-movement-nw]
678 Move northeast (ne) after insertion: \\[picture-movement-ne]
679 Move southwest (sw) after insertion: \\[picture-movement-sw]
680 Move southeast (se) after insertion: \\[picture-movement-se]
682 Move westnorthwest (wnw) after insertion: C-u \\[picture-movement-nw]
683 Move eastnortheast (ene) after insertion: C-u \\[picture-movement-ne]
684 Move westsouthwest (wsw) after insertion: C-u \\[picture-movement-sw]
685 Move eastsoutheast (ese) after insertion: C-u \\[picture-movement-se]
692 Move vertically to SAME column in previous line: \\[picture-move-down]
693 Move vertically to SAME column in next line: \\[picture-move-up]
695 non-whitespace character: \\[picture-end-of-line]
696 Move right, inserting spaces if required: \\[picture-forward-column]
697 Move left changing tabs to spaces if required: \\[picture-backward-column]
698 Move in direction of current picture motion: \\[picture-motion]
699 Move opposite to current picture motion: \\[picture-motion-reverse]
705 character (see variable `picture-tab-chars'): \\[picture-tab-search]
706 Move to next stop in tab stop list: \\[picture-tab]
707 Set tab stops according to context of this line: \\[picture-set-tab-stops]
712 Clear ARG columns after point without moving: \\[picture-clear-column]
714 Clear ARG columns backward: \\[picture-backward-clear-column]
715 Clear ARG lines, advancing over them: \\[picture-clear-line]
717 Open blank line(s) beneath current line: \\[picture-open-line]
720 Clear a rectangle and save it: \\[picture-clear-rectangle]
721 Clear a rectangle, saving in a named register: \\[picture-clear-rectangle-to-register]
722 Insert currently saved rectangle at point: \\[picture-yank-rectangle]
723 Insert rectangle from named register: \\[picture-yank-rectangle-from-register]
724 Draw a rectangular box around mark and point: \\[picture-draw-rectangle]
728 You can return to the previous mode with \\[picture-mode-exit], which
732 Entry to this mode calls the value of `picture-mode-hook' if non-nil.
737 (if (eq major-mode 'picture-mode)
738 (error "You are already editing a picture")
739 (set (make-local-variable 'picture-mode-old-local-map) (current-local-map))
740 (use-local-map picture-mode-map)
741 (set (make-local-variable 'picture-mode-old-mode-name) mode-name)
742 (set (make-local-variable 'picture-mode-old-major-mode) major-mode)
743 (setq major-mode 'picture-mode)
744 (set (make-local-variable 'picture-killed-rectangle) nil)
746 (set (make-local-variable 'picture-tab-chars)
747 (default-value 'picture-tab-chars))
748 (make-local-variable 'picture-vertical-step)
749 (make-local-variable 'picture-horizontal-step)
750 (set (make-local-variable 'picture-mode-old-truncate-lines) truncate-lines)
752 (picture-set-motion 0 1)
754 ;; edit-picture-hook is what we used to run, picture-mode-hook is in doc.
755 (run-hooks 'edit-picture-hook 'picture-mode-hook)
757 (substitute-command-keys "\\[picture-mode-exit]")
758 picture-mode-old-mode-name)))
761 (defalias 'edit-picture 'picture-mode)
763 (defun picture-mode-exit (&optional nostrip)
764 "Undo `picture-mode' and return to previous major mode.
767 Runs `picture-mode-exit-hook' at the end."
769 (if (not (eq major-mode 'picture-mode))
772 (setq mode-name picture-mode-old-mode-name)
773 (use-local-map picture-mode-old-local-map)
774 (setq major-mode picture-mode-old-major-mode)
776 (setq truncate-lines picture-mode-old-truncate-lines)
778 (run-hooks 'picture-mode-exit-hook)))
780 (provide 'picture)
783 ;;; picture.el ends here