Source

skk / skk-viper.el

Diff from to

skk-viper.el

-;;; skk-viper.el --- SKK related code for Viper
-;; Copyright (C) 1996, 1997
-;; Masahiko Sato <masahiko@kuis.kyoto-u.ac.jp>, Murata Shuuichirou <mrt@mickey.ai.kyutech.ac.jp>
+;; skk-viper.el --- SKK related code for Viper
+;; Copyright (C) 1996, 1997, 1998, 1999
+;; Masahiko Sato <masahiko@kuis.kyoto-u.ac.jp>, Murata Shuuichirou <mrt@astec.co.jp>
 ;;
 ;; Author: Masahiko Sato <masahiko@kuis.kyoto-u.ac.jp>,
-;;         Murata Shuuichirou <mrt@mickey.ai.kyutech.ac.jp>
-;; Maintainer: Murata Shuuichirou <mrt@mickey.ai.kyutech.ac.jp>
+;;         Murata Shuuichirou <mrt@notwork.org>
+;; Maintainer: Murata Shuuichirou <mrt@notwork.org>
 ;;             Mikio Nakajima <minakaji@osaka.email.ne.jp>
 ;; Version: $Id$
 ;; Keywords: japanese
 ;; Last Modified: $Date$
 
-;; This program is free software; you can redistribute it and/or modify
+;; This file is not part of SKK yet.
+
+;; SKK 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 versions 2, or (at your option)
 ;; any later version.
 
-;; This program is distributed in the hope that it will be useful
+;; SKK 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.
 
 ;;; Commentary:
 
-;; Following people contributed modifications to skk.el (Alphabetical order):
-;;      Mikio Nakajima <minakaji@osaka.email.ne.jp>
-;;      Murata Shuuichirou <mrt@mickey.ai.kyutech.ac.jp>
-
-;;; Change log:
-
 ;;; Code:
+(eval-when-compile (require 'skk))
 (require 'skk-foreword)
-(require 'skk-vars)
-(require 'advice)
 (require 'viper)
 
-(setq skk-use-viper t)
+;;(defgroup skk-viper nil "SKK/Viper related customization."
+;;  :prefix "skk-"
+;;  :group 'skk )
 
-;;;###skk-autoload
-(defvar skk-viper-normalize-map-function nil
+;; internal constant.
+;;;###autoload
+(defconst skk-viper-use-vip-prefix
+  (not (fboundp 'viper-normalize-minor-mode-map-alist)))
+
+;;;###autoload
+(defconst skk-viper-normalize-map-function
+  (if skk-viper-use-vip-prefix 
+      'vip-normalize-minor-mode-map-alist 
+    'viper-normalize-minor-mode-map-alist )
   "Viper $B$,(B minor-mode-map-alist $B$rD4@0$9$k$?$a$N4X?t!#(B" )
 
-(defvar skk-viper-or-vip 
-  (if (fboundp 'viper-normalize-minor-mode-map-alist)
-      'viper
-    'vip ))
+;; macros and inline functions.
+(defmacro skk-viper-advice-select (viper vip arg body)
+  (` (if skk-viper-use-vip-prefix
+	 (defadvice (, vip) (, arg) (,@ body))
+       (defadvice (, viper) (, arg) (,@ body)))))
 
-(let ((other-buffer
-       (if skk-xemacs
-           (local-variable-p 'minor-mode-map-alist nil t)
-         (local-variable-p 'minor-mode-map-alist) )))
-  (require 'viper)
-  ;; for current buffer and buffers to be created in the future.
-  ;; substantially the same job as vip-harness-minor-mode does.
-  (setq skk-viper-normalize-map-function
-	(if (eq skk-viper-or-vip 'viper)
-	    'viper-normalize-minor-mode-map-alist
-	  'vip-normalize-minor-mode-map-alist ))
-  (funcall skk-viper-normalize-map-function)
-  (setq-default minor-mode-map-alist minor-mode-map-alist)
-  (if (not other-buffer)
-      nil
-    ;; for buffers which are already created and have the minor-mode-map-alist
-    ;; localized by Viper.
-    (save-current-buffer
-      (let ((buf (buffer-list)))
-        (while buf
-          (set-buffer (car buf))
-          (if (null (assq 'skk-j-mode minor-mode-map-alist))
-              (progn
-                (setq minor-mode-map-alist
-                      (nconc
-                       (list
-                        (cons 'skk-abbrev-mode skk-abbrev-mode-map)
-                        (cons 'skk-ascii-mode skk-ascii-mode-map)
-                        (cons 'skk-j-mode skk-j-mode-map)
-                        (cons 'skk-zenkaku-mode skk-zenkaku-mode-map) )
-                       minor-mode-map-alist ))
-                (funcall skk-viper-normalize-map-function) ))
-          (setq buf (cdr buf)) )))))
+(setq skk-kana-cleanup-command-list
+      (cons 
+       (if skk-viper-use-vip-prefix
+	   'vip-del-backward-char-in-insert
+	 'viper-del-backward-char-in-insert )
+       skk-kana-cleanup-command-list ))
 
-(setq sentence-end (concat "[$B!#!)!*(B]\\|" sentence-end))
+(setq skk-use-viper t)
+(save-match-data
+  (or (string-match sentence-end "$B!#!)!*(B")
+      (setq sentence-end (concat "[$B!#!)!*(B]\\|" sentence-end))))
 
-(defsubst skk-looking-at-jisx0208 (char)
-  (eq 'japanese-jisx0208 (car (find-charset-string (char-to-string char)))) )
+;; cursor color support.
+(if (and (boundp 'viper-insert-state-cursor-color)
+	 viper-insert-state-cursor-color
+	 (fboundp 'viper-color-defined-p)
+	 (viper-color-defined-p viper-insert-state-cursor-color))
+    (setq skk-use-color-cursor nil))
 
-(defmacro skk-viper-advice-select (viper vip arg body)
-  (` (if (eq skk-viper-or-vip 'viper)
-	 (defadvice (, viper) (, arg) (,@ body))
-       (defadvice (, vip) (, arg) (,@ body)) )))
-       
+;; advices.
+(defadvice skk-cursor-set-properly (before skk-viper-ad activate)
+  "vi-state $B$N$H$-$O!"(BSKK $B%b!<%I$K$J$C$F$$$F$b%+!<%=%k$r%G%#%U%)%k%H$K$7$F$*$/!#(B"
+  (if (or (and (boundp 'viper-current-state)
+	       (eq viper-current-state 'vi-state))
+	  (and (boundp 'vip-current-state)
+	       (eq vip-current-state 'vi-state)))
+      (ad-set-arg 0 skk-default-cursor-color)))
+
 (skk-viper-advice-select
  viper-forward-word-kernel vip-forward-word-kernel
  (around skk-ad activate)
- ((if skk-mode 
-      (let ((enable-multibyte-characters t))
-        (forward-word val) )
+ ("SKK $B%b!<%I$,%*%s$G!"%]%$%s%H$ND>8e$NJ8;z$,(B JISX0208 $B$@$C$?$i(B forward-word $B$9$k!#(B"
+  (if (and skk-mode (skk-jisx0208-p (following-char)))
+      (forward-word val)
     ad-do-it )))
- 
+
 (skk-viper-advice-select
  viper-backward-word-kernel vip-backward-word-kernel
  (around skk-ad activate)
- ((if skk-mode
-      (let ((enable-multibyte-characters t))
-        (backward-word val) )
+ ("SKK $B%b!<%I$,%*%s$G!"%]%$%s%H$ND>A0$NJ8;z$,(B JISX0208 $B$@$C$?$i(B backward-word $B$9$k!#(B"
+  (if (and skk-mode (skk-jisx0208-p (preceding-char)))
+      (backward-word val)
     ad-do-it )))
 
+;; please sync with advice to delete-backward-char
 (skk-viper-advice-select
  viper-del-backward-char-in-insert vip-del-backward-char-in-insert
  (around skk-ad activate)
- ((cond ((and skk-henkan-on (>= skk-henkan-start-point (point)))
-         (setq skk-henkan-count 0)
-         (skk-kakutei) )
-        (skk-henkan-active
-         (if (and (not skk-delete-implies-kakutei)
-                  (= skk-henkan-end-point (point)) )
-             (skk-previous-candidate)
-           (if skk-use-face (skk-henkan-face-off))
-           (if overwrite-mode
-               (progn
-                 (backward-char 1)
-                 (delete-char 1) )
-             (delete-backward-char 1)
-	     (if (>= skk-henkan-end-point (point)) (skk-kakutei)) )))
-        ((and skk-henkan-on overwrite-mode)
-         (backward-char 1)
-         (delete-char 1) )
-        (t ad-do-it) )))
- 
+ ("$B"'%b!<%I$G(B skk-delete-implies-kakutei $B$,(B non-nil $B$@$C$?$iD>A0$NJ8;z$r>C$7$F3NDj$9$k!#(B
+$B"'%b!<%I$G(B skk-delete-implies-kakutei $B$,(B nil $B$@$C$?$iA08uJd$rI=<($9$k!#(B
+$B"&%b!<%I$@$C$?$i3NDj$9$k!#(B
+$B3NDjF~NO%b!<%I$G!"$+$J%W%l%U%#%C%/%9$NF~NOCf$J$i$P!"$+$J%W%l%U%#%C%/%9$r>C$9!#(B"
+  (let ((count (or (prefix-numeric-value (ad-get-arg 0)) 1)))
+    (cond (skk-henkan-active
+	   (if (and (not skk-delete-implies-kakutei)
+		    (= skk-henkan-end-point (point)))
+	       (skk-previous-candidate)
+	     ;;(if skk-use-face (skk-henkan-face-off))
+ 	     ;; overwrite-mode $B$G!"%]%$%s%H$,A43QJ8;z$K0O$^$l$F$$$k$H(B
+	     ;; $B$-$K(B delete-backward-char $B$r;H$&$H!"A43QJ8;z$O>C$9$,H>(B
+	     ;; $B3QJ8;zJ,$7$+(B backward $BJ}8~$K%]%$%s%H$,La$i$J$$(B (Emacs
+	     ;; 19.31 $B$K$F3NG'(B)$B!#JQ49Cf$N8uJd$KBP$7$F$O(B
+	     ;; delete-backward-char $B$GI,$:A43QJ8;z(B 1 $BJ8;zJ,(B backward
+	     ;; $BJ}8~$KLa$C$?J}$,NI$$!#(B
+	     (if overwrite-mode
+		 (progn
+		   (backward-char count)
+		   (delete-char count))
+	       ad-do-it )
+	     ;; XXX assume skk-prefix has no multibyte chars.
+	     (if (> (length skk-prefix) count)
+		 (setq skk-prefix (substring skk-prefix 0 (- (length skk-prefix) count)))
+	       (setq skk-prefix ""))
+	     (if (>= skk-henkan-end-point (point)) (skk-kakutei))))
+	  ((and skk-henkan-on (>= skk-henkan-start-point (point)))
+	   (setq skk-henkan-count 0)
+	   (skk-kakutei))
+	  ;; $BF~NOCf$N8+=P$78l$KBP$7$F$O(B delete-backward-char $B$GI,$:A43QJ8;z(B 1
+	  ;; $BJ8;zJ,(B backward $BJ}8~$KLa$C$?J}$,NI$$!#(B
+	  ((and skk-henkan-on overwrite-mode)
+	   (backward-char count)
+	   (delete-char count))
+	  (t
+	   (if (string= skk-prefix "")
+	       ad-do-it
+	     (skk-erase-prefix 'clean)))))))
+
 (skk-viper-advice-select
  viper-intercept-ESC-key vip-intercept-ESC-key
  (before skk-add activate)
  ("$B"&%b!<%I!""'%b!<%I$@$C$?$i3NDj$9$k!#(B"
-  (and skk-mode skk-henkan-on (skk-kakutei)) ))
+  (and skk-mode skk-henkan-on (skk-kakutei))))
 
 (skk-viper-advice-select
  viper-join-lines vip-join-lines
  (after skk-ad activate)
- ("$B%9%Z!<%9$NN>B&$NJ8;z%;%C%H$,(B JISX0208 $B$@$C$?$i%9%Z!<%9$r<h$j=|$/!#(B"
+ ("$B%9%Z!<%9$NN>B&$NJ8;z%;%C%H$,(B JISX0208 $B$@$C$?$i%9%Z!<%9$r<h$j=|$/!#(B" ;
   (save-match-data
-    (and (skk-save-point
-	  (skip-chars-backward " ")
-	  (string-match "\\c|" (char-to-string (preceding-char))) )
-         (skk-save-point
-	  (skip-chars-forward " ")
-	  (string-match "\\c|" (char-to-string (following-char))) )
-         (delete-char 1) ))))
+    (and (skk-jisx0208-p
+	  (char-after (progn (skip-chars-forward " ") (point))))
+	 (skk-jisx0208-p
+	  (char-before (progn (skip-chars-backward " ") (point))))
+	 (while (looking-at " ")
+	   (delete-char 1))))))
 
-;;(defadvice vip-insert (after skk-ad activate)
-;;  "skk-mode $B$@$C$?$i$+$J%b!<%I$K$9$k!#(B"
-;;  (if skk-mode (skk-j-mode-on)) )
+;;; Functions.
+;;;###autoload
+(defun skk-viper-normalize-map ()
+  (let ((other-buffer
+	 (if (eq skk-emacs-type 'xemacs)
+	     (local-variable-p 'minor-mode-map-alist nil t)
+	   (local-variable-p 'minor-mode-map-alist))))
+    ;; for current buffer and buffers to be created in the future.
+    ;; substantially the same job as viper-harness-minor-mode does.
+    (funcall skk-viper-normalize-map-function)
+    (setq-default minor-mode-map-alist minor-mode-map-alist)
+    (if (not other-buffer)
+	nil
+      ;; for buffers which are already created and have the minor-mode-map-alist
+      ;; localized by Viper.
+      (save-current-buffer
+	(let ((buf (buffer-list)))
+	  (while buf
+	    (set-buffer (car buf))
+	    (if (null (assq 'skk-j-mode minor-mode-map-alist))
+		(progn
+		  (set-modified-alist
+		   'minor-mode-map-alist
+		   (list (cons 'skk-latin-mode skk-latin-mode-map)
+			 (cons 'skk-abbrev-mode skk-abbrev-mode-map)
+			 (cons 'skk-j-mode skk-j-mode-map)
+			 (cons 'skk-jisx0208-latin-mode skk-jisx0208-latin-mode-map)))
+		  (funcall skk-viper-normalize-map-function)))
+	    (setq buf (cdr buf))))))))
 
-;;(defadvice vip-Insert (after skk-ad activate)
-;;  "skk-mode $B$@$C$?$i$+$J%b!<%I$K$9$k!#(B"
-;;  (if skk-mode (skk-j-mode-on)) )
+(eval-after-load "viper-cmd"
+  '(defun viper-toggle-case (arg)
+     "Toggle character case."
+     (interactive "P")
+     (let ((val (viper-p-val arg)) (c))
+       (viper-set-destructive-command
+	(list 'viper-toggle-case val nil nil nil nil))
+       (while (> val 0)
+	 (setq c (following-char))
+	 (delete-char 1 nil)
+	 (cond ((skk-ascii-char-p c)
+		(if (eq c (upcase c))
+		    (insert-char (downcase c) 1)
+		  (insert-char (upcase c) 1)))
+	       ((and (<= ?$B$!(B c) (>= ?$B$s(B c))
+		(insert-string
+		 (skk-hiragana-to-katakana (char-to-string c))))
+	       ((and (<= ?$B%!(B c) (>= ?$B%s(B c))
+		(insert-string
+		 (skk-katakana-to-hiragana (char-to-string c))))
+	       (t (insert-char c 1)))
+	 (if (eolp) (backward-char 1))
+	 (setq val (1- val))))))
 
-;;(defadvice vip-open-line (after skk-ad activate)
-;;  "skk-mode $B$@$C$?$i$+$J%b!<%I$K$9$k!#(B"
-;;  (if skk-mode (skk-j-mode-on)) )
-
-;;(defadvice vip-Open-line (after skk-ad activate)
-;;  "skk-mode $B$@$C$?$i$+$J%b!<%I$K$9$k!#(B"
-;;  (if skk-mode (skk-j-mode-on)) )
-
-;;(defadvice vip-append (after skk-ad activate)
-;;  "skk-mode $B$@$C$?$i$+$J%b!<%I$K$9$k!#(B"
-;;  (if skk-mode (skk-j-mode-on)) )
-
-;;(defadvice vip-Append (after skk-ad activate)
-;;  "skk-mode $B$@$C$?$i$+$J%b!<%I$K$9$k!#(B"
-;;  (if skk-mode (skk-j-mode-on)) )
-
-;;(defadvice vip-overwrite (after skk-ad activate)
-;;  "skk-mode $B$@$C$?$i$+$J%b!<%I$K$9$k!#(B"
-;;  (if skk-mode (skk-j-mode-on)) )
-
-;;;; $B$3$j$c%@%a$C$9$M!#(B
-;;;;(defadvice vip-replace-char (after skk-ad activate)
-;;;;  "skk-mode $B$@$C$?$i$+$J%b!<%I$K$9$k!#(B"
-;;;;  (if skk-mode (skk-j-mode-on)) )
+(skk-viper-normalize-map)
 
 (provide 'skk-viper)
 ;;; skk-viper.el ends here