1 |
;;; picture.el --- "Picture mode" -- editing using quarter-plane screen model |
;;; picture.el --- "Picture mode" -- editing using quarter-plane screen model |
2 |
|
|
3 |
;; Copyright (C) 1985, 1994 Free Software Foundation, Inc. |
;; Copyright (C) 1985, 1994, 2002, 2003 Free Software Foundation, Inc. |
4 |
|
|
5 |
;; Author: K. Shane Hartman |
;; Author: K. Shane Hartman |
6 |
;; Maintainer: FSF |
;; Maintainer: FSF |
104 |
"Move cursor right, making whitespace if necessary. |
"Move cursor right, making whitespace if necessary. |
105 |
With argument, move that many columns." |
With argument, move that many columns." |
106 |
(interactive "p\nd") |
(interactive "p\nd") |
107 |
(picture-update-desired-column interactive) |
(let (deactivate-mark) |
108 |
(setq picture-desired-column (max 0 (+ picture-desired-column arg))) |
(picture-update-desired-column interactive) |
109 |
(let ((current-column (move-to-column picture-desired-column t))) |
(setq picture-desired-column (max 0 (+ picture-desired-column arg))) |
110 |
(if (and (> current-column picture-desired-column) |
(let ((current-column (move-to-column picture-desired-column t))) |
111 |
(< arg 0)) |
(if (and (> current-column picture-desired-column) |
112 |
;; It seems that we have just tried to move to the right |
(< arg 0)) |
113 |
;; column of a multi-column character. |
;; It seems that we have just tried to move to the right |
114 |
(forward-char -1)))) |
;; column of a multi-column character. |
115 |
|
(forward-char -1))))) |
116 |
|
|
117 |
(defun picture-backward-column (arg &optional interactive) |
(defun picture-backward-column (arg &optional interactive) |
118 |
"Move cursor left, making whitespace if necessary. |
"Move cursor left, making whitespace if necessary. |
125 |
"Move vertically down, making whitespace if necessary. |
"Move vertically down, making whitespace if necessary. |
126 |
With argument, move that many lines." |
With argument, move that many lines." |
127 |
(interactive "p") |
(interactive "p") |
128 |
(picture-update-desired-column nil) |
(let (deactivate-mark) |
129 |
(picture-newline arg) |
(picture-update-desired-column nil) |
130 |
(let ((current-column (move-to-column picture-desired-column t))) |
(picture-newline arg) |
131 |
(if (> current-column picture-desired-column) |
(let ((current-column (move-to-column picture-desired-column t))) |
132 |
(forward-char -1)))) |
(if (> current-column picture-desired-column) |
133 |
|
(forward-char -1))))) |
134 |
|
|
135 |
(defvar picture-vertical-step 0 |
(defvar picture-vertical-step 0 |
136 |
"Amount to move vertically after text character in Picture mode.") |
"Amount to move vertically after text character in Picture mode.") |
222 |
"Move point in direction opposite of current picture motion in Picture mode. |
"Move point in direction opposite of current picture motion in Picture mode. |
223 |
With ARG do it that many times. Useful for delineating rectangles in |
With ARG do it that many times. Useful for delineating rectangles in |
224 |
conjunction with diagonal picture motion. |
conjunction with diagonal picture motion. |
225 |
Do \\[command-apropos] `picture-movement' to see commands which control motion." |
Do \\[command-apropos] picture-movement to see commands which control motion." |
226 |
(interactive "p") |
(interactive "p") |
227 |
(picture-motion (- arg))) |
(picture-motion (- arg))) |
228 |
|
|
229 |
|
(defun picture-mouse-set-point (event) |
230 |
|
"Move point to the position clicked on, making whitespace if necessary." |
231 |
|
(interactive "e") |
232 |
|
(let* ((pos (posn-col-row (event-start event))) |
233 |
|
(x (car pos)) |
234 |
|
(y (cdr pos)) |
235 |
|
(current-row (count-lines (window-start) (line-beginning-position)))) |
236 |
|
(unless (equal x (current-column)) |
237 |
|
(picture-forward-column (- x (current-column)))) |
238 |
|
(unless (equal y current-row) |
239 |
|
(picture-move-down (- y current-row))))) |
240 |
|
|
241 |
|
|
242 |
;; Picture insertion and deletion. |
;; Picture insertion and deletion. |
243 |
|
|
590 |
(defvar picture-mode-map nil) |
(defvar picture-mode-map nil) |
591 |
|
|
592 |
(defun picture-substitute (oldfun newfun) |
(defun picture-substitute (oldfun newfun) |
593 |
(substitute-key-definition oldfun newfun picture-mode-map global-map)) |
(define-key picture-mode-map (vector 'remap oldfun) newfun)) |
594 |
|
|
595 |
(if (not picture-mode-map) |
(if (not picture-mode-map) |
596 |
(progn |
(progn |
614 |
(picture-substitute 'previous-line 'picture-move-up) |
(picture-substitute 'previous-line 'picture-move-up) |
615 |
(picture-substitute 'beginning-of-line 'picture-beginning-of-line) |
(picture-substitute 'beginning-of-line 'picture-beginning-of-line) |
616 |
(picture-substitute 'end-of-line 'picture-end-of-line) |
(picture-substitute 'end-of-line 'picture-end-of-line) |
617 |
|
(picture-substitute 'mouse-set-point 'picture-mouse-set-point) |
618 |
|
|
619 |
(define-key picture-mode-map "\C-c\C-d" 'delete-char) |
(define-key picture-mode-map "\C-c\C-d" 'delete-char) |
620 |
(define-key picture-mode-map "\e\t" 'picture-toggle-tab-state) |
(define-key picture-mode-map "\e\t" 'picture-toggle-tab-state) |