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

   1 ;;; skk-num.el --- \e$B?tCMJQ49$N$?$a$N%W%m%0%i%`\e(B
   2 ;; Copyright (C) 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997,
   3 ;;               1998, 1999, 2000
   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-num.el,v 1.3 2000-11-08 01:51:44 youngs Exp $
   9 ;; Keywords: japanese
  10 ;; Last Modified: $Date: 2000-11-08 01:51:44 $
  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) (require 'cl))
  33 (require 'skk-foreword)
  34
  35 ;;;###autoload
  36 (defgroup skk-num nil "SKK number conversion related customization."
  37   :prefix "skk-num-"
  38   :group 'skk)
  39
  40 ;; user variables.
  41 (defcustom skk-num-type-alist
  42   '((0 . identity)
  43     (1 . skk-num-jisx0208-latin)
  44     (2 . skk-num-type2-kanji)
  45     (3 . skk-num-type3-kanji)
  46     (4 . skk-num-recompute)
  47     (5 . skk-num-type5-kanji)
  48     (9 . skk-num-shogi))
  49   "*\e$B?tCM$NJQ49$N$?$a$N!"%$%s%G%/%9$HJQ49$K;HMQ$9$k4X?t$H$N%(!<%j%9%H!#\e(B
  50 \e$B3FMWAG$O!"\e(B`\(\e$B%$%s%G%/%9\e(B . \e$B4X?tL>\e(B\)' \e$B$H$$$&9=@.$K$J$C$F$$$k!#\e(B
  51 \e$B%$%s%G%/%9$K$O!"Nc$($P8+=P$78l$,\e(B \"\e$BJ?@.\e(B#1\e$BG/\e(B\" \e$B$N$H$-!"\e(B`#' \e$B5-9f$ND>8e$KI=<($5$l$k\e(B
  52 integer `1' \e$B$rBeF~$9$k!#\e(B
  53
  54 \e$B%$%s%G%/%9$H4X?t$N4X78\e(B \(\e$B%G%#%U%)%k%HCM\e(B\) \e$B$O2<5-$NDL$j!#\e(B
  55     0 -> \e$BL5JQ49\e(B
  56     1 -> \e$BA43Q?t;z$XJQ49\e(B
  57     2 -> \e$B4A?t;z$XJQ49\e(B \(\e$B0L<h$j$J$7\e(B\)
  58     3 -> \e$B4A?t;z$XJQ49\e(B \(\e$B0L<h$j$r$9$k\e(B\)
  59     4 -> \e$B$=$N?t;z$=$N$b$N$r%-!<$K$7$F<-=q$r:F8!:w\e(B
  60     5 -> \e$B4A?t;z\e(B (\e$B<j7A$J$I$G;HMQ$9$kJ8;z$r;HMQ\e(B) \e$B$XJQ49\e(B (\e$B0L<h$j$r$9$k\e(B)
  61     9 -> \e$B>-4}$G;HMQ$9$k?t;z\e(B \(\"\e$B#3;M\e(B\" \e$B$J$I\e(B\) \e$B$KJQ49\e(B"
  62   :type '(repeat (cons (choice :tag "Index"
  63                                (integer 0) (integer 1) (integer 2) (integer 3)
  64                                (integer 4) (integer 5) (integer 9))
  65                   (function :tag "Function")))
  66   :group 'skk-num)
  67
  68 (defcustom skk-num-convert-float nil
  69   "*Non-nil \e$B$G$"$l$P!"IbF0>.?tE@?t$r;H$C$?8+=P$78l$KBP1~$7$FJQ49$r9T$J$&!#\e(B
  70 \e$B$3$NCM$r\e(B non-nil \e$B$K$9$k$3$H$G!"\e(B\"#.# /#1\e$B!%\e(B#1/#0\e$B7n\e(B#0\e$BF|\e(B/\" \e$B$J$I$N<-=q8+=P$7$,;HMQ\e(B
  71 \e$B$G$-$J$/$J$k$N$G!"Cm0U!#\e(B"
  72   :type 'boolean
  73   :group 'skk-num)
  74
  75 (defcustom skk-num-uniq (or (assq 4 skk-num-type-alist)
  76                             (and (assq 2 skk-num-type-alist)
  77                                  (assq 3 skk-num-type-alist)))
  78   "*Non-nil \e$B$G$"$l$P!"0[$J$k?tCMI=8=$G$bJQ497k2L$,F1$8?tCM$r=EJ#$7$F=PNO$7$J$$!#\e(B"
  79   :type 'boolean
  80   :group 'skk-num)
  81
  82 (defcustom skk-num-load-hook nil
  83   "*skk-num.el \e$B$r%m!<%I$7$?8e$K%3!<%k$5$l$k%U%C%/!#\e(B"
  84   :type 'hook
  85   :group 'skk-num)
  86
  87 ;; internal constants and variables
  88 (defconst skk-num-alist-type1
  89   '((?0 . "\e$B#0\e(B") (?1 . "\e$B#1\e(B") (?2 . "\e$B#2\e(B") (?3 . "\e$B#3\e(B")
  90     (?4 . "\e$B#4\e(B") (?5 . "\e$B#5\e(B") (?6 . "\e$B#6\e(B") (?7 . "\e$B#7\e(B")
  91     (?8 . "\e$B#8\e(B") (?9 . "\e$B#9\e(B")
  92     (?. . "\e$B!%\e(B")                           ; \e$B>.?tE@!#\e(B(?. . ".") \e$B$NJ}$,NI$$?M$b$$$k$+$b\e(B...\e$B!#\e(B
  93     (?  . ""))
  94   "ascii \e$B?t;z$N\e(B char type \e$B$HA43Q?t;z$N\e(B string type \e$B$NO"A[%j%9%H!#\e(B
  95 \"1995\" -> \"\e$B#1#9#9#5\e(B\" \e$B$N$h$&$JJ8;zNs$NJQ49$r9T$&:]$KMxMQ$9$k!#\e(B")
  96
  97 (defconst skk-num-alist-type2
  98   '((?0 . "\e$B!;\e(B") (?1 . "\e$B0l\e(B") (?2 . "\e$BFs\e(B") (?3 . "\e$B;0\e(B")
  99     (?4 . "\e$B;M\e(B") (?5 . "\e$B8^\e(B") (?6 . "\e$BO;\e(B") (?7 . "\e$B<7\e(B")
 100     (?8 . "\e$BH,\e(B") (?9 . "\e$B6e\e(B") (?  . ""))
 101   "ascii \e$B?t;z$N\e(B char type \e$B$H4A?t;z$N\e(B string type \e$B$NO"A[%j%9%H!#\e(B
 102 \"1995\" -> \"\e$B0l6e6e8^\e(B\" \e$B$N$h$&$JJ8;zNs$NJQ49$r9T$&:]$KMxMQ$9$k!#\e(B")
 103
 104 (defconst skk-num-alist-type5
 105   '((?1 . "\e$B0m\e(B") (?2 . "\e$BFu\e(B") (?3 . "\e$B;2\e(B")
 106     (?4 . "\e$B;M\e(B") (?5 . "\e$B8`\e(B") (?6 . "\e$BO;\e(B") (?7 . "\e$B<7\e(B")
 107     (?8 . "\e$BH,\e(B") (?9 . "\e$B6e\e(B") (?  . ""))
 108   "ascii \e$B?t;z$N\e(B char type \e$B$H4A?t;z$N\e(B string type \e$B$NO"A[%j%9%H!#\e(B
 109 \"1995\" -> \"\e$B0mot6eI46e=&8`\e(B\" \e$B$N$h$&$JJ8;zNs$NJQ49$r9T$&:]$KMxMQ$9$k!#\e(B")
 110
 111 (skk-deflocalvar skk-num-list nil
 112   "skk-henkan-key \e$B$NCf$K4^$^$l$k?t;z$rI=$9J8;zNs$N%j%9%H!#\e(B
 113 \e$BNc$($P!"\e(B\"\e$B"&$X$$$;$$\e(B7\e$B$M$s\e(B10\e$B$,$D\e(B\" \e$B$NJQ49$r9T$&$H$-!"\e(Bskk-henkan-key \e$B$O\e(B
 114 \"\e$B$X$$$;$$\e(B7\e$B$M$s\e(B10\e$B$,$D\e(B\" \e$B$G$"$j!"\e(Bskk-num-list \e$B$O\e(B \(\"7\" \"10\"\) \e$B$H$J$k!#\e(B")
 115
 116 (defvar skk-num-recompute-key nil
 117   "#4 \e$B%?%$%W$N%-!<$K$h$j?tCM$N:F7W;;$r9T$J$C$?$H$-$N8!:w%-!<!#\e(B")
 118
 119 (defun skk-num-compute-henkan-key (key)
 120   ;; KEY \e$B$NCf$NO"B3$9$k?t;z$r8=$o$9J8;zNs$r\e(B "#" \e$B$KCV$-49$($?J8;zNs$rJV$9!#\e(B"12"
 121   ;; \e$B$d\e(B "\e$B#0#9\e(B" \e$B$J$IO"B3$9$k?t;z$r\e(B 1 \e$B$D$N\e(B "#" \e$B$KCV$-49$($k$3$H$KCm0U!#\e(B
 122   ;; \e$BCV$-49$($??t;z$r\e(B skk-num-list \e$B$NCf$K%j%9%H$N7A$GJ]B8$9$k!#\e(B
 123   ;; \e$BNc$($P!"\e(BKEY \e$B$,\e(B "\e$B$X$$$;$$\e(B7\e$BG/\e(B12\e$B$,$D\e(B" \e$B$G$"$l$P!"\e(B"\e$B$X$$$;$$\e(B#\e$B$M$s\e(B#\e$B$,$D\e(B"
 124   ;; \e$B$HJQ49$7!"\e(Bskk-num-list \e$B$K\e(B ("7" "12") \e$B$H$$$&%j%9%H$rBeF~$9$k!#\e(B
 125   ;; \e$B<-=q$N8+=P$78l$N8!:w$K;HMQ$9$k!#\e(B
 126   (let ((numexp (if skk-num-convert-float
 127                     "[.0-9]+" "[0-9]+")))
 128     ;;(setq skk-noconv-henkan-key key)
 129     (save-match-data
 130       ;; \e$B0L<h$j$N\e(B "," \e$B$r=|5n$9$k!#\e(B
 131       (while (string-match "," key)
 132         (setq key (concat (substring key 0 (match-beginning 0))
 133                           (substring key (match-end 0)))))
 134       ;; \e$BA43Q?t;z$r\e(B ascii \e$B?t;z$KJQ49$9$k!#\e(B
 135       (while (string-match "[\e$B#0\e(B-\e$B#9\e(B]" key)
 136         (let ((zen-num (match-string 0 key)))
 137           (setq key (concat (substring key 0 (match-beginning 0))
 138                             (skk-jisx0208-to-ascii zen-num)
 139                             (substring key (match-end 0))))))
 140       ;; ascii \e$B?t;z$r\e(B "#" \e$B$KCV$-49$(!"$=$N?t;z$r\e(B skk-num-list \e$B$NCf$KJ]B8!#\e(B
 141       (while (string-match numexp key)
 142         (setq skk-num-list (nconc skk-num-list (list (match-string 0 key)))
 143               key (concat (substring key 0 (match-beginning 0))
 144                           "#"
 145                           (substring key (match-end 0)))))))
 146   key)
 147
 148 (defun skk-num-convert (key)
 149   ;; skk-henkan-list \e$B$N\e(B skk-henkan-count \e$B$,;X$7$F$$$k?tCMJQ49%-!<$N\e(B
 150   ;; \e$B8uJd$rJQ49$7!"\e(Bskk-henkan-list \e$B$r\e(B
 151   ;;   ("#2" ...) -> (("#2" ."\e$B0l\e(B") ...)
 152   ;; \e$B$N$h$&$KJQ7A$9$k!#\e(B
 153     (if (not key)
 154       nil
 155     (let ((numexp (if skk-num-convert-float
 156                       "#[.0-9]+" "#[0-9]+"))
 157           (n 0)
 158           (workkey key)
 159           num convnum string convlist current)
 160       (save-match-data
 161         (while (and (setq num (nth n skk-num-list))
 162                     (string-match numexp workkey))
 163           (setq convnum (save-match-data
 164                           (skk-num-exp num (string-to-number
 165                                             (substring workkey
 166                                                        (1+ (match-beginning 0))
 167                                                        (match-end 0)))))
 168                 string (substring workkey 0 (match-beginning 0))
 169                 workkey (substring workkey (match-end 0))
 170                 n (1+ n))
 171           (if (not (and (stringp convnum) (string= convnum "")
 172                         (string= string "")))
 173               (setq convlist (nconc convlist (list string convnum)))))
 174         (setq convlist (nconc convlist (list workkey)))
 175         (cond ((null convlist) nil)
 176               ((and (null (cdr convlist)) (stringp (car convlist)))
 177                (setq current (car convlist)))
 178               ;; CONV-LIST \e$B$NA4MWAG$,J8;zNs!#\e(B
 179               ((null (memq t (mapcar 'listp convlist)))
 180                (setq current (mapconcat 'identity convlist ""))
 181                (if (and (> skk-henkan-count -1)
 182                         (nth skk-henkan-count skk-henkan-list))
 183                    ;; ("A" "#2" "C") -> ("A" ("#2" ."\e$B0l\e(B") "C")
 184                    (setf (nth skk-henkan-count skk-henkan-list)
 185                          (cons key current))
 186                  (setq skk-henkan-list
 187                        (nconc skk-henkan-list (list (cons key current))))))
 188               ;; #4
 189               (t (let ((l (mapcar (function (lambda (e) (cons key e)))
 190                                   (skk-num-flatten-list (delete "" convlist)))))
 191                    (setq current (cdr (car l)))
 192                    (if (and (> skk-henkan-count -1)
 193                             (nth skk-henkan-count skk-henkan-list))
 194                        (progn
 195                          (setf (nth skk-henkan-count skk-henkan-list) (car l))
 196                          (setq skk-henkan-list (skk-splice-in
 197                                                 skk-henkan-list
 198                                                 (1+ skk-henkan-count)
 199                                                 (cdr l))))
 200                      (setq skk-henkan-list (nconc skk-henkan-list l))))))
 201         current))))
 202
 203 (defun skk-num-convert*7 ()
 204   (let ((skk-henkan-count skk-henkan-count)
 205         (n 7))
 206     (while (and (> n 0) (nth skk-henkan-count skk-henkan-list))
 207       (skk-num-convert (skk-get-current-candidate))
 208       (setq skk-henkan-count (1+ skk-henkan-count)
 209             n (1- n)))
 210     (and skk-num-recompute-key (skk-num-uniq))))
 211
 212 (defun skk-num-rawnum-exp (string)
 213   (setq string (skk-num-rawnum-exp-1
 214                 string "[\e$B#0\e(B-\e$B#9\e(B][\e$B!;0l6e8^;0;M<7FsH,O;\e(B]" "#9" 0))
 215   (setq string (skk-num-rawnum-exp-1
 216                 string "\\(^\\|[^#0-9]\\)\\([0-9]+\\)" "#0" 2))
 217   (setq string (skk-num-rawnum-exp-1
 218                 string "[\e$B#0\e(B-\e$B#9\e(B]+" "#1" 0))
 219   (setq string (skk-num-rawnum-exp-1
 220                 string "\\([\e$B!;0l6e8^;0;M<7FsH,O;==\e(B][\e$B==I4@iK|2/C{5~\e(B]\\)+" "#3" 0))
 221   ;; (mapcar 'char-to-string
 222   ;;         (sort
 223   ;;          '(?\e$B0l\e(B ?\e$BFs\e(B ?\e$B;0\e(B ?\e$B;M\e(B ?\e$B8^\e(B ?\e$BO;\e(B ?\e$B<7\e(B ?\e$BH,\e(B ?\e$B6e\e(B ?\e$B!;\e(B) '<))
 224   ;;   --> ("\e$B!;\e(B" "\e$B0l\e(B" "\e$B6e\e(B" "\e$B8^\e(B" "\e$B;0\e(B" "\e$B;M\e(B" "\e$B<7\e(B" "\e$BFs\e(B" "\e$BH,\e(B" "\e$BO;\e(B")
 225   ;;
 226   ;; [\e$B!;\e(B-\e$B6e\e(B] \e$B$H$$$&@55,I=8=$,;H$($J$$$N$G!"@8$N$^$^$D$C$3$s$G$*$/!#\e(B
 227   (skk-num-rawnum-exp-1 string "[\e$B!;0l6e8^;0;M<7FsH,O;\e(B]+" "#2" 0))
 228
 229 (defun skk-num-rawnum-exp-1 (string key type place)
 230   (save-match-data
 231     (while (string-match key string)
 232       (setq string (concat (substring string 0 (match-beginning place))
 233                            type
 234                            (substring string (match-end place)))))
 235     string))
 236
 237 (defun skk-num-flatten-list (list)
 238   ;; \e$BM?$($i$l$?%j%9%H$N3FMWAG$+$iAH$_9g$;2DG=$JJ8;zNs$NO"@\$r:n$j!"%j%9%H$GJV\e(B
 239   ;; \e$B$9!#\e(B
 240   ;; (("A" "B") "1" ("X" "Y")) -> ("A1X" "A1Y" "B1X" "B1Y")
 241   (let ((dst (car list))
 242         (src (cdr list))
 243         elt)
 244     (while src
 245       (setq elt (car src))
 246       (if (consp elt)
 247           (setq dst (apply (function nconc)
 248                            (mapcar
 249                             (lambda (str0)
 250                               (mapcar
 251                                (lambda (str1)
 252                                  (concat str0 str1))
 253                                elt))
 254                             dst)))
 255         (setq dst (mapcar
 256                    (lambda (str0)
 257                      (concat str0 elt))
 258                    dst)))
 259       (setq src (cdr src)))
 260     dst))
 261
 262 (defun skk-num-exp (num type)
 263   ;; ascii \e$B?t;z$N\e(B NUM \e$B$r\e(B TYPE \e$B$K=>$$JQ49$7!"JQ498e$NJ8;zNs$rJV$9!#\e(B
 264   ;; TYPE \e$B$O2<5-$NDL$j!#\e(B
 265   ;; 0 -> \e$BL5JQ49\e(B
 266   ;; 1 -> \e$BA43Q?t;z$XJQ49\e(B
 267   ;; 2 -> \e$B4A?t;z$XJQ49\e(B (\e$B0L<h$j$J$7\e(B)
 268   ;; 3 -> \e$B4A?t;z$XJQ49\e(B (\e$B0L<h$j$r$9$k\e(B)
 269   ;; 4 -> \e$B$=$N?t;z$=$N$b$N$r%-!<$K$7$F<-=q$r:F8!:w\e(B
 270   ;; 5 -> \e$B4A?t;z\e(B (\e$B<j7A$J$I$G;HMQ$9$kJ8;z$r;HMQ\e(B) \e$B$XJQ49\e(B (\e$B0L<h$j$r$9$k\e(B)
 271   ;; 9 -> \e$B>-4}$G;HMQ$9$k?t;z\e(B ("\e$B#3;M\e(B" \e$B$J$I\e(B) \e$B$KJQ49\e(B
 272   (let ((fun (cdr (assq type skk-num-type-alist))))
 273     (if fun (funcall fun num))))
 274
 275 (defun skk-num-jisx0208-latin (num)
 276   ;; ascii \e$B?t;z$N\e(B NUM \e$B$rA43Q?t;z$NJ8;zNs$KJQ49$7!"JQ498e$NJ8;zNs$rJV$9!#\e(B
 277   ;; \e$BNc$($P\e(B "45" \e$B$r\e(B "\e$B#4#5\e(B" \e$B$KJQ49$9$k!#\e(B
 278   (let ((candidate
 279          (mapconcat (function (lambda (c) (cdr (assq c skk-num-alist-type1))))
 280                     num "")))
 281     (if (not (string= candidate ""))
 282         candidate)))
 283
 284 (defun skk-num-type2-kanji (num)
 285   ;; ascii \e$B?t;z\e(B NUM \e$B$r4A?t;z$NJ8;zNs$KJQ49$7!"JQ498e$NJ8;zNs$rJV$9!#\e(B
 286   ;; \e$BNc$($P!"\e(B"45" \e$B$r\e(B "\e$B;M8^\e(B" \e$B$KJQ49$9$k!#\e(B
 287   (save-match-data
 288     (if (not (string-match "\\.[0-9]" num))
 289         (let ((candidate
 290                (mapconcat (function (lambda (c)
 291                                       (cdr (assq c skk-num-alist-type2))))
 292                           num "")))
 293           (if (not (string= candidate ""))
 294               candidate)))))
 295
 296 (defun skk-num-type3-kanji (num)
 297   ;; ascii \e$B?t;z\e(B NUM \e$B$r4A?t;z$NJ8;zNs$KJQ49$7\e(B (\e$B0L<h$j$r$9$k\e(B)\e$B!"JQ498e$NJ8;zNs$r\e(B
 298   ;; \e$BJV$9!#Nc$($P\e(B "1021" \e$B$r\e(B "\e$B@iFs==0l\e(B" \e$B$KJQ49$9$k!#\e(B
 299   (save-match-data
 300     (if (not (string-match "\\.[0-9]" num))
 301         ;; \e$B>.?tE@$r4^$^$J$$?t\e(B
 302         (let ((str (skk-num-type3-kanji-1 num)))
 303           (if (string= "" str) "\e$B!;\e(B" str)))))
 304
 305 (defun skk-num-type3-kanji-1 (num)
 306   ;; skk-num-type3-kanji \e$B$N%5%V%k!<%A%s!#\e(B
 307   (let ((len (length num))
 308         (i 0)
 309         char v num1 v1)
 310     ;; \e$B!V@i5~!W$^$G$O=PNO$9$k!#\e(B
 311     (when (> len 20) (skk-error "\e$B0L$,Bg$-$9$.$^$9!*\e(B" "Too big number!"))
 312     (setq num (append num nil))
 313     (cond
 314      ((<= len 4)
 315       (while (setq char (car num))
 316         ;; \e$B0L\e(B:   \e$B0l\e(B  \e$B==\e(B  \e$BI4\e(B  \e$B@i\e(B
 317         ;; len:   1   2   3   4
 318         (if (= len 1)
 319             ;; \e$B0L$rI=$o$94A?t;z0J30$N4A?t;z!#\e(B
 320             (unless (eq char ?0)
 321             ;; \e$B0l$N0L$G\e(B 0 \e$B$G$J$$?t!#\e(B
 322               (setq v (concat v (cdr (assq char skk-num-alist-type2)))))
 323           ;; \e$B0L$rI=$o$94A?t;z0J30$N4A?t;z!#\e(B
 324           (unless (memq char '(?0 ?1))
 325             ;; \e$B==$N0L0J>e$G!"$+$D\e(B 0, 1 \e$B0J30$N?t;z!#\e(B
 326             (setq v (concat v (cdr (assq char skk-num-alist-type2)))))
 327           ;; \e$B0L$rI=$o$94A?t;z!#\e(B
 328           (when (and (not (eq char ?0)) (memq len '(2 3 4)))
 329             (setq v
 330                   (concat
 331                    v
 332                    (cdr (assq len '((2 . "\e$B==\e(B") (3 . "\e$BI4\e(B") (4 . "\e$B@i\e(B"))))))))
 333         (setq len (1- len) num (cdr num))))
 334      (t
 335       (setq num (nreverse num))
 336       (while num
 337         (setq num1 nil)
 338         (while (and (< (length num1) 4) num)
 339           (setq num1 (cons (car num) num1)
 340                 num (cdr num)))
 341         (when num1
 342           (setq v1 (skk-num-type3-kanji-1 num1))
 343           (when (and (eq i 1) (equal v1 "\e$B@i\e(B"))
 344             ;; \e$BF|K\8l$G$O!V@i2/!W$H$$$&I=8=$O$H$-$K;H$o$l$k$,!"!V@iK|!W$H$$$&I=\e(B
 345             ;; \e$B8=$O$^$:;H$o$l$J$$$N$G!"!V0l@iK|!W$KD>$9!#\e(B
 346             (setq v1 (concat "\e$B0l\e(B" v1)))
 347           (setq
 348            v
 349            (concat
 350             v1
 351             (when v1
 352               (cdr
 353                (assq
 354                 i '((0 . "") (1 . "\e$BK|\e(B") (2 . "\e$B2/\e(B") (3 . "\e$BC{\e(B") (4 . "\e$B5~\e(B")))))
 355             v)))
 356         (setq i (1+ i)))))
 357     v))
 358
 359 (defun skk-num-type5-kanji (num)
 360   ;; ascii \e$B?t;z\e(B NUM \e$B$r4A?t;z$NJ8;zNs$KJQ49$7\e(B (\e$B0L<h$j$r$9$k\e(B)\e$B!"JQ498e$NJ8;zNs$r\e(B
 361   ;; \e$BJV$9!#Nc$($P\e(B "1021" \e$B$r\e(B "\e$B0motFu=&0m\e(B" \e$B$KJQ49$9$k!#\e(B
 362   (save-match-data
 363     (if (not (string-match "\\.[0-9]" num))
 364         ;; \e$B>.?tE@$r4^$^$J$$?t\e(B
 365         (let ((str (skk-num-type5-kanji-1 num)))
 366           (if (string= "" str) "\e$BNm\e(B" str)))))
 367
 368 (defun skk-num-type5-kanji-1 (num)
 369   ;; skk-num-type5-kanji \e$B$N%5%V%k!<%A%s!#\e(B
 370   (let ((len (length num))
 371         (i 0)
 372          char v num1 v1)
 373     ;; \e$B!V@i5~!W$^$G$O=PNO$9$k!#\e(B
 374     (when (> len 20) (skk-error "\e$B0L$,Bg$-$9$.$^$9!*\e(B" "Too big number!"))
 375     (setq num (append num nil))
 376     (cond
 377      ((<= len 4)
 378       (while (setq char (car num))
 379         (if (= len 1)
 380             (unless (eq char ?0)
 381               (setq v (concat v (cdr (assq char skk-num-alist-type5)))))
 382           ;; \e$B0L$rI=$o$94A?t;z0J30$N4A?t;z!#\e(B
 383           (setq v (concat v (cdr (assq char skk-num-alist-type5))))
 384           ;; \e$B0L$rI=$o$94A?t;z!#\e(B
 385           (when (and (not (eq char ?0)) (memq len '(2 3 4)))
 386             (setq v
 387                   (concat
 388                    v
 389                    (cdr (assq len '((2 . "\e$B=&\e(B") (3 . "\e$BI4\e(B") (4 . "\e$Bot\e(B"))))))))
 390         (setq len (1- len) num (cdr num))))
 391      (t
 392       (setq num (nreverse num))
 393       (while num
 394         (setq num1 nil)
 395         (while (and (< (length num1) 4) num)
 396           (setq num1 (cons (car num) num1)
 397                 num (cdr num)))
 398         (when num1
 399           (setq v1 (skk-num-type5-kanji-1 num1))
 400           (setq
 401            v
 402            (concat
 403             v1
 404             (when v1
 405               (cdr
 406                (assq
 407                 i '((0 . "") (1 . "\e$Bh_\e(B") (2 . "\e$B2/\e(B") (3 . "\e$BC{\e(B") (4 . "\e$B5~\e(B")))))
 408             v)))
 409         (setq i (1+ i)))))
 410     v))
 411
 412 (defun skk-num-shogi (num)
 413   ;; ascii \e$B?t;z$N\e(B NUM \e$B$r>-4}$G;HMQ$5$l$k?t;zI=5-$KJQ49$9$k!#\e(B
 414   ;; \e$BNc$($P\e(B "34" \e$B$r\e(B "\e$B#3;M\e(B" \e$B$KJQ49$9$k!#\e(B
 415   (save-match-data
 416     (if (and (= (length num) 2)
 417              (not (string-match "\\.[0-9]" num)))
 418         (let ((candidate
 419                (concat (cdr (assq (aref num 0) skk-num-alist-type1))
 420                        (cdr (assq (aref num 1) skk-num-alist-type2)))))
 421           (if (not (string= candidate ""))
 422               candidate)))))
 423
 424 (defun skk-num-recompute (num)
 425   ;; #4 \e$B$N8+=P$7$KBP$7!"\e(Bskk-henkan-key \e$B$KBeF~$5$l$??t;z$=$N$b$N$r:FEY8!:w$9$k!#\e(B
 426   (let (result)
 427     (setq skk-num-recompute-key num)
 428     (with-temp-buffer
 429       ;; \e$B%+%l%s%H%P%C%U%!$N%P%C%U%!%m!<%+%kJQ?t$K1F6A$r5Z$\$5$J$$$h$&!"%o!<%-\e(B
 430       ;; \e$B%s%0%P%C%U%!$X0lC6F($2$k\e(B
 431       (let ((skk-current-search-prog-list skk-search-prog-list)
 432             (skk-henkan-key num)
 433             ;; \e$B%+%l%s%H$NJQ49$OAw$j$J$7\e(B (skk-henkan-okurigana \e$B$H\e(B skk-okuri-char \e$B$O\e(B
 434             ;; \e$B$$$:$l$b\e(B nil) \e$B$@$,!"JL%P%C%U%!\e(B (work \e$B%P%C%U%!\e(B) \e$B$KF~$C$F$$$k$N$G!"G0\e(B
 435             ;; \e$B$N$?$a!"\e(Bnil \e$B$rF~$l$F$*$/!#\e(B
 436             skk-henkan-okurigana skk-okuri-char skk-use-numeric-conversion)
 437         (while skk-current-search-prog-list
 438           (setq result (skk-nunion result (skk-search))))))
 439     ;; \e$B$3$3$G\e(B temp-buffer \e$B$r=P$FJQ49$r9T$J$C$F$$$k%+%l%s%H%P%C%U%!$KLa$k\e(B
 440     ;; (\e$B%P%C%U%!%m!<%+%kCM$G$"$k\e(B skk-henkan-list \e$B$rA`:n$7$?$$$?$a\e(B)\e$B!#\e(B
 441     (if result
 442         (if (null (cdr result));;(= (length result) 1)
 443             (car result)
 444           result)
 445       ;; \e$BJQ49$G$-$J$+$C$?$i85$N?t;z$r$=$N$^$^JV$7$F$*$/!#\e(B
 446       num)))
 447
 448 ;;;###autoload
 449 (defun skk-num-uniq ()
 450   (if (or (not skk-num-uniq) (null skk-henkan-list))
 451       nil
 452     (save-match-data
 453       (let ((n1 -1) n2 e1 e2 e3
 454             ;; 1 \e$B$D$G$b\e(B 2 \e$B7e0J>e$N?t;z$,$"$l$P!"\e(B#2 \e$B$H\e(B #3 \e$B$G$O\e(B uniq \e$B$7$J$$!#\e(B
 455             (type2and3 (> 2 (apply 'max (mapcar 'length skk-num-list))))
 456             type2 type3 index2 index3 head2 head3 tail2 tail3
 457             case-fold-search)
 458         (while (setq n1 (1+ n1) e1 (nth n1 skk-henkan-list))
 459           ;; cons cell \e$B$G$J$1$l$P\e(B skk-nunion \e$B$G=hM}:Q$_$J$N$G!"=EJ#$O$J$$!#\e(B
 460           (if (consp e1)
 461               ;; (car e1) \e$B$H\e(B equal \e$B$N$b$N$,>C$($k$N$@$+$i\e(B e1 \e$B<+?H$,>C$($k$3\e(B
 462               ;; \e$B$H$O$J$$!#\e(B
 463               (setq skk-henkan-list (delete (car e1) skk-henkan-list)
 464                     skk-henkan-list (delete (cdr e1) skk-henkan-list)))
 465           (if (not (and skk-num-recompute-key (consp e1)))
 466               nil
 467             ;; ("#4" . "xxx") \e$B$r4^$`8uJd$,\e(B skk-henkan-list \e$B$NCf$K$"$k!#\e(B
 468             (setq n2 -1)
 469             (while (setq n2 (1+ n2) e2 (nth n2 skk-henkan-list))
 470               (if (and (not (= n1 n2)) (consp e2)
 471                        ;; \e$BNc$($P\e(B ("#4" . "\e$B0l\e(B") \e$B$H\e(B ("#2" . "\e$B0l\e(B") \e$B$,JBB8$7$F$$\e(B
 472                        ;; \e$B$k>l9g!#\e(B
 473                        (string= (cdr e1) (cdr e2)))
 474                   (setq skk-henkan-list (delq e2 skk-henkan-list)))))
 475           (if (not type2and3)
 476               nil
 477             ;; 1 \e$B7e$N?t;z$rJQ49$9$k:]$K!"\e(Bskk-henkan-list \e$B$K\e(B #2 \e$B%(%s%H%j$H\e(B #3
 478             ;; \e$B%(%s%H%j$,$"$l$P!"\e(B#2 \e$B$b$7$/$O\e(B #3 \e$B%(%s%H%j$N$&$A!"$h$j8eJ}$K$"$k\e(B
 479             ;; \e$B$b$N$r>C$9!#\e(B
 480             (setq e3 (if (consp e1) (car e1) e1))
 481             ;; e3 \e$B$O\e(B "#2" \e$B$N$h$&$K?tCMJQ49$r<($9J8;zNs$N$_$H$O8B$i$J$$$N$G!"\e(B
 482             ;; member \e$B$O;H$($J$$!#\e(B
 483             (cond ((string-match "#2" e3)
 484                    (setq type2 e1
 485                          index2 n1
 486                          head2 (substring e3 0 (match-beginning 0))
 487                          tail2 (substring e3 (match-end 0))))
 488                   ((string-match "#3" e3)
 489                    (setq type3 e1
 490                          index3 n1
 491                          head3 (substring e3 0 (match-beginning 0))
 492                          tail3 (substring e3 (match-end 0)))))))
 493         (if (and type2and3 type2 type3
 494                  ;; \e$B?tCMJQ49$r<($9J8;zNs\e(B "#[23]" \e$B$NA08e$NJ8;zNs$bF10l$N$H\e(B
 495                  ;; \e$B$-$N$_\e(B uniq \e$B$r9T$J$&!#\e(B
 496                  (string= head2 head3) (string= tail2 tail3))
 497             (if (> index2 index3)
 498                 ;; "#3" \e$B$NJ}$,A0$K$"$k!#\e(B
 499                 (setq skk-henkan-list (delq type2 skk-henkan-list))
 500               ;; \e$BJQ?t\e(B type[23] \e$B$NCM$O!"\e(Bskk-henkan-list \e$B$+$iD>@\Cj=P$7$?$b\e(B
 501               ;; \e$B$N$@$+$i\e(B delete \e$B$G$J$/!"\e(Bdelq \e$B$G==J,!#\e(B
 502               (setq skk-henkan-list (delq type3 skk-henkan-list))))))))
 503
 504 ;;;###autoload
 505 (defun skk-num-process-user-minibuf-input (key)
 506   (save-match-data
 507     (let (numexp orglen val)
 508       (if (or (and (string-match "#[012349]" key)
 509                    (setq numexp key))
 510               (and (setq numexp (skk-num-rawnum-exp key))
 511                    (not (string= key numexp))))
 512           (progn
 513             (setq orglen (length skk-henkan-list)
 514                   ;; skk-henkan-list \e$B$ND4@0$O!"\e(Bskk-num-convert \e$B$NCf$G9T$J$C\e(B
 515                   ;; \e$B$F$/$l$k!#\e(B
 516                   val (skk-num-convert numexp))
 517             (if (= (length skk-henkan-list) (1+ orglen))
 518                 ;; #4 \e$B$GJ#?t$N8uJd$KJQ49$G$-$?>l9g$O3NDj$7$J$$!#\e(B
 519                 (setq skk-kakutei-flag t)))
 520         (setq skk-henkan-list (nconc skk-henkan-list (list key))
 521               skk-kakutei-flag t
 522               val key))
 523       val)))
 524
 525 ;;;###autoload
 526 (defun skk-num-initialize ()
 527   ;; skk-use-numeric-convert \e$B4XO"$NJQ?t$r=i4|2=$9$k!#\e(B
 528   (setq skk-last-henkan-data
 529         (put-alist 'num-list skk-num-list skk-last-henkan-data)
 530         skk-num-list nil
 531         skk-num-recompute-key nil))
 532
 533 ;;;###autoload
 534 (defun skk-num-henkan-key ()
 535   ;; type4 \e$B$N?tCM:FJQ49$,9T$J$o$l$?$H$-$O!"?tCM<+?H$rJV$7!"$=$l0J30$N?tCMJQ49\e(B
 536   ;; \e$B$G$O!"\e(Bskk-henkan-key \e$B$rJV$9!#\e(B
 537   (or skk-num-recompute-key skk-henkan-key))
 538
 539 ;;;###autoload
 540 (defun skk-num-update-jisyo (noconvword word &optional purge)
 541   ;; \e$B?t;z<+?H$r8+=P$78l$H$7$F<-=q$N%"%C%W%G!<%H$r9T$J$&!#\e(B
 542   (if (and skk-num-recompute-key
 543            (save-match-data (string-match "#4" noconvword)))
 544       (with-current-buffer (skk-get-jisyo-buffer skk-jisyo 'nomsg)
 545         (let ((skk-henkan-key skk-num-recompute-key)
 546               skk-use-numeric-conversion)
 547           (skk-update-jisyo word purge)))))
 548
 549 ;;;###autoload
 550 (defun skk-num (str)
 551   ;; \e$B?t;z$r\e(B skk-number-style \e$B$NCM$K=>$$JQ49$9$k!#\e(B
 552   ;; skk-current-date \e$B$N%5%V%k!<%A%s!#\e(B
 553   (mapconcat (function
 554               (lambda (c)
 555                 (cond ((or (not skk-number-style)
 556                            (and (numberp skk-number-style)
 557                                 (= skk-number-style 0)))
 558                        (char-to-string c))
 559                       ((or (eq skk-number-style t)
 560                            (and (numberp skk-number-style)
 561                                 (= skk-number-style 1)))
 562                        (cdr (assq c skk-num-alist-type1)))
 563                       (t (cdr (assq c skk-num-alist-type2))))))
 564              str ""))
 565
 566 (run-hooks 'skk-num-load-hook)
 567
 568 (provide 'skk-num)
 569 ;;; Local Variables:
 570 ;;; End:
 571 ;;; skk-num.el ends here