--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/mule/visual-mode.el	Mon Aug 13 09:02:59 2007 +0200
@@ -0,0 +1,1173 @@
+;; visual.el -- cursor motion, insertion, deletion, etc. in visual order
+;; Copyright (C) 1992 Free Software Foundation, Inc.
+
+;; This file is part of XEmacs.
+
+;; XEmacs is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; XEmacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with XEmacs; see the file COPYING.  If not, write to the 
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; 94.5.15  created for Mule Ver.1.1 by Takahashi N. <ntakahas@etl.go.jp>
+
+;;;###autoload
+(defvar visual-mode nil "non-nil if in visual-mode.")
+
+(make-variable-buffer-local 'visual-mode)
+
+(defvar visual-use-lr-commands nil
+  "If non-nil, use visual-left-* and visual-right-* commands instead of
+visual-forward-* and visual-backward-* commands.")
+
+(defvar visual-mode-map
+  (let ((map (make-keymap)))
+    (substitute-key-definition 'self-insert-command
+			       'visual-self-insert-command
+			       map global-map)
+    ; visual basic commands
+    (define-key map [(control d)]       'visual-delete-char)
+    (define-key map [(control k)]       'visual-kill-line)
+    (define-key map [(control m)]       'visual-newline)
+    (define-key map [(control o)]       'visual-open-line)
+    (define-key map [(control p)]       'visual-previous-line)
+    (define-key map [(control w)]       'visual-kill-region)
+    (define-key map [(control y)]       'visual-yank)
+    (define-key map [delete]       'visual-backward-delete-char)
+    (define-key map [(meta <)]       'visual-beginning-of-buffer)
+    (define-key map [(meta >)]       'visual-end-of-buffer)
+    (define-key map [(meta d)]       'visual-kill-word)
+    (define-key map [(meta w)]       'visual-kill-ring-save)
+    (define-key map [(meta y)]       'visual-yank-pop)
+    (define-key map [(meta delete)]    'visual-backward-kill-word)
+    (define-key map [up]          'visual-previous-line)
+    (define-key map [down]        'visual-next-line)
+    (define-key map [home]        'visual-beginning-of-buffer)
+    (define-key map [end]         'visual-end-of-buffer)
+    (define-key map [left]        'visual-move-to-left-char)
+    (define-key map [right]       'visual-move-to-right-char)
+    (define-key map [(meta left)]      'visual-move-to-left-word)
+    (define-key map [(meta right)]     'visual-move-to-right-word)
+    (define-key map [(control c) (control c)] 'exit-visual-mode)
+    (define-key map [(control c) <]    'l2r-mode)
+    (define-key map [(control c) >]    'r2l-mode)
+    ; LR commands
+    (if visual-use-lr-commands
+	(progn
+	  (define-key map [(control a)] 'visual-left-end-of-line)
+	  (define-key map [(control b)] 'visual-move-to-left-char)
+	  (define-key map [(control e)] 'visual-right-end-of-line)
+	  (define-key map [(control f)] 'visual-move-to-right-char)
+	  (define-key map [(meta b)] 'visual-move-to-left-word)
+	  (define-key map [(meta f)] 'visual-move-to-right-word))
+      (define-key map [(control a)]       'visual-beginning-of-line)
+      (define-key map [(control b)]       'visual-backward-char)
+      (define-key map [(control e)]       'visual-end-of-line)
+      (define-key map [(control f)]       'visual-forward-char)
+      (define-key map [(meta b)]       'visual-backward-word)
+      (define-key map [(meta f)]       'visual-forward-word))
+    map)
+  "minor-mode-keymap for visual-mode.")
+
+(if (not (assq 'visual-mode minor-mode-map-alist))
+    (setq minor-mode-map-alist
+	  (cons (cons 'visual-mode visual-mode-map)
+		minor-mode-map-alist)))
+
+(defvar visual-mode-indicator nil
+  "string displayed in mode line. \" l2r\" or \" r2l\".")
+(make-variable-buffer-local 'visual-mode-indicator)
+
+(if (not (assq 'visual-mode minor-mode-alist))
+    (setq minor-mode-alist
+	  (cons '(visual-mode visual-mode-indicator)
+		minor-mode-alist)))
+
+(setq auto-mode-alist
+      (append '(("\\.l2r$" . l2r-mode) ("\\.r2l$" . r2l-mode))
+	      auto-mode-alist))
+
+(defvar visual-mode-hooks nil)
+
+;;;###autoload
+(defun visual-mode (&optional arg)
+  "Toggle visual-mode.  With ARG, turn visual-mode on iff ARG is positive."
+  (interactive "P")
+  (if (null arg)
+    (if visual-mode (exit-visual-mode) (enter-visual-mode))
+   (if (> (prefix-numeric-value arg) 0)
+       (enter-visual-mode)
+     (exit-visual-mode))))
+
+(defun enter-visual-mode nil
+  "Enter visual-mode.  Cursor moves in visual order."
+  (interactive)
+  (if (not visual-mode)
+      (progn
+	(setq visual-mode t
+	      visual-mode-indicator (if display-direction " r2l" " l2r"))
+	(redraw-display)
+	(run-hooks 'visual-mode-hooks))))
+
+(defun exit-visual-mode nil
+  "Exit visual-mode.  Cursor moves in logical order."
+  (interactive)
+  (if visual-mode
+      (progn
+	(setq visual-mode nil)
+	(redraw-modeline t))))
+
+(defun l2r-mode nil
+  "Set display-direction left to right."
+  (interactive)
+  (if (not visual-mode)
+      (enter-visual-mode))
+  (setq display-direction nil)
+  (setq visual-mode-indicator " l2r")
+  (redraw-display))
+
+(defun r2l-mode nil
+  "Set display-direction right to left."
+  (interactive)
+  (if (not visual-mode)
+      (enter-visual-mode))
+  (setq display-direction t)
+  (setq visual-mode-indicator " r2l")
+  (redraw-display))
+
+
+;; cursor motion
+
+(defun visual-forward-char (arg)
+  "Move the cursor visually forward by ARG (integer) characters.
+if ARG is negative, move backward."
+  (interactive "p")
+  (if (< arg 0)
+      (while (< arg 0)
+	(visual-backward-1-char)
+	(setq arg (1+ arg)))
+    (while (> arg 0)
+      (visual-forward-1-char)
+      (setq arg (1- arg)))))
+
+(defun visual-forward-1-char nil
+  "Move the cursor visually forward by 1 character."
+  (let ((r-dir (if display-direction 0 1))
+	(a-dir (visual-char-direction-after-point))
+	(aa-dir (visual-char-direction-after-after-point))
+	(b-dir (visual-char-direction-before-point)))
+
+    ;  symbols used in the following comments
+    ; ^  : point in here
+    ; ~  : point will be there
+    ; d  : character whose direction is the same as display-direction
+    ; r  : character whose direction is opposite to display-direction
+    ; !d : r or nil
+    ; !r : d or nil
+    ; r* : 0 or more r's
+    ; d* : 0 or more d's
+
+    (cond
+     ((null a-dir)
+      ; ... nil
+      ;    ^
+      (error "end of buffer"))
+
+     ((eq a-dir r-dir)
+      (if (eq b-dir r-dir)
+
+	  ; ... r r ...
+	  ;    ~ ^
+	  (backward-char 1)
+
+	; ... !r r r* ...
+	;       ^    ~
+	(skip-direction-forward r-dir)))
+
+     ((eq aa-dir r-dir)
+      ; ... d r* r ...
+      ;    ^    ~
+      (forward-char 1)
+      (skip-direction-forward r-dir)
+      (backward-char 1))
+
+     (t
+      ; ... d !r ...
+      ;    ^ ~
+      (forward-char 1)))))
+
+(defun visual-backward-char (arg)
+  "Move the cursor visually backward by ARG (integer) characters.
+if ARG is negative, move forward."
+  (interactive "p")
+  (if (< arg 0)
+      (while (< arg 0)
+	(visual-forward-1-char)
+	(setq arg (1+ arg)))
+    (while (> arg 0)
+      (visual-backward-1-char)
+      (setq arg (1- arg)))))
+
+(defun visual-backward-1-char nil
+  "Move the cursor visually backward by 1 character."
+  (let ((r-dir (if display-direction 0 1))
+	(a-dir (visual-char-direction-after-point))
+	(aa-dir (visual-char-direction-after-after-point))
+	(b-dir (visual-char-direction-before-point)))
+
+    ;  symbols used in the following comments
+    ; ^  : point in here
+    ; ~  : point will be there
+    ; d  : character whose direction is the same as display-direction
+    ; r  : character whose direction is opposite to display-direction
+    ; !d : r or nil
+    ; !r : d or nil
+    ; r* : 0 or more r's
+    ; d* : 0 or more d's
+
+    (cond
+     ((eq a-dir r-dir)
+      (if (eq aa-dir r-dir)
+	  ; ... r r ...
+	  ;    ^ ~
+	  (forward-char 1)
+
+	; ... !r r* !r ...
+	;    ~     ^
+	(skip-direction-backward r-dir)
+	(if (visual-char-direction-before-point)
+	    (backward-char 1)
+	  (skip-direction-forward r-dir)
+	  (backward-char 1)
+	  (error "beginning of buffer"))))
+
+     ((null b-dir)
+      ; nil !r ...
+      ;    ^
+      (error "beginning of buffer"))
+
+     ((eq b-dir r-dir)
+      ; ... r* r !r
+      ;    ~    ^
+      (skip-direction-backward r-dir))
+
+     (t
+      ; ... d !r ...
+      ;    ~ ^
+      (backward-char 1)))))
+
+(defun visual-char-direction (ch)
+  "Return the direction of CH (character).
+Newline's direction will be same as display-direction."
+  (cond
+   ((null ch) nil)
+   ((= ch ?\n) (if display-direction 1 0))
+   (t (char-direction ch))))
+
+(defun visual-char-direction-after-point nil
+  "Return the direction of after-point-character.
+0: left-to-right, 1: right-to-left"
+  (visual-char-direction (char-after (point))))
+
+(defun visual-char-direction-after-after-point nil
+  "Return the direction of after-after-point-character.
+0: left-to-right, 1: right-to-left"
+  (if (= (point) (point-max))
+      nil
+    (save-excursion
+      (forward-char 1)
+      (visual-char-direction (char-after (point))))))
+
+(defun visual-char-direction-before-point nil
+  "Return the direction of before-point-character.
+0: left-to-right, 1: right-to-left"
+  (visual-char-direction (char-before (point))))
+
+(defun skip-direction-forward (dir)
+  "Move point forward as long as DIR-direction characters continue."
+  (while (eq (visual-char-direction-after-point) dir)
+    (forward-char 1)))
+
+(defun skip-direction-backward (dir)
+  "Move point backward as long as DIR-direction characters continue."
+  (while (eq (visual-char-direction-before-point) dir)
+    (backward-char 1)))
+
+(defvar *visual-punctuations*
+  '(?  ?. ?, ?: ?; ?? ?! ?- ?_ ?' ?\" ?/ ?( ?) ?[ ?] ?{ ?} ?\n ?\t ; ASCII
+    ?  ?. ?, ?: ?; ?? ?! ?- ?_ ?' ?" ?( ?) ?[ ?]		   ; Hebrew
+    ?[2](3![0](B ?[2](3&[0](B ?[2](3%[0](B ?[2](3)[0](B ?[2](3"[0](B ?[2](3'[0](B ?[2](3([0](B ?[2](3#[0](B ?[2](3$[0](B ?[2](3*[0](B ?[2](3+[0](B ))				   ; Arabic
+
+(defun visual-forward-word (arg)
+  "Move the cursor visually forward by ARG (integer) words.
+If ARG is negative, move the cursor backward."
+  (interactive "p")
+  (if (< arg 0)
+      (while (< arg 0)
+	(visual-backward-1-word)
+	(setq arg (1+ arg)))
+    (while (> arg 0)
+      (visual-forward-1-word)
+      (setq arg (1- arg)))))
+
+(defun visual-backward-word (arg)
+  "Move the cursor visually backward by ARG (integer) words.
+If ARG is negative, move the cursor forward."
+  (interactive "p")
+  (if (< arg 0)
+      (while (< arg 0)
+	(visual-forward-1-word)
+	(setq arg (1+ arg)))
+    (while (> arg 0)
+      (visual-backward-1-word)
+      (setq arg (1- arg)))))
+
+(defun visual-forward-1-word nil
+  "Move the cursor visually forward by one word."
+  (while (memq (visual-char-after) *visual-punctuations*)
+    (visual-forward-1-char))
+  (while (not (memq (visual-char-after) *visual-punctuations*))
+    (visual-forward-1-char)))
+
+(defun visual-backward-1-word nil
+  "Move the cursor visually backward by one word."
+  (while (memq (visual-char-before) *visual-punctuations*)
+    (visual-backward-1-char))
+  (while (not (memq (visual-char-before) *visual-punctuations*))
+    (visual-backward-1-char)))
+
+(defun visual-char-before nil
+  "Return the character visually before the cursor.
+If such position is out of range, returns nil."
+  ; almost same as visual-backward-1-char
+  (save-excursion			
+    (let ((r-dir (if display-direction 0 1))
+	  (a-dir (visual-char-direction-after-point))
+	  (aa-dir (visual-char-direction-after-after-point))
+	  (b-dir (visual-char-direction-before-point)))
+      (cond
+       ((eq a-dir r-dir)
+	(if (eq aa-dir r-dir)
+	    (progn
+	      (forward-char 1)
+	      (char-after (point)))
+	  (skip-direction-backward r-dir)
+	  (if (visual-char-direction-before-point)
+	      (progn
+		(backward-char 1)
+		(char-after (point)))
+	    nil)))
+       ((null b-dir)
+	nil)
+       ((eq b-dir r-dir)
+	(skip-direction-backward r-dir)
+	(char-after (point)))
+       (t
+	(backward-char 1)
+	(char-after (point)))))))
+
+(defun visual-char-after nil
+  "Return the character under the cursor.
+If such position is out of range, returns nil."
+  (char-after (point)))
+
+(defun visual-beginning-of-line (&optional arg)
+  "Move the cursor to the visual beginning of line.
+With ARG not nil, move forward ARG - 1 lines first.
+If scan reaches end of buffer, stop there without error."
+  (interactive "P")
+  (beginning-of-line arg)
+  (let ((a-dir (visual-char-direction-after-point))
+	(d-dir (if display-direction 1 0)))
+    (if (and a-dir (/= a-dir d-dir))
+	(progn (skip-direction-forward a-dir)
+	       (backward-char 1)))))
+
+(fset 'visual-end-of-line 'end-of-line)
+
+(defun visual-beginning-of-buffer nil
+  "Move the cursor to the visual beginning of current buffer."
+  (interactive)
+  (beginning-of-buffer)
+  (visual-beginning-of-line))
+
+(fset 'visual-end-of-buffer 'end-of-buffer)
+
+(defvar visual-temporary-goal-column 0
+  "temporary-goal-column command for visual-mode.")
+
+(defun visual-next-line (arg)
+  "next-line command for visual-mode."
+  (interactive "p")
+  (if (and (not (eq last-command 'visual-next-line))
+	   (not (eq last-command 'visual-previous-line)))
+      (setq visual-temporary-goal-column (visual-current-column)))
+  (next-line arg)
+  (visual-goto-column visual-temporary-goal-column))
+
+(defun visual-previous-line (arg)
+  "previous-line command for visual-mode."
+  (interactive "p")
+  (if (and (not (eq last-command 'visual-next-line))
+	   (not (eq last-command 'visual-previous-line)))
+      (setq visual-temporary-goal-column (visual-current-column)))
+  (previous-line arg)
+  (visual-goto-column visual-temporary-goal-column))
+
+(defun visual-current-column nil
+  "Return the current column counted in visual order."
+  (let ((c 0) (p (point)))
+    (visual-beginning-of-line)
+    (while (/= (point) p)
+      (setq c (+ c (char-width (visual-char-after))))
+      (visual-forward-1-char))
+    c))
+
+(defun visual-goto-column (col)
+  "Move the cursor to visual column N (integer) in the current line.
+If it is impossible to go to column N, the cursor is put on the nearest column
+M (M < N).  Returns N - M."
+  (if (< col 0)
+      (error "argument must be positive."))
+  (let ((c 0))
+    (visual-beginning-of-line)
+    (while (and (< c col) (not (eolp)))
+      (setq c (+ c (char-width (visual-char-after))))
+      (visual-forward-1-char))
+    (if (> c col)
+	(progn
+	  (visual-backward-1-char)
+	  (setq c (- c (char-width (visual-char-after))))))
+    (- col c)))
+
+
+;; insertion
+
+(defun visual-insert-char (ch arg)
+  "Insert character CH visually before the cursor.
+With ARG (integer) insert that many characters."
+  (if (< arg 0)
+      (error "arg must be >= 0."))
+  (while (> arg 0)
+    (visual-insert-1-char ch)
+    (setq arg (1- arg))))
+
+(defun visual-insert-1-char (ch)
+  "Insert character CH visually before the cursor.
+The cursor moves visually forward."
+  (let ((c-dir (visual-char-direction ch))
+	(r-dir (if display-direction 0 1))
+	(a-dir (visual-char-direction-after-point))
+	(tmp))
+
+    ;  symbols used in the following comments
+    ; d  : character whose direction is the same as display-direction
+    ; r  : character whose direction is opposite to display-direction
+    ; !d : r or nil
+    ; !r : d or nil
+    ; ^d : point is here and the character to be inserted is d
+    ; ^r : point is here and the character to be inserted is d
+
+    (if (eq c-dir r-dir)
+	(if (eq a-dir r-dir)
+	    
+	    ; ... r ...
+	    ;    ^r
+	    (progn
+	      (forward-char 1)
+	      (insert ch)
+	      (backward-char 2))
+	  
+	  ; ... !r ...
+	  ;    ^r
+	  (skip-direction-backward c-dir)
+	  (insert ch)
+	  (skip-direction-forward c-dir))
+      
+      (if (or (eq a-dir nil)
+	      (eq a-dir c-dir))
+	  
+	  ; ... !r ...
+	  ;    ^d
+	  (insert ch)
+	
+	; ... r ...
+	;    ^d
+	(forward-char 1)
+	(setq tmp (delete-direction-backward r-dir))
+	(skip-direction-forward r-dir)
+	(insert ch tmp)
+	(backward-char 1)))))
+
+(defun delete-direction-forward (dir)
+  "From current point, delete DIR-direction charaters forward.
+Returns the deleted string."
+  (let ((p (point)))
+    (skip-direction-forward dir)
+    (prog1
+      (buffer-substring (point) p)
+      (delete-region (point) p))))
+
+(defun delete-direction-backward (dir)
+  "From current point, delete DIR-direction characters backward.
+Return the deleted string."
+  (let ((p (point)))
+    (skip-direction-backward dir)
+    (prog1
+      (buffer-substring (point) p)
+      (delete-region (point) p))))
+
+(defun visual-self-insert-command (arg)
+  "Insert this character (32 <= CH < 127).
+With ARG (integer), insert that many characters.
+If display-direction is non-nil, the cursor stays at the same position."
+  (interactive "*p")
+  (visual-insert-char last-command-char arg)
+  (if display-direction
+      (visual-backward-char arg)))
+
+(defun visual-newline (arg)
+  "newline command for visual-mode.
+With ARG (integer), insert that many newlines."
+  (interactive "*p")
+  (visual-insert-char ?\n arg))
+
+(defun visual-open-line (arg)
+  "open-line command for visual-mode.
+With arg (integer), insert that many newlines."
+  (interactive "*p")
+  (visual-insert-char ?\n arg)
+  (visual-backward-char arg))
+
+
+;; deletion
+
+(defun visual-delete-char (arg)
+  "Delete ARG (integer) characters visually forward.
+If ARG is negative, delete backward."
+  (interactive "*p")
+  (if (< arg 0)
+      (while (< arg 0)
+	(visual-backward-delete-1-char)
+	(setq arg (1+ arg)))
+    (while (> arg 0)
+      (visual-delete-1-char)
+      (setq arg (1- arg)))))
+
+(defun visual-backward-delete-char (arg)
+  "Delete ARG (integer) characters visually backward.
+If arg is negative, delete forward."
+  (interactive "*p")
+  (if (< arg 0)
+      (while (< arg 0)
+	(visual-delete-1-char)
+	(setq arg (1+ arg)))
+    (while (> arg 0)
+      (visual-backward-delete-1-char)
+      (setq arg (1- arg)))))
+
+(fset 'visual-delete-backward-char 'visual-backward-delete-char)
+
+(defun visual-backward-delete-1-char nil
+  "Delete a character visually before the cursor.
+Ther cursor moves visually backward."
+  (let ((d-dir (if display-direction 1 0))
+	(r-dir (if display-direction 0 1))
+	(a-dir (visual-char-direction-after-point))
+	(aa-dir (visual-char-direction-after-after-point))
+	(b-dir (visual-char-direction-before-point))
+	(tmp))
+
+    ;  symbols used in the following comments
+    ; ^  : point in here
+    ; d  : character whose direction is the same as display-direction
+    ; r  : character whose direction is opposite to display-direction
+    ; !d : r or nil
+    ; !r : d or nil
+    ; r* : 0 or more r's
+    ; d* : 0 or more d's
+
+    (if (eq a-dir r-dir)
+	(cond
+	 ((eq aa-dir r-dir)
+	  ; ... r r ...
+	  ;    ^
+	  (forward-char 1)
+	  (delete-char 1)
+	  (backward-char 1))
+
+	 ((save-excursion
+	    (skip-direction-backward r-dir)
+	    (backward-char 1)
+	    (and (eq (visual-char-direction-after-point) d-dir)
+		 (eq (visual-char-direction-before-point) r-dir)))
+	  ; ... r d r* r !r ...
+	  ;           ^
+	  (forward-char 1)
+	  (setq tmp (delete-direction-backward r-dir))
+	  (delete-backward-char 1)
+	  (skip-direction-backward r-dir)
+	  (insert tmp)
+	  (backward-char 1))
+
+	 (t
+	  ; .....!r d r* r !r ...
+	  ;             ^
+	  (skip-direction-backward r-dir)
+	  (delete-backward-char 1)
+	  (skip-direction-forward r-dir)
+	  (backward-char 1)))
+
+      (cond
+       ((null b-dir)
+	; nil !r ...
+	;    ^
+	(error "beginning of buffer"))
+
+       ((eq b-dir r-dir)
+	; ... r !r ...
+	;      ^
+	(skip-direction-backward r-dir)
+	(delete-char 1)
+	(skip-direction-forward r-dir))
+
+       (t
+	; ... !r !r ...
+	;       ^
+	(delete-backward-char 1))))))
+
+(fset 'visual-delete-backward-1-char 'visual-backward-delete-1-char)
+
+(defun visual-delete-1-char nil
+  "Delete a character under the cursor.
+Visually, the cursor stays at the same position."
+  (let ((d-dir (if display-direction 1 0))
+	(r-dir (if display-direction 0 1))
+	(a-dir (visual-char-direction-after-point))
+	(aa-dir (visual-char-direction-after-after-point))
+	(b-dir (visual-char-direction-before-point))
+	(tmp))
+
+    ;  symbols used in the following comments
+    ; ^  : point in here
+    ; d  : character whose direction is the same as display-direction
+    ; r  : character whose direction is opposite to display-direction
+    ; !d : r or nil
+    ; !r : d or nil
+    ; r* : 0 or more r's
+    ; d* : 0 or more d's
+
+    (cond
+     ((null a-dir)
+      ; ... nil
+      ;    ^
+      (error "end of buffer"))
+
+     ((eq a-dir r-dir)
+      (if (eq b-dir r-dir)
+
+	  ; ... r r ...
+	  ;      ^
+	  (progn (delete-char 1)
+		 (backward-char 1))
+
+	; ... !r r ...
+	;       ^
+	(delete-char 1)
+	(skip-direction-forward r-dir)))
+
+     ((not (eq aa-dir r-dir))
+      ; ... d !r ...
+      ;    ^
+      (delete-char 1))
+
+     ((eq b-dir r-dir)
+      ; ... r d r ...
+      ;      ^
+      (delete-char 1)
+      (setq tmp (delete-direction-forward r-dir))
+      (skip-direction-backward r-dir)
+      (insert tmp)
+      (backward-char 1))
+
+     (t
+      ; ...!r d r ...
+      ;      ^
+      (delete-char 1)
+      (skip-direction-forward r-dir)
+      (backward-char 1)))))
+
+(defun visual-delete-region (beg end)
+  "delete-region command for visual-mode."
+  (interactive "*r")
+  (let ((begl) (begc) (endl) (endc) (l))
+
+    ; swap beg & end if necessary
+    (goto-char beg)
+    (setq begl (current-line)
+	  begc (visual-current-column))
+    (goto-char end)
+    (setq endl (current-line)
+	  endc (visual-current-column))
+    (if (or (> begl endl)
+	    (and (= begl endl)
+		 (> begc endc)))
+	(progn
+	  (setq beg (prog1 end (setq end beg))
+		begl (prog1 endl (setq endl begl))
+		begc (prog1 endc (setq endc begc)))
+	  (goto-char end)))
+
+    ; insert a newline visually at END
+    (visual-insert-1-char ?\n)
+    (visual-backward-1-char)
+    (setq l (current-line))
+
+    ; insert a newline visually at BEG
+    (goto-line begl)
+    (visual-goto-column begc)
+    (visual-insert-1-char ?\n)
+    (beginning-of-line)
+
+    (delete-region
+     (point)
+     (progn
+       (goto-line (1+ l))
+       (end-of-line)
+       (point)))
+    (backward-char 1)
+    (visual-delete-char 2)))
+
+(defun current-line nil
+  "Return the current line number (in the buffer) of point."
+  (interactive)
+  (save-excursion
+    (beginning-of-line)
+    (1+ (count-lines 1 (point)))))
+
+
+;; kill
+
+(defun visual-kill-region (beg end)
+  "kill-region command for visual-mode."
+  (interactive "r")
+  (let ((begl) (begc) (endl) (endc) (l))
+
+    ; swap beg & end if necessary
+    (goto-char beg)
+    (setq begl (current-line)
+	  begc (visual-current-column))
+    (goto-char end)
+    (setq endl (current-line)
+	  endc (visual-current-column))
+    (if (or (> begl endl)
+	    (and (= begl endl) (> begc endc)))
+	(progn
+	  (setq beg (prog1 end (setq end beg))
+		begl (prog1 endl (setq endl begl))
+		begc (prog1 endc (setq endc begc)))
+	  (goto-char end)))
+
+  (if (or (and buffer-read-only (not inhibit-read-only))
+	  (text-property-not-all beg end 'read-only nil))
+      (progn
+	(visual-copy-region-as-kill beg end)
+	(if kill-read-only-ok
+	    (message "Read only text copied to kill ring")
+	  (barf-if-buffer-read-only)))
+
+    ; insert a newline visually at END
+    (visual-insert-1-char ?\n)
+    (visual-backward-1-char)
+    (setq l (current-line))
+
+    ; insert a newline visually at BEG
+    (goto-line begl)
+    (visual-goto-column begc)
+    (visual-insert-1-char ?\n)
+    (beginning-of-line)
+
+    (kill-region
+     (point)
+     (progn
+       (goto-line (1+ l))
+       (end-of-line)
+       (point)))
+    (backward-char 1)
+    (visual-delete-char 2)))
+
+  (setq this-command 'kill-region))
+  
+(defun visual-kill-word (arg)
+  "Kill ARG (integer) words visually forward.
+If ARG is negative, kill backward."
+  (interactive "*p")
+  (visual-kill-region
+   (point)
+   (progn
+     (visual-forward-word arg)
+     (point))))
+
+(defun visual-backward-kill-word (arg)
+  "Kill ARG (integer) words visually backward.
+If ARG is negative, kill forward."
+  (interactive "*p")
+  (visual-kill-region
+   (point)
+   (progn
+     (visual-backward-word arg)
+     (point))))
+
+(defun visual-kill-line (&optional arg)
+  "kill-line command for visual-mode."
+  (interactive "*P")
+  (visual-kill-region
+   (point)
+   (progn
+     (if arg
+	 (progn
+	   (forward-line (prefix-numeric-value arg))
+	   (visual-beginning-of-line))
+       (if (eobp)
+	   (signal 'end-of-buffer nil))
+       (if (not (eolp))
+	   (visual-end-of-line)
+	 (forward-line 1)
+	 (visual-beginning-of-line)))
+     (point))))
+
+(defun visual-copy-region-as-kill (beg end)
+  "copy-region-as-kill command for visual-mode."
+  (interactive "r")
+  (let ((buffer-read-only nil)
+	(auto-save-mode 0)
+	(p (point)))
+    (visual-kill-region beg end)
+    (visual-yank 1)
+    (if (/= (point) p)
+	(exchange-point-and-mark)))
+  nil)
+
+(defun visual-kill-ring-save (beg end)
+  "kill-ring-save command for visual-mode."
+  (interactive "r")
+  (visual-copy-region-as-kill beg end)
+  (if (interactive-p)
+      (let ((other-end (if (= (point) beg) end beg))
+	    (opoint (point))
+	    (inhibit-quit t))
+	(if (pos-visible-in-window-p other-end (selected-window))
+	    (progn
+	      (set-marker (mark-marker) (point) (current-buffer))
+	      (goto-char other-end)
+	      (sit-for 1)
+	      (set-marker (mark-marker) other-end (current-buffer))
+	      (goto-char opoint)
+	      (and quit-flag mark-active
+		   (deactivate-mark)))
+	  (let* ((killed-text (current-kill 0))
+		 (message-len (min (length killed-text) 40)))
+	    (if (= (point) beg)
+		(message "Saved text until \"%s\""
+			(substring killed-text (- message-len)))
+	      (message "Saved text from \"%s\""
+		      (substring killed-text 0 message-len))))))))
+      
+
+;; yank
+
+(defun visual-yank (&optional arg)
+  "yank command for visual-mode."
+  (interactive "*P")
+  (setq this-command t)
+
+  (let ((l1 (current-line)) (c1 (visual-current-column)) l2 c2)
+
+    ;; Insert a newline both before and after current point.
+    (visual-insert-char ?\n 2)
+    (visual-backward-1-char)
+
+    ;; Reinsert killed string between the two newlines.
+    (insert (current-kill (cond
+			   ((listp arg) 0)
+			   ((eq arg '-) -1)
+			   (t (1- arg)))))
+
+    ;; Delete the latter newline visually.
+    (visual-delete-1-char)
+    (setq l2 (current-line)
+	  c2 (visual-current-column))
+
+    ;; Delete the former newline visually.
+    (goto-line l1)
+    (end-of-line)
+    (visual-delete-1-char)
+    (push-mark (point))
+
+    ;; Go back to the end of yanked string.
+    (if (= (- l2 l1) 1)
+	(visual-goto-column (+ c1 c2))
+      (goto-line (1- l2))
+      (visual-goto-column c2))
+
+    ;; Exchange point and mark if necessary.
+    (if (consp arg)
+	(goto-char (prog1 (mark t)
+		     (set-marker (mark-marker) (point) (current-buffer))))))
+
+  (setq this-command 'yank)
+  nil)
+
+(defun visual-yank-pop (arg)
+  "yank-pop command for visual-mode."
+  (interactive "*p")
+  (if (not (eq last-command 'yank))
+      (error "Previous command was not a yank"))
+  (setq this-command 'yank)
+  (let (l1 c1 l2 c2 before)
+
+    (save-excursion
+      (setq l2 (current-line)
+	    c2 (visual-current-column))
+      (goto-char (mark t))
+      (setq l1 (current-line)
+	    c1 (visual-current-column))
+      (if (or (> l1 l2)
+	      (and (= l1 l2) (> c1 c2)))
+	  (setq before t)))
+
+    (visual-delete-region (point) (mark t))
+    (setq l1 (current-line)
+	  c1 (visual-current-column))
+
+    ;; Insert a newline both before and after current point.
+    (visual-insert-char ?\n 2)
+    (visual-backward-1-char)
+
+    ;; Reinsert killed string between the two newlines.
+    (insert (current-kill arg))
+
+    ;; Delete the latter newline visually.
+    (visual-delete-1-char)
+    (setq l2 (current-line)
+	  c2 (visual-current-column))
+
+    ;; Delete the former newline visually.
+    (goto-line l1)
+    (end-of-line)
+    (visual-delete-1-char)
+    (set-marker (mark-marker) (point) (current-buffer))
+
+    ;; Go back to the end of yanked string.
+    (if (= (- l2 l1) 1)
+	(visual-goto-column (+ c1 c2))
+      (goto-line (1- l2))
+      (visual-goto-column c2))
+
+    ;; Exchange point and mark if necessary.
+    (if before
+	(goto-char (prog1 (mark t)
+		     (set-marker (mark-marker) (point) (current-buffer))))))
+
+  nil)
+
+
+;; misc
+
+(defun visual-reverse-direction-word nil
+  "Reverse the char order of the word before point."
+  (interactive "*")
+  (goto-char
+    (prog1
+      (point)
+      (reverse-region
+       (point)
+       (progn (skip-direction-backward (visual-char-direction-before-point))
+	      (point))))))
+
+(defun visual-reverse-region (begin end)
+  "Reverse the order of chars between BEGIN and END."
+  (interactive "*r")
+  (apply 'insert
+	 (nreverse
+	  (string-to-char-list
+	   (prog1 (buffer-substring begin end) (delete-region begin end))))))
+
+
+;; LR commands
+
+(defun visual-char-left nil
+  "Return the character on the left of visual point."
+  (if display-direction
+      (visual-char-after)
+    (visual-char-before)))
+
+(defun visual-char-right nil
+  "Return the character on the right of visual point."
+  (if display-direction
+      (visual-char-before)
+    (visual-char-after)))
+
+(defun visual-move-to-left-char (arg)
+  "Move the cursor visually left by ARG (integer) characters.
+If ARG is negative, move the cursor right."
+  (interactive "p")
+  (if display-direction
+      (visual-forward-char arg)
+    (visual-backward-char arg)))
+
+(defun visual-move-to-left-1-char nil
+  "Move the cursor visually left by 1 character."
+  (interactive "p")
+  (if display-direction
+      (visual-forward-1-char)
+    (visual-backward-1-char)))
+
+(defun visual-move-to-right-char (arg)
+  "Move the cursor visually right by ARG (integer) characters.
+If ARG is negative, move the cursor left."
+  (interactive "p")
+  (if display-direction
+      (visual-backward-char arg)
+    (visual-forward-char arg)))
+
+(defun visual-move-to-right-1-char nil
+  "Move the cursor visually right by 1 character."
+  (interactive "p")
+  (if display-direction
+      (visual-backward-1-char)
+    (visual-forward-1-char)))
+
+(defun visual-move-to-left-word (arg)
+  "Move the cursor visually left by ARG (integer) words.
+If ARG is negative, move the cursor right."
+  (interactive "p")
+  (if display-direction
+      (visual-forward-word arg)
+    (visual-backward-word arg)))
+
+(defun visual-move-to-right-word (arg)
+  "Move the cursor visually right by ARG (integer) words.
+If ARG is negative, move the cursor left."
+  (interactive "p")
+  (if display-direction
+      (visual-backward-word arg)
+    (visual-forward-word arg)))
+
+(defun visual-left-end-of-line (arg)
+  "Move the line cursor to the left-end of line.
+With ARG not nil, move forward ARG - 1 lines first.
+If scan reaches end of buffer, stop there without error."
+  (interactive "P")
+  (if display-direction
+      (visual-end-of-line arg)
+    (visual-beginning-of-line arg)))
+
+(defun visual-right-end-of-line (arg)
+  "Move the line cursor to the right-end of line.
+With ARG not nil, move forward ARG - 1 lines first.
+If scan reaches end of buffer, stop there without error."
+  (interactive "P")
+  (if display-direction
+      (visual-beginning-of-line arg)
+    (visual-end-of-line arg)))
+
+(defun visual-insert-char-left (ch arg)
+  "Insert CH (character) on the left of visual point as many as
+ARG (integer)."
+  (if (< arg 0)
+      (error "ARG must be >= 0."))
+  (visual-insert-char ch arg)
+  (and display-direction
+       (visual-backward-char arg)))
+
+(defun visual-insert-left-1-char (ch)
+  "Insert CH (character) on the left of visual point."
+  (visual-insert-1-char ch)
+  (and display-direction
+       (visual-backward-1-char)))
+
+(defun visual-insert-char-right (ch arg)
+  "Insert CH (character) on the right of visual point as many as
+ARG (integer)."
+  (if (< arg 0)
+      (error "ARG must be >= 0."))
+  (visual-insert-char ch arg)
+  (or display-direction
+      (visual-backward-char arg)))
+
+(defun visual-insert-right-1-char (ch)
+  "Insert CH (character) on the right of visual point."
+  (visual-insert-1-char ch)
+  (or display-direction
+      (visual-backward-1-char)))
+
+(defun visual-delete-left-char (arg)
+  "Delete ARG (integer) characters on the left of visual point.
+If ARG is negative, on the right."
+  (interactive "*p")
+  (if display-direction
+      (visual-delete-char arg)
+    (visual-backward-delete-char arg)))
+
+(defun visual-delete-left-1-char nil
+  "Delete 1 character on the left of visual point."
+  (interactive "*p")
+  (if display-direction
+      (visual-delete-1-char)
+    (visual-backward-delete-1-char)))
+
+(defun visual-delete-right-char (arg)
+  "Delete ARG (integer) characters on the right of visual point.
+If ARG is negative, on the left."
+  (interactive "*p")
+  (if display-direction
+      (visual-backward-delete-char arg)
+    (visual-delete-char arg)))
+
+(defun visual-delete-right-1-char nil
+  "Delete 1 character on the right of visual point."
+  (interactive "*p")
+  (if display-direction
+      (visual-backward-delete-1-char)
+    (visual-delete-1-char)))
+
+(defmacro visual-replace-left-1-char (ch)
+  (list
+   'progn
+   '(visual-delete-left-1-char)
+   (list 'visual-insert-left-1-char ch)))
+
+(defmacro visual-replace-right-1-char (ch)
+  (list
+   'progn
+   '(visual-delete-right-1-char)
+   (list 'visual-insert-right-1-char ch)))
+
+(defun visual-kill-left-word (arg)
+  "Kill ARG (integer) words on the left of visual pointer.
+If ARG is negative, kill on the right."
+  (interactive "*p")
+  (if display-direction
+      (visual-kill-word arg)
+    (visual-backward-kill-word arg)))
+
+(defun visual-kill-right-word (arg)
+  "Kill ARG (integer) words on the right of visual point.
+If ARG is negative, kill on the left."
+  (interactive "*p")
+  (if display-direction
+      (visual-backward-kill-word arg)
+    (visual-kill-word arg)))
+
+;;;
+(provide 'visual-mode)