cgit.sxemacs.org Git - packages/blob - mule-packages/skk/skk-viper.el

   1 ;; skk-viper.el --- SKK related code for Viper
   2 ;; Copyright (C) 1996, 1997, 1998, 1999
   3 ;; Masahiko Sato <masahiko@kuis.kyoto-u.ac.jp>, Murata Shuuichirou <mrt@astec.co.jp>
   4 ;;
   5 ;; Author: Masahiko Sato <masahiko@kuis.kyoto-u.ac.jp>,
   6 ;;         Murata Shuuichirou <mrt@notwork.org>
   7 ;; Maintainer: Murata Shuuichirou <mrt@notwork.org>
   8 ;;             Mikio Nakajima <minakaji@osaka.email.ne.jp>
   9 ;; Version: $Id: skk-viper.el,v 1.2 2000-07-10 04:34:02 yoshiki Exp $
  10 ;; Keywords: japanese
  11 ;; Last Modified: $Date: 2000-07-10 04:34:02 $
  12
  13 ;; This file is not part of SKK yet.
  14
  15 ;; SKK is free software; you can redistribute it and/or modify
  16 ;; it under the terms of the GNU General Public License as published by
  17 ;; the Free Software Foundation; either versions 2, or (at your option)
  18 ;; any later version.
  19
  20 ;; SKK is distributed in the hope that it will be useful
  21 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  22 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  23 ;; GNU General Public License for more details.
  24
  25 ;; You should have received a copy of the GNU General Public License
  26 ;; along with SKK, see the file COPYING.  If not, write to the Free
  27 ;; Software Foundation Inc., 59 Temple Place - Suite 330, Boston,
  28 ;; MA 02111-1307, USA.
  29
  30 ;;; Commentary:
  31
  32 ;;; Code:
  33 (eval-when-compile (require 'skk))
  34 (require 'skk-foreword)
  35 (require 'viper)
  36
  37 ;;(defgroup skk-viper nil "SKK/Viper related customization."
  38 ;;  :prefix "skk-"
  39 ;;  :group 'skk )
  40
  41 ;; internal constant.
  42 ;;;###autoload
  43 (defconst skk-viper-use-vip-prefix
  44   (not (fboundp 'viper-normalize-minor-mode-map-alist)))
  45
  46 ;;;###autoload
  47 (defconst skk-viper-normalize-map-function
  48   (if skk-viper-use-vip-prefix
  49       'vip-normalize-minor-mode-map-alist
  50     'viper-normalize-minor-mode-map-alist )
  51   "Viper \e$B$,\e(B minor-mode-map-alist \e$B$rD4@0$9$k$?$a$N4X?t!#\e(B" )
  52
  53 ;; macros and inline functions.
  54 (defmacro skk-viper-advice-select (viper vip arg body)
  55   (` (if skk-viper-use-vip-prefix
  56          (defadvice (, vip) (, arg) (,@ body))
  57        (defadvice (, viper) (, arg) (,@ body)))))
  58
  59 (setq skk-kana-cleanup-command-list
  60       (cons
  61        (if skk-viper-use-vip-prefix
  62            'vip-del-backward-char-in-insert
  63          'viper-del-backward-char-in-insert )
  64        skk-kana-cleanup-command-list ))
  65
  66 (setq skk-use-viper t)
  67 (save-match-data
  68   (or (string-match sentence-end "\e$B!#!)!*\e(B")
  69       (setq sentence-end (concat "[\e$B!#!)!*\e(B]\\|" sentence-end))))
  70
  71 ;; cursor color support.
  72 (if (and (boundp 'viper-insert-state-cursor-color)
  73          viper-insert-state-cursor-color
  74          (fboundp 'viper-color-defined-p)
  75          (viper-color-defined-p viper-insert-state-cursor-color))
  76     (setq skk-use-color-cursor nil))
  77
  78 ;; advices.
  79 (defadvice skk-cursor-set-properly (before skk-viper-ad activate)
  80   "vi-state \e$B$N$H$-$O!"\e(BSKK \e$B%b!<%I$K$J$C$F$$$F$b%+!<%=%k$r%G%#%U%)%k%H$K$7$F$*$/!#\e(B"
  81   (if (or (and (boundp 'viper-current-state)
  82                (eq viper-current-state 'vi-state))
  83           (and (boundp 'vip-current-state)
  84                (eq vip-current-state 'vi-state)))
  85       (ad-set-arg 0 skk-default-cursor-color)))
  86
  87 (skk-viper-advice-select
  88  viper-forward-word-kernel vip-forward-word-kernel
  89  (around skk-ad activate)
  90  ("SKK \e$B%b!<%I$,%*%s$G!"%]%$%s%H$ND>8e$NJ8;z$,\e(B JISX0208 \e$B$@$C$?$i\e(B forward-word \e$B$9$k!#\e(B"
  91   (if (and skk-mode (skk-jisx0208-p (following-char)))
  92       (forward-word val)
  93     ad-do-it )))
  94
  95 (skk-viper-advice-select
  96  viper-backward-word-kernel vip-backward-word-kernel
  97  (around skk-ad activate)
  98  ("SKK \e$B%b!<%I$,%*%s$G!"%]%$%s%H$ND>A0$NJ8;z$,\e(B JISX0208 \e$B$@$C$?$i\e(B backward-word \e$B$9$k!#\e(B"
  99   (if (and skk-mode (skk-jisx0208-p (preceding-char)))
 100       (backward-word val)
 101     ad-do-it )))
 102
 103 ;; please sync with advice to delete-backward-char
 104 (skk-viper-advice-select
 105  viper-del-backward-char-in-insert vip-del-backward-char-in-insert
 106  (around skk-ad activate)
 107  ("\e$B"'%b!<%I$G\e(B skk-delete-implies-kakutei \e$B$,\e(B non-nil \e$B$@$C$?$iD>A0$NJ8;z$r>C$7$F3NDj$9$k!#\e(B
 108 \e$B"'%b!<%I$G\e(B skk-delete-implies-kakutei \e$B$,\e(B nil \e$B$@$C$?$iA08uJd$rI=<($9$k!#\e(B
 109 \e$B"&%b!<%I$@$C$?$i3NDj$9$k!#\e(B
 110 \e$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!#\e(B"
 111   (let ((count (or (prefix-numeric-value (ad-get-arg 0)) 1)))
 112     (cond (skk-henkan-active
 113            (if (and (not skk-delete-implies-kakutei)
 114                     (= skk-henkan-end-point (point)))
 115                (skk-previous-candidate)
 116              ;;(if skk-use-face (skk-henkan-face-off))
 117              ;; overwrite-mode \e$B$G!"%]%$%s%H$,A43QJ8;z$K0O$^$l$F$$$k$H\e(B
 118              ;; \e$B$-$K\e(B delete-backward-char \e$B$r;H$&$H!"A43QJ8;z$O>C$9$,H>\e(B
 119              ;; \e$B3QJ8;zJ,$7$+\e(B backward \e$BJ}8~$K%]%$%s%H$,La$i$J$$\e(B (Emacs
 120              ;; 19.31 \e$B$K$F3NG'\e(B)\e$B!#JQ49Cf$N8uJd$KBP$7$F$O\e(B
 121              ;; delete-backward-char \e$B$GI,$:A43QJ8;z\e(B 1 \e$BJ8;zJ,\e(B backward
 122              ;; \e$BJ}8~$KLa$C$?J}$,NI$$!#\e(B
 123              (if overwrite-mode
 124                  (progn
 125                    (backward-char count)
 126                    (delete-char count))
 127                ad-do-it )
 128              ;; XXX assume skk-prefix has no multibyte chars.
 129              (if (> (length skk-prefix) count)
 130                  (setq skk-prefix (substring skk-prefix 0 (- (length skk-prefix) count)))
 131                (setq skk-prefix ""))
 132              (if (>= skk-henkan-end-point (point)) (skk-kakutei))))
 133           ((and skk-henkan-on (>= skk-henkan-start-point (point)))
 134            (setq skk-henkan-count 0)
 135            (skk-kakutei))
 136           ;; \e$BF~NOCf$N8+=P$78l$KBP$7$F$O\e(B delete-backward-char \e$B$GI,$:A43QJ8;z\e(B 1
 137           ;; \e$BJ8;zJ,\e(B backward \e$BJ}8~$KLa$C$?J}$,NI$$!#\e(B
 138           ((and skk-henkan-on overwrite-mode)
 139            (backward-char count)
 140            (delete-char count))
 141           (t
 142            (if (string= skk-prefix "")
 143                ad-do-it
 144              (skk-erase-prefix 'clean)))))))
 145
 146 (skk-viper-advice-select
 147  viper-intercept-ESC-key vip-intercept-ESC-key
 148  (before skk-add activate)
 149  ("\e$B"&%b!<%I!""'%b!<%I$@$C$?$i3NDj$9$k!#\e(B"
 150   (and skk-mode skk-henkan-on (skk-kakutei))))
 151
 152 (skk-viper-advice-select
 153  viper-join-lines vip-join-lines
 154  (after skk-ad activate)
 155  ("\e$B%9%Z!<%9$NN>B&$NJ8;z%;%C%H$,\e(B JISX0208 \e$B$@$C$?$i%9%Z!<%9$r<h$j=|$/!#\e(B" ;
 156   (save-match-data
 157     (and (skk-jisx0208-p
 158           (char-after (progn (skip-chars-forward " ") (point))))
 159          (skk-jisx0208-p
 160           (char-before (progn (skip-chars-backward " ") (point))))
 161          (while (looking-at " ")
 162            (delete-char 1))))))
 163
 164 ;;; Functions.
 165 ;;;###autoload
 166 (defun skk-viper-normalize-map ()
 167   (let ((other-buffer
 168          (if (eq skk-emacs-type 'xemacs)
 169              (local-variable-p 'minor-mode-map-alist nil t)
 170            (local-variable-p 'minor-mode-map-alist))))
 171     ;; for current buffer and buffers to be created in the future.
 172     ;; substantially the same job as viper-harness-minor-mode does.
 173     (funcall skk-viper-normalize-map-function)
 174     (setq-default minor-mode-map-alist minor-mode-map-alist)
 175     (if (not other-buffer)
 176         nil
 177       ;; for buffers which are already created and have the minor-mode-map-alist
 178       ;; localized by Viper.
 179       (save-current-buffer
 180         (let ((buf (buffer-list)))
 181           (while buf
 182             (set-buffer (car buf))
 183             (if (null (assq 'skk-j-mode minor-mode-map-alist))
 184                 (progn
 185                   (set-modified-alist
 186                    'minor-mode-map-alist
 187                    (list (cons 'skk-latin-mode skk-latin-mode-map)
 188                          (cons 'skk-abbrev-mode skk-abbrev-mode-map)
 189                          (cons 'skk-j-mode skk-j-mode-map)
 190                          (cons 'skk-jisx0208-latin-mode skk-jisx0208-latin-mode-map)))
 191                   (funcall skk-viper-normalize-map-function)))
 192             (setq buf (cdr buf))))))))
 193
 194 (eval-after-load "viper-cmd"
 195   '(defun viper-toggle-case (arg)
 196      "Toggle character case."
 197      (interactive "P")
 198      (let ((val (viper-p-val arg)) (c))
 199        (viper-set-destructive-command
 200         (list 'viper-toggle-case val nil nil nil nil))
 201        (while (> val 0)
 202          (setq c (following-char))
 203          (delete-char 1 nil)
 204          (cond ((skk-ascii-char-p c)
 205                 (if (eq c (upcase c))
 206                     (insert-char (downcase c) 1)
 207                   (insert-char (upcase c) 1)))
 208                ((and (<= ?\e$B$!\e(B c) (>= ?\e$B$s\e(B c))
 209                 (insert-string
 210                  (skk-hiragana-to-katakana (char-to-string c))))
 211                ((and (<= ?\e$B%!\e(B c) (>= ?\e$B%s\e(B c))
 212                 (insert-string
 213                  (skk-katakana-to-hiragana (char-to-string c))))
 214                (t (insert-char c 1)))
 215          (if (eolp) (backward-char 1))
 216          (setq val (1- val))))))
 217
 218 (skk-viper-normalize-map)
 219
 220 (provide 'skk-viper)
 221 ;;; skk-viper.el ends here