日本語を考慮してforward-word

最近twitterでつぶやいてばっかで書いてなかった超久々日記。
forward-wordで漢字/ひらがな/カタカナをきっちり分けて飛べないのが気になったので、なんとなく作成。用途不明。
dabbrev-ja.elを超参考にして作成。
あんまりテストしてないけど、とりあえず動いてるかなー。

(defun my-forward-word (arg)
  (interactive "p")
  (let ((char-category
         '(lambda (ch)
            (when ch
              (let* ((c (char-category-set ch))
                     ct)
                (cond
                 ((aref c ?a)
                  (cond
                   ((or (and (>= ?z ch) (>= ch ?a))
                        (and (>= ?Z ch) (>= ch ?A))
                        (and (>= ?9 ch) (>= ch ?0))
                        (= ch ?-) (= ch ?_))
                    'alphnum)
                   (t
                    'ex-alphnum)))
                 ((aref c ?j) ; Japanese
                  (cond
                   ((aref c ?K) 'katakana)
                   ((aref c ?A) '2alphnum)
                   ((aref c ?H) 'hiragana)
                   ((aref c ?C) 'kanji)
                   (t 'ja)))
                 ((aref c ?k) 'hankaku-kana)
                 ((aref c ?r) 'j-roman)
                 (t 'etc))))))
        char type)
    (when (null arg) (setq arg 1))
    (while (> arg 0)
      (setq char (char-after))
      (setq type (funcall char-category char))
      (while (and (prog1 (not (eq (point) (point-max)))
                    (goto-char (1+ (point))))
                  (eq type (funcall char-category (char-after)))))
      (setq arg (1- arg)))))

引数argが負だった場合、逆方向に検索とか考えてない。
つか、これで調べると「ー」って、カタカナなんだね。驚いたわ。
なんかホントに用途がよく分かんない関数をでっちあげたな…。素のforward-wordでいいじゃんっていう…。
# つか、これ、よく考えたら、次の「単語」に飛ぶ、じゃないな…。そういう点で素のforward-wordは日本語でも正しく動作してるか…。

追記

逆方向にも対応させてみた。
なんとなくM-f/M-bは、これくらい細かく対応してくれた方が嬉しいかもとか思った。とりあえず素のM-f/M-bの代わりとして使ってみようかなとか。
返り値は、ポイント返した方が良いかなあ…。内部で使ってるよくわからないシンボルを返すよりも。
まあいいや。それは最後のtypeを(point)にすりゃいいだけだし。

(defun my-forward-word (arg)
  (interactive "p")
  (let ((char-category
         '(lambda (ch)
            (when ch
              (let* ((c (char-category-set ch))
                     ct)
                (cond
                 ((aref c ?a)
                  (cond
                   ((or (and (>= ?z ch) (>= ch ?a))
                        (and (>= ?Z ch) (>= ch ?A))
                        (and (>= ?9 ch) (>= ch ?0))
                        (= ch ?-) (= ch ?_))
                    'alphnum)
                   (t
                    'ex-alphnum)))
                 ((aref c ?j) ; Japanese
                  (cond
                   ((aref c ?K) 'katakana)
                   ((aref c ?A) '2alphnum)
                   ((aref c ?H) 'hiragana)
                   ((aref c ?C) 'kanji)
                   (t 'ja)))
                 ((aref c ?k) 'hankaku-kana)
                 ((aref c ?r) 'j-roman)
                 (t 'etc))))))
        (direction 'char-after)
        char type)
    (when (null arg) (setq arg 1))
    (when (> 0 arg)
      (setq arg (- arg))
      (setq direction 'char-before))
    (while (> arg 0)
      (setq char (funcall direction))
      (setq type (funcall char-category char))
      (while (and (prog1 (not (eq (point) (point-max)))
                    (cond ((eq direction 'char-after)
                           (goto-char (1+ (point))))
                          (t
                           (goto-char (1- (point))))))
                  (eq type (funcall char-category (funcall direction)))))
      (setq arg (1- arg)))
    type))
(defun my-backward-word (arg)
  (interactive "p")
  (my-forward-word (- (or arg 1))))

;; 素のforward-word, backward-wordを潰す
(global-set-key "\M-f" 'my-forward-word)
(global-set-key "\M-b" 'my-backward-word)

更新時刻

• 2009/06/05/00:25
• 2009/06/06/00:39