(ispell-command-loop): Add current dictionary name and program name
[bpt/emacs.git] / lisp / textmodes / picture.el
index 0ef0630..fd788a7 100644 (file)
@@ -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
@@ -20,8 +20,8 @@
 
 ;; 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:
 
@@ -104,14 +104,15 @@ If scan reaches end of buffer, stop there without error."
   "Move cursor right, making whitespace if necessary.
 With argument, move that many columns."
   (interactive "p\nd")
-  (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))))
+  (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.
@@ -124,11 +125,12 @@ With argument, move that many columns."
   "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))
@@ -345,7 +359,7 @@ With positive argument insert that many lines."
                         (point))))
     (replace-match newtext fixedcase literal)
     (if (< change 0)
-       (insert-char ?\ (- change)))))
+       (insert-char ?\s (- change)))))
 \f
 ;; Picture Tabs
 
@@ -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