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

   1 ;;; skk-auto.el --- \e$BAw$j2>L>$N<+F0=hM}$N$?$a$N%W%m%0%i%`\e(B
   2 ;; Copyright (C) 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998,
   3 ;;               1999
   4 ;; Masahiko Sato <masahiko@kuis.kyoto-u.ac.jp>
   5
   6 ;; Author: Masahiko Sato <masahiko@kuis.kyoto-u.ac.jp>
   7 ;; Maintainer: Mikio Nakajima <minakaji@osaka.email.ne.jp>
   8 ;; Version: $Id: skk-auto.el,v 1.2 2000-07-10 04:33:59 yoshiki Exp $
   9 ;; Keywords: japanese
  10 ;; Last Modified: $Date: 2000-07-10 04:33:59 $
  11
  12 ;; This file is part of SKK.
  13
  14 ;; SKK is free software; you can redistribute it and/or modify
  15 ;; it under the terms of the GNU General Public License as published by
  16 ;; the Free Software Foundation; either versions 2, or (at your option)
  17 ;; any later version.
  18
  19 ;; SKK is distributed in the hope that it will be useful
  20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  22 ;; GNU General Public License for more details.
  23
  24 ;; You should have received a copy of the GNU General Public License
  25 ;; along with SKK, see the file COPYING.  If not, write to the Free
  26 ;; Software Foundation Inc., 59 Temple Place - Suite 330, Boston,
  27 ;; MA 02111-1307, USA.
  28
  29 ;;; Commentary:
  30
  31 ;;; Code:
  32 (eval-when-compile (require 'skk))
  33 (require 'skk-foreword)
  34
  35 ;;;###autoload
  36 (defgroup skk-auto nil "SKK auto okuri process related customization."
  37   :prefix "skk-"
  38   :group 'skk )
  39
  40 ;;; user variables
  41 (defcustom skk-okuri-search-function 'skk-okuri-search-subr-original
  42   "*skk-okuri-search \e$B$G;HMQ$9$k4X?t!#\e(B"
  43   :type 'function
  44   :group 'skk-auto )
  45
  46 (defcustom skk-auto-load-hook nil
  47   "*skk-auto.el \e$B$r%m!<%I$7$?8e$K%3!<%k$5$l$k%U%C%/!#\e(B"
  48   :type 'hook
  49   :group 'skk-auto )
  50
  51 ;;;###autoload
  52 (defun skk-okuri-search ()
  53   ;; skk-auto-okuri-process \e$B$,\e(B non-nil \e$B$J$i$P\e(B "Uresii" \e$B$N$h$&$KAw$j2>L>$b4^$a\e(B
  54   ;; \e$B$F%?%$%W$7$F$bAw$j$"$j$N\e(B "\e$B4r$7$$\e(B" \e$B$rC5$7=P$9!#\e(B
  55   (if (and skk-auto-okuri-process
  56            (not (or skk-abbrev-mode skk-process-okuri-early
  57                     skk-henkan-okurigana ))
  58            ;; we don't do auto-okuri-process if henkan key contains numerals.
  59            (not (skk-numeric-p))
  60            (> (length skk-henkan-key) skk-kanji-len) )
  61       (let (l)
  62         (setq skk-okuri-index-min (length skk-henkan-list)
  63               l (funcall skk-okuri-search-function)
  64               skk-okuri-index-max (+ skk-okuri-index-min (length l)) )
  65         l )))
  66
  67 (defun skk-okuri-search-subr-original ()
  68   ;; skk-okuri-search \e$B$N%5%V%k!<%A%s!#8+$D$1$?%(%s%H%j$N%j%9%H$rJV$9!#\e(B
  69   (let* ((henkan-key skk-henkan-key)
  70          (key (substring henkan-key 0 skk-kanji-len))
  71          (len (length henkan-key))
  72          (key1 (concat "\n" key))
  73          key2 len2 key3 len3 okuri3
  74          ;; case-fold-search \e$B$O!"<-=q%P%C%U%!$G$O>o$K\e(B nil\e$B!#\e(B
  75          ;;case-fold-search
  76          (inhibit-quit t)
  77          key-cand-alist p q r )
  78     (save-match-data
  79       (with-current-buffer (skk-get-jisyo-buffer skk-jisyo)
  80         (goto-char skk-okuri-ari-min)
  81         (while (search-forward key1 skk-okuri-ari-max t)
  82           (setq p (point)
  83                 key2 (concat key (buffer-substring-no-properties
  84                                   p (- (search-forward " ") 2) ))
  85                 len2 (length key2) )
  86           (if (not (and (<= len2 len)
  87                         (string= key2 (substring henkan-key 0 len2)) ))
  88               nil
  89             (let ((cont t))
  90               (skk-save-point
  91                (end-of-line)
  92                (setq q (point)) )
  93               (while (and cont (search-forward "/[" q t))
  94                 (setq r (point))
  95                 (setq okuri3 (buffer-substring-no-properties
  96                               r
  97                               (1- (search-forward "/")) )
  98                       key3 (concat key2 okuri3)
  99                       len3 (length key3) )
 100                 (if (not (and (<= len3 len)
 101                               (string= key3 (substring henkan-key 0 len3)) ))
 102                     nil
 103                   ;; finally found a candidate!
 104                   (let ((okuri
 105                          (concat okuri3 (substring henkan-key len3 len)) )
 106                         cand )
 107                     (while (not (eq (following-char) ?\]))
 108                       (setq cand
 109                             (concat
 110                              (buffer-substring-no-properties
 111                               (point)
 112                               (1- (search-forward "/" skk-okuri-ari-max t)) )
 113                              okuri ))
 114                       ;; \e$B8+=P$78l$,0c$C$F$b8uJd$,F1$8$3$H$,$"$jF@$k!#\e(B
 115                       ;;   \e$B$+$s\e(Bz /\e$B46\e(B/[\e$B$8\e(B/\e$B46\e(B/]/
 116                       ;;   \e$B$+$s\e(Bj /\e$B46\e(B/[\e$B$8\e(B/\e$B46\e(B/]/
 117                       ;; \e$B$J$I!#\e(B
 118                       (if (null (rassoc cand key-cand-alist))
 119                           (setq key-cand-alist (cons (cons key3 cand)
 120                                                      key-cand-alist ))))
 121                     ;; it is not necessary to seach for "\[" on this line
 122                     ;; any more
 123                     (setq cont nil) ))))))
 124         ;; key3 \e$B$ND9$$$b$N=g$K%=!<%H$7$FJV$9!#\e(B
 125         (mapcar (function
 126                  (lambda (x) (cdr x)) )
 127                 (sort (nreverse key-cand-alist)
 128                       (function (lambda (x y)
 129                                   (string< (car y) (car x)) ))))))))
 130
 131 ;;;###autoload
 132 (defun skk-adjust-search-prog-list-for-auto-okuri ()
 133   ;; skk-auto-okuri-process \e$B$,\e(B nil \e$B$G$"$l$P!"\e(Bskk-search-prog-list \e$B$+$i\e(B
 134   ;; '(skk-okuri-search) \e$B$r>C$7!"\e(Bnon-nil \e$B$G$"$l$P2C$($k!#\e(B
 135   ;;
 136   ;; '(skk-okuri-search) \e$B$r2C$($k0LCV$K$D$$$F$O!"\e(Bskk-jisyo \e$B$N8e$,:GNI$+$I$&$+\e(B
 137   ;; \e$B$OJ,$i$J$$$N$G!"%*%W%7%g%s$GJQ99$G$-$k$h$&$K$9$Y$-$@$,\e(B...\e$B!#\e(B
 138   (if (not skk-auto-okuri-process)
 139       (setq skk-search-prog-list
 140             (delete '(skk-okuri-search) skk-search-prog-list) )
 141     (if (null (member '(skk-okuri-search) skk-search-prog-list))
 142         (let ((pl skk-search-prog-list)
 143               (n 0) dic mark )
 144           (while pl
 145             (setq dic (car pl))
 146             (if (memq (nth 1 dic) '(skk-jisyo skk-rdbms-private-jisyo-table))
 147                 (setq mark n
 148                       pl nil)
 149               (setq pl (cdr pl)
 150                     n (1+ n) )))
 151           (skk-splice-in skk-search-prog-list (1+ mark)
 152                          '((skk-okuri-search)) )))))
 153
 154 ;;(add-hook 'skk-mode-hook 'skk-adjust-search-prog-list-for-auto-okuri)
 155
 156 (run-hooks 'skk-auto-load-hook)
 157 (provide 'skk-auto)
 158 ;;; skk-auto.el ends here