;;; picture.el --- "Picture mode" -- editing using quarter-plane screen model
-;; Copyright (C) 1985, 1994 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1994, 2002, 2003, 2004,
+;; 2005 Free Software Foundation, Inc.
;; Author: K. Shane Hartman
;; Maintainer: FSF
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
(skip-chars-backward " \t" (prog1 (point) (end-of-line)))
(setq picture-desired-column (current-column)))
-(defun picture-forward-column (arg)
+(defun picture-forward-column (arg &optional interactive)
"Move cursor right, making whitespace if necessary.
With argument, move that many columns."
- (interactive "p")
- (picture-update-desired-column (interactive-p))
- (setq picture-desired-column (max 0 (+ picture-desired-column arg)))
- (let ((current-column (move-to-column picture-desired-column t)))
- (if (and (> current-column picture-desired-column)
- (< arg 0))
- ;; It seems that we have just tried to move to the right
- ;; column of a multi-column character.
- (forward-char -1))))
-
-(defun picture-backward-column (arg)
+ (interactive "p\nd")
+ (let (deactivate-mark)
+ (picture-update-desired-column interactive)
+ (setq picture-desired-column (max 0 (+ picture-desired-column arg)))
+ (let ((current-column (move-to-column picture-desired-column t)))
+ (if (and (> current-column picture-desired-column)
+ (< arg 0))
+ ;; It seems that we have just tried to move to the right
+ ;; column of a multi-column character.
+ (forward-char -1)))))
+
+(defun picture-backward-column (arg &optional interactive)
"Move cursor left, making whitespace if necessary.
With argument, move that many columns."
- (interactive "p")
- (picture-update-desired-column (interactive-p))
+ (interactive "p\nd")
+ (picture-update-desired-column interactive)
(picture-forward-column (- arg)))
(defun picture-move-down (arg)
"Move vertically down, making whitespace if necessary.
With argument, move that many lines."
(interactive "p")
- (picture-update-desired-column nil)
- (picture-newline arg)
- (let ((current-column (move-to-column picture-desired-column t)))
- (if (> current-column picture-desired-column)
- (forward-char -1))))
-
-(defconst picture-vertical-step 0
+ (let (deactivate-mark)
+ (picture-update-desired-column nil)
+ (picture-newline arg)
+ (let ((current-column (move-to-column picture-desired-column t)))
+ (if (> current-column picture-desired-column)
+ (forward-char -1)))))
+
+(defvar picture-vertical-step 0
"Amount to move vertically after text character in Picture mode.")
-(defconst picture-horizontal-step 1
+(defvar picture-horizontal-step 1
"Amount to move horizontally after text character in Picture mode.")
(defun picture-move-up (arg)
"Move point in direction opposite of current picture motion in Picture mode.
With ARG do it that many times. Useful for delineating rectangles in
conjunction with diagonal picture motion.
-Do \\[command-apropos] `picture-movement' to see commands which control motion."
+Do \\[command-apropos] picture-movement to see commands which control motion."
(interactive "p")
(picture-motion (- arg)))
+(defun picture-mouse-set-point (event)
+ "Move point to the position clicked on, making whitespace if necessary."
+ (interactive "e")
+ (let* ((pos (posn-col-row (event-start event)))
+ (x (car pos))
+ (y (cdr pos))
+ (current-row (count-lines (window-start) (line-beginning-position))))
+ (unless (equal x (current-column))
+ (picture-forward-column (- x (current-column))))
+ (unless (equal y current-row)
+ (picture-move-down (- y current-row)))))
+
\f
;; Picture insertion and deletion.
(while (> arg 0)
(setq arg (1- arg))
(if (/= picture-desired-column (current-column))
- (move-to-column-force picture-desired-column))
+ (move-to-column picture-desired-column t))
(let ((col (+ picture-desired-column width)))
(or (eolp)
(let ((pos (point)))
- (move-to-column-force col)
+ (move-to-column col t)
(delete-region pos (point)))))
(insert ch)
(forward-char -1)
(let* ((original-col (current-column))
(target-col (max 0 (+ original-col arg)))
pos)
- (move-to-column-force target-col)
+ (move-to-column target-col t)
(setq pos (point))
(move-to-column original-col)
(delete-region pos (point))
(point))))
(replace-match newtext fixedcase literal)
(if (< change 0)
- (insert-char ?\ (- change)))))
+ (insert-char ?\s (- change)))))
\f
;; Picture Tabs
(top (min r1 r2))
(bottom (max r1 r2)))
(goto-line top)
- (move-to-column-force left)
+ (move-to-column left t)
(picture-update-desired-column t)
(picture-movement-right)
\f
;; Picture Keymap, entry and exit points.
-(defconst picture-mode-map nil)
+(defvar picture-mode-map nil)
(defun picture-substitute (oldfun newfun)
- (substitute-key-definition oldfun newfun picture-mode-map global-map))
+ (define-key picture-mode-map (vector 'remap oldfun) newfun))
(if (not picture-mode-map)
(progn
(picture-substitute 'previous-line 'picture-move-up)
(picture-substitute 'beginning-of-line 'picture-beginning-of-line)
(picture-substitute 'end-of-line 'picture-end-of-line)
+ (picture-substitute 'mouse-set-point 'picture-mouse-set-point)
(define-key picture-mode-map "\C-c\C-d" 'delete-char)
(define-key picture-mode-map "\e\t" 'picture-toggle-tab-state)
(define-key picture-mode-map "\C-c`" 'picture-movement-nw)
(define-key picture-mode-map "\C-c'" 'picture-movement-ne)
(define-key picture-mode-map "\C-c/" 'picture-movement-sw)
- (define-key picture-mode-map "\C-c\\" 'picture-movement-se)))
+ (define-key picture-mode-map "\C-c\\" 'picture-movement-se)
+ (define-key picture-mode-map [(control ?c) left] 'picture-movement-left)
+ (define-key picture-mode-map [(control ?c) right] 'picture-movement-right)
+ (define-key picture-mode-map [(control ?c) up] 'picture-movement-up)
+ (define-key picture-mode-map [(control ?c) down] 'picture-movement-down)
+ (define-key picture-mode-map [(control ?c) home] 'picture-movement-nw)
+ (define-key picture-mode-map [(control ?c) prior] 'picture-movement-ne)
+ (define-key picture-mode-map [(control ?c) end] 'picture-movement-sw)
+ (define-key picture-mode-map [(control ?c) next] 'picture-movement-se)))
(defcustom picture-mode-hook nil
"If non-nil, its value is called on entry to Picture mode.
C-c C-r Draw a rectangular box around mark and point.
\\[copy-rectangle-to-register] Copies a rectangle to a register.
\\[advertised-undo] Can undo effects of rectangle overlay commands
- commands if invoked soon enough.
+ if invoked soon enough.
You can return to the previous mode with:
C-c C-c Which also strips trailing whitespace from every line.
Stripping is suppressed by supplying an argument.
-Entry to this mode calls the value of picture-mode-hook if non-nil.
+Entry to this mode calls the value of `picture-mode-hook' if non-nil.
Note that Picture mode commands will work outside of Picture mode, but
they are not defaultly assigned to keys."
(interactive)
(if (eq major-mode 'picture-mode)
(error "You are already editing a picture")
- (make-local-variable 'picture-mode-old-local-map)
- (setq picture-mode-old-local-map (current-local-map))
+ (set (make-local-variable 'picture-mode-old-local-map) (current-local-map))
(use-local-map picture-mode-map)
- (make-local-variable 'picture-mode-old-mode-name)
- (setq picture-mode-old-mode-name mode-name)
- (make-local-variable 'picture-mode-old-major-mode)
- (setq picture-mode-old-major-mode major-mode)
+ (set (make-local-variable 'picture-mode-old-mode-name) mode-name)
+ (set (make-local-variable 'picture-mode-old-major-mode) major-mode)
(setq major-mode 'picture-mode)
- (make-local-variable 'picture-killed-rectangle)
- (setq picture-killed-rectangle nil)
- (make-local-variable 'tab-stop-list)
- (setq tab-stop-list (default-value 'tab-stop-list))
- (make-local-variable 'picture-tab-chars)
- (setq picture-tab-chars (default-value 'picture-tab-chars))
+ (set (make-local-variable 'picture-killed-rectangle) nil)
+ (set (make-local-variable 'tab-stop-list) (default-value 'tab-stop-list))
+ (set (make-local-variable 'picture-tab-chars)
+ (default-value 'picture-tab-chars))
(make-local-variable 'picture-vertical-step)
(make-local-variable 'picture-horizontal-step)
- (make-local-variable 'picture-mode-old-truncate-lines)
- (setq picture-mode-old-truncate-lines truncate-lines)
+ (set (make-local-variable 'picture-mode-old-truncate-lines) truncate-lines)
(setq truncate-lines t)
(picture-set-motion 0 1)
(defalias 'edit-picture 'picture-mode)
(defun picture-mode-exit (&optional nostrip)
- "Undo picture-mode and return to previous major mode.
+ "Undo `picture-mode' and return to previous major mode.
With no argument strips whitespace from end of every line in Picture buffer
otherwise just return to previous mode."
(interactive "P")
(provide 'picture)
+;;; arch-tag: e452d08d-a470-4fbf-896e-ea276698d1ca
;;; picture.el ends here
HCoop / bpt / emacs.git / blobdiff