From 70fd74cfc50a1cc60aaed7e45a250c2f4d053c37 Mon Sep 17 00:00:00 2001
From: tarao <tarao.gnn@gmail.com>
Date: Tue, 3 Aug 2010 10:09:33 +0000
Subject: [PATCH] Vim compatible behaviour (but it is not fully compatible when
 it is used with -iw and -aw).

---
 vimpulse-cjk.el | 92 +++++++++++++++++++++++++++++++++++++------------
 1 file changed, 70 insertions(+), 22 deletions(-)

diff --git a/vimpulse-cjk.el b/vimpulse-cjk.el
index c3a7361..e2cdc1d 100644
--- a/vimpulse-cjk.el
+++ b/vimpulse-cjk.el
@@ -1,29 +1,77 @@
+(defgroup vimpulse-cjk nil
+  "CJK patch for Viper/Vimpulse"
+  :prefix "vimpulse-cjk-"
+  :group 'vimpulse)
+
+(defcustom vimpulse-cjk-want-japanese-phrase-as-word nil
+  "Treats successive kanjis and hiraganas as a word.
+This is rather Emacs behaviour than Vim."
+  :type 'boolean
+  :group 'vimpulse-cjk)
+
+(defun viper-cjk-category (ch)
+  (let ((cat (char-category-set ch))
+        (list '(?K ; katakana
+                ?A ; full-width alpha-numeric
+                ?H ; hiragana
+                ?C ; kanji
+                ?k ; half-width kana
+                ?r ; Japanese roman ?
+                ?j ; Japanese
+                ?c ; Chinese
+                ?h ; Korean
+                )))
+    (let (r) (dolist (x list r) (setq r (or r (when (aref cat x) x)))))))
+
+(defun viper-cjk-category-after (pos)
+  (and (< pos (point-max)) (viper-cjk-category (char-after pos))))
+
+(defun viper-cjk-category-before (pos)
+  (and (< (point-min) pos) (viper-cjk-category (char-before pos))))
+
 (defun viper-looking-at-cjk ()
-  (let ((pos (point)))
-    (when (< pos (point-max))
-      (let* ((ch (char-after pos))
-             (cat (char-category-set ch)))
-        (or (aref cat ?c) ; Chinese
-            (aref cat ?j) ; Japanese
-            (aref cat ?h) ; Korean
-            )))))
+  (viper-cjk-category-after (point)))
+
+(defun viper-skip-cjk-forward (&optional cat)
+  (let ((cat (viper-cjk-category-after (point))))
+    (when cat
+      (while (= cat (or (viper-cjk-category-after (point)) 0))
+        (forward-char)))))
+
+(defun viper-skip-cjk-backward (&optional cat)
+  (let ((cat (viper-cjk-category-after (point))))
+    (when cat
+      (while (= cat (or (viper-cjk-category-before (point)) 0))
+        (backward-char)))))
+
 (defadvice viper-looking-at-alpha
   (around ad-viper-looking-at-alpha-cjk activate)
-  (or ad-do-it (viper-looking-at-cjk)))
+  (or ad-do-it (and vimpulse-cjk-want-japanese-phrase-as-word
+                    (viper-looking-at-cjk))))
+
 (defadvice viper-skip-alpha-forward
-  (around ad-viper-skip-alpha-forward (arg) activate)
-  (forward-word)
-  (when (and arg (looking-at arg))
-    (forward-char)
-    (when (viper-looking-at-alpha) (viper-skip-alpha-forward arg))))
+  (around ad-viper-skip-alpha-forward-cjk (arg) activate)
+  (let ((cjk (viper-looking-at-cjk)))
+    (if (and cjk (not vimpulse-cjk-want-japanese-phrase-as-word))
+        (viper-skip-cjk-forward)
+      (forward-word))
+    (when (and (not cjk) arg (looking-at arg))
+      (forward-char)
+      (when (viper-looking-at-alpha) (viper-skip-alpha-forward arg)))))
+
 (defadvice viper-skip-alpha-backward
-  (around ad-viper-skip-alpha-backward (arg) activate)
-  (backward-word)
-  (when (and (< (point-min) (point))
-             (string= (string (char-before (point))) (or arg "")))
-    (backward-char)
-    (when (and (< (point-min) (point))
-               (save-excursion (backward-char) (viper-looking-at-alpha)))
-      (viper-skip-alpha-backward arg))))
+  (around ad-viper-skip-alpha-backward-cjk (arg) activate)
+  (let ((cjk (viper-looking-at-cjk)))
+    (if (and cjk (not vimpulse-cjk-want-japanese-phrase-as-word))
+        (viper-skip-cjk-backward)
+      (backward-word))
+    (when (and (not cjk)
+               arg
+               (< (point-min) (point))
+               (string= (string (char-before (point))) arg))
+      (backward-char)
+      (when (and (< (point-min) (point))
+                 (save-excursion (backward-char) (viper-looking-at-alpha)))
+        (viper-skip-alpha-backward arg)))))
 
 (provide 'vimpulse-cjk)