(org-up-heading-all): Fixed bug with

[bpt/emacs.git] / lisp / textmodes / picture.el

diff --git a/lisp/textmodes/picture.el b/lisp/textmodes/picture.el
index dc47a89..b3c69ca 100644 (file)
--- a/lisp/textmodes/picture.el
+++ b/lisp/textmodes/picture.el
@@ -1,6 +1,6 @@
 ;;; picture.el --- "Picture mode" -- editing using quarter-plane screen model
 
-;; Copyright (C) 1985, 1994 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1994, 2002, 2003 Free Software Foundation, Inc.
 
 ;; Author: K. Shane Hartman
 ;; Maintainer: FSF
@@ -100,35 +100,37 @@ If scan reaches end of buffer, stop there without error."
   (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))))
+  (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.")
@@ -220,10 +222,22 @@ Do \\[command-apropos]  picture-movement  to see commands which control motion."
   "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.
 
@@ -240,11 +254,11 @@ Do \\[command-apropos] `picture-movement' to see commands which control motion."
     (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)
@@ -265,7 +279,7 @@ Do \\[command-apropos] `picture-movement' to see those commands."
   (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))
@@ -547,7 +561,7 @@ Leaves the region surrounding the rectangle."
          (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)
@@ -576,7 +590,7 @@ Leaves the region surrounding the rectangle."
 (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
@@ -600,6 +614,7 @@ Leaves the region surrounding the rectangle."
       (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)
@@ -621,7 +636,15 @@ Leaves the region surrounding the rectangle."
       (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.
@@ -740,4 +763,5 @@ With no argument strips whitespace from end of every line in Picture buffer
 
 (provide 'picture)
 
+;;; arch-tag: e452d08d-a470-4fbf-896e-ea276698d1ca
 ;;; picture.el ends here