Mercurial > hg > xemacs-beta
comparison lisp/skk/skk-num.el @ 219:262b8bb4a523 r20-4b8
Import from CVS: tag r20-4b8
| author | cvs |
|---|---|
| date | Mon, 13 Aug 2007 10:09:35 +0200 |
| parents | |
| children |
comparison
equal
deleted
inserted
replaced
| 218:c9f226976f56 | 219:262b8bb4a523 |
|---|---|
| 1 ;;; skk-num.el --- $B?tCMJQ49$N$?$a$N%W%m%0%i%`(B | |
| 2 ;; Copyright (C) 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997 | |
| 3 ;; Masahiko Sato <masahiko@kuis.kyoto-u.ac.jp> | |
| 4 | |
| 5 ;; Author: Masahiko Sato <masahiko@kuis.kyoto-u.ac.jp> | |
| 6 ;; Maintainer: Mikio Nakajima <minakaji@osaka.email.ne.jp> | |
| 7 ;; Version: $Id: skk-num.el,v 1.1 1997/12/02 08:48:38 steve Exp $ | |
| 8 ;; Keywords: japanese | |
| 9 ;; Last Modified: $Date: 1997/12/02 08:48:38 $ | |
| 10 | |
| 11 ;; This program is free software; you can redistribute it and/or modify | |
| 12 ;; it under the terms of the GNU General Public License as published by | |
| 13 ;; the Free Software Foundation; either versions 2, or (at your option) | |
| 14 ;; any later version. | |
| 15 | |
| 16 ;; This program is distributed in the hope that it will be useful | |
| 17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
| 19 ;; GNU General Public License for more details. | |
| 20 | |
| 21 ;; You should have received a copy of the GNU General Public License | |
| 22 ;; along with SKK, see the file COPYING. If not, write to the Free | |
| 23 ;; Software Foundation Inc., 59 Temple Place - Suite 330, Boston, | |
| 24 ;; MA 02111-1307, USA. | |
| 25 | |
| 26 ;;; Commentary: | |
| 27 | |
| 28 ;;; Change log: | |
| 29 | |
| 30 ;; Following people contributed modifications to skk.el (Alphabetical order): | |
| 31 ;; Hideki Sakurada <sakurada@kuis.kyoto-u.ac.jp> | |
| 32 ;; Manabu Kawashima <kaw@lp.nm.fujitsu.co.jp> | |
| 33 | |
| 34 ;;; TODO | |
| 35 ;; (1)skk-kanji-num-str2-subr $B$N%P%0=$@5!#(Bskk-kanji-num-str2-subr $B$N%3%a%s%H;2>H(B | |
| 36 ;; $B$N$3$H!#(B | |
| 37 ;; | |
| 38 ;; (2)skk-kanji-num-str3 $B$N?7@_!#(B | |
| 39 | |
| 40 ;;; Code: | |
| 41 (require 'skk-foreword) | |
| 42 (require 'skk-vars) | |
| 43 (require 'cl) | |
| 44 | |
| 45 ;; user variables. | |
| 46 ;;;###skk-autoload | |
| 47 (defvar skk-num-type-list | |
| 48 '((?0 . identity) | |
| 49 (?1 . skk-zenkaku-num-str) | |
| 50 (?2 . skk-kanji-num-str) | |
| 51 (?3 . skk-kanji-num-str2) | |
| 52 ;;(?5 . skk-kanji-num-str3) ; $B=`HwCf(B | |
| 53 (?4 . skk-recompute-numerals) | |
| 54 (?9 . skk-shogi-num-str) ) | |
| 55 "*$B?t;z$NJQ49$N$?$a$N!"%$%s%G%/%9$HJQ49$K;HMQ$9$k4X?t$H$N%I%C%H%Z%"$N%j%9%H!#(B | |
| 56 $B3FMWAG$O!"(B($B?t;z$N(B char-type . $B4X?tL>(B) $B$H$$$&9=@.$K$J$C$F$$$k!#(B | |
| 57 car $BItJ,$O!"Nc$($P!"8+=P$78l$,(B \"$BJ?@.(B#1$BG/(B\" $B$N$H$-!"(B# $B5-9f$ND>8e$KI=<($5$l$k?t(B | |
| 58 $B;z(B \"1\" $B$r(B char-type $B$GI=$o$7$?$b$N$rBeF~$9$k!#(B") | |
| 59 | |
| 60 (defvar skk-numeric-conversion-float-num nil | |
| 61 "*Non-nil $B$G$"$l$P!"IbF0>.?tE@?t$r;H$C$?8+=P$78l$KBP1~$7$FJQ49$r9T$J$&!#(B | |
| 62 $B$3$NCM$r(B non-nil $B$K$9$k$3$H$G!"(B\"#.# /#1$B!%(B#1/#0$B7n(B#0$BF|(B/\" $B$J$I$N<-=q8+=P$7$,;HMQ(B | |
| 63 $B$G$-$J$/$J$k$N$G!"Cm0U!#(B" ) | |
| 64 | |
| 65 ;;;###skk-autoload | |
| 66 (defvar skk-uniq-numerals (or (assq ?4 skk-num-type-list) | |
| 67 (and (assq ?2 skk-num-type-list) | |
| 68 (assq ?3 skk-num-type-list) )) | |
| 69 "*Non-nil $B$G$"$l$P!"0[$J$k?tCMI=8=$G$bJQ497k2L$,F1$8?tCM$r=EJ#$7$F=PNO$7$J$$!#(B" ) | |
| 70 | |
| 71 (defvar skk-num-load-hook nil | |
| 72 "*skk-num.el $B$r%m!<%I$7$?8e$K%3!<%k$5$l$k%U%C%/!#(B" ) | |
| 73 | |
| 74 ;; internal constants and variables | |
| 75 (defconst skk-num-alist-type1 | |
| 76 '((?0 . "$B#0(B") (?1 . "$B#1(B") (?2 . "$B#2(B") (?3 . "$B#3(B") | |
| 77 (?4 . "$B#4(B") (?5 . "$B#5(B") (?6 . "$B#6(B") (?7 . "$B#7(B") | |
| 78 (?8 . "$B#8(B") (?9 . "$B#9(B") | |
| 79 (?. . "$B!%(B") ; $B>.?tE@!#(B(?. . ".") $B$NJ}$,NI$$?M$b$$$k$+$b(B...$B!#(B | |
| 80 (? . "") ) | |
| 81 "ascii $B?t;z$N(B char type $B$HA43Q?t;z$N(B string type $B$NO"A[%j%9%H!#(B | |
| 82 \"1995\" -> \"$B#1#9#9#5(B\" $B$N$h$&$JJ8;zNs$NJQ49$r9T$&:]$KMxMQ$9$k!#(B" ) | |
| 83 | |
| 84 (defconst skk-num-alist-type2 | |
| 85 '((?0 . "$B!;(B") (?1 . "$B0l(B") (?2 . "$BFs(B") (?3 . "$B;0(B") | |
| 86 (?4 . "$B;M(B") (?5 . "$B8^(B") (?6 . "$BO;(B") (?7 . "$B<7(B") | |
| 87 (?8 . "$BH,(B") (?9 . "$B6e(B") (? . "") ) | |
| 88 "ascii $B?t;z$N(B char type $B$H4A?t;z$N(B string type $B$NO"A[%j%9%H!#(B | |
| 89 \"1995\" -> \"$B0l6e6e8^(B\" $B$N$h$&$JJ8;zNs$NJQ49$r9T$&:]$KMxMQ$9$k!#(B" ) | |
| 90 | |
| 91 ;;; $B=`HwCf(B | |
| 92 ;;;(defconst skk-num-alist-type3 | |
| 93 ;;; '((?1 . "$B0m(B") (?2 . "$BFu(B") (?3 . "$B;2(B") | |
| 94 ;;; (?4 . "$B;M(B") (?5 . "$B8`(B") (?6 . "$BO;(B") (?7 . "$B<7(B") | |
| 95 ;;; (?8 . "$BH,(B") (?9 . "$B6e(B") (? . "") ) | |
| 96 ;;; "ascii $B?t;z$N(B char type $B$H4A?t;z$N(B string type $B$NO"A[%j%9%H!#(B | |
| 97 ;;;\"1995\" -> \"$B0mot6eI46e=&8`(B\" $B$N$h$&$JJ8;zNs$NJQ49$r9T$&:]$KMxMQ$9$k!#(B" ) | |
| 98 | |
| 99 ;;;###skk-autoload | |
| 100 (skk-deflocalvar skk-num-list nil | |
| 101 "skk-henkan-key $B$NCf$K4^$^$l$k?t;z$rI=$9J8;zNs$N%j%9%H!#(B | |
| 102 $BNc$($P!"(B\"$B"&$X$$$;$$(B7$B$M$s(B10$B$,$D(B\" $B$NJQ49$r9T$&$H$-!"(Bskk-henkan-key $B$O(B | |
| 103 \"$B$X$$$;$$(B7$B$M$s(B10$B$,$D(B\" $B$G$"$j!"(Bskk-num-list $B$O(B \(\"7\" \"10\"\) $B$H$J$k!#(B" ) | |
| 104 | |
| 105 ;;;###skk-autoload | |
| 106 (skk-deflocalvar skk-recompute-numerals-key nil | |
| 107 "#4 $B%?%$%W$N%-!<$K$h$j?tCM$N:F7W;;$r9T$J$C$?$H$-$N8!:w%-!<!#(B" ) | |
| 108 | |
| 109 ;;;###skk-autoload | |
| 110 (defun skk-compute-numeric-henkan-key (key) | |
| 111 ;; KEY $B$NCf$NO"B3$9$k?t;z$r8=$o$9J8;zNs$r(B "#" $B$KCV$-49$($?J8;zNs$rJV$9!#(B"12" | |
| 112 ;; $B$d(B "$B#0#9(B" $B$J$IO"B3$9$k?t;z$r(B 1 $B$D$N(B "#" $B$KCV$-49$($k$3$H$KCm0U!#(B | |
| 113 ;; $BCV$-49$($??t;z$r(B skk-num-list $B$NCf$K%j%9%H$N7A$GJ]B8$9$k!#(B | |
| 114 ;; $BNc$($P!"(BKEY $B$,(B "$B$X$$$;$$(B7$BG/(B12$B$,$D(B" $B$G$"$l$P!"(B"$B$X$$$;$$(B#$B$M$s(B#$B$,$D(B" | |
| 115 ;; $B$HJQ49$7!"(Bskk-num-list $B$K(B ("7" "12") $B$H$$$&%j%9%H$rBeF~$9$k!#(B | |
| 116 ;; $B<-=q$N8+=P$78l$N8!:w$K;HMQ$9$k!#(B | |
| 117 (let ((numberrep (if skk-numeric-conversion-float-num | |
| 118 "[.0-9]+" "[0-9]+" )) | |
| 119 (enable-multibyte-characters t) ) | |
| 120 ;;(setq skk-noconv-henkan-key key) | |
| 121 (save-match-data | |
| 122 ;; $BA43Q?t;z$r(B ascii $B?t;z$KJQ49$9$k!#(B | |
| 123 (while (string-match "[$B#0(B-$B#9(B]" key) | |
| 124 (let ((zen-num (match-string 0 key))) | |
| 125 (setq key (concat (substring key 0 (match-beginning 0)) | |
| 126 (skk-jisx0208-to-ascii zen-num) | |
| 127 (substring key (match-end 0)) )))) | |
| 128 ;; ascii $B?t;z$r(B "#" $B$KCV$-49$(!"$=$N?t;z$r(B skk-num-list $B$NCf$KJ]B8!#(B | |
| 129 (while (string-match numberrep key) | |
| 130 (setq skk-num-list (nconc skk-num-list (list (match-string 0 key))) | |
| 131 key (concat (substring key 0 (match-beginning 0)) | |
| 132 "#" | |
| 133 (substring key (match-end 0)) ))))) | |
| 134 key ) | |
| 135 | |
| 136 ;;(defun skk-compute-noconv-henkan-key (key) | |
| 137 ;; ;; $BJ8;zNs(B KEY $B$NCf$K?tCMJQ49$rI=$o$9(B "#" $B$,$"$l$P!"$=$NItJ,$r:o=|$7!"(B | |
| 138 ;; ;; skk-num-list $B$NCf$G3:Ev$9$k?t;z$rA^F~$7!":G=i$K(B skk-start-henkan $B$KEO$5$l(B | |
| 139 ;; ;; $B$?J8;zNs$rJV$9!#Nc$($P!"(Bskk-num-list $B$,(B ("1" "2" "3") $B$G!"(BKEY $B$,(B | |
| 140 ;; ;; "#$B$,$D(B#$B$,$D(B#$B$,$D(B" $B$G$"$k$H$-$O!"J8;zNs(B "1$B$,$D(B2$B$,$D(B3$B$,$D(B" $B$rJV$9!#(B | |
| 141 ;; (if skk-num-list | |
| 142 ;; (save-match-data | |
| 143 ;; (let ((num-list skk-num-list) | |
| 144 ;; str ) | |
| 145 ;; (while (and num-list key (string-match "#" key)) | |
| 146 ;; (setq str (concat str (substring key 0 (match-beginning 0)) | |
| 147 ;; (car num-list) ) | |
| 148 ;; key (substring key (match-end 0)) | |
| 149 ;; num-list (cdr num-list) )) | |
| 150 ;; (setq key (concat str key)) ))) | |
| 151 ;; key ) | |
| 152 | |
| 153 ;;;###skk-autoload | |
| 154 (defun skk-numeric-convert (key) | |
| 155 (if (not key) | |
| 156 nil | |
| 157 (let ((numexp (if skk-numeric-conversion-float-num | |
| 158 "#[.0-9]+" "#[0-9]+" )) | |
| 159 (n 0) | |
| 160 (workkey key) | |
| 161 num convnum string convlist current ) | |
| 162 (save-match-data | |
| 163 (while (and (setq num (nth n skk-num-list)) | |
| 164 (string-match numexp workkey) ) | |
| 165 (setq convnum (skk-num-exp num (string-to-char | |
| 166 (substring workkey | |
| 167 (1+ (match-beginning 0)) | |
| 168 (match-end 0) ))) | |
| 169 string (substring workkey 0 (match-beginning 0)) | |
| 170 workkey (substring workkey (match-end 0)) | |
| 171 n (1+ n) ) | |
| 172 (if (not (and (stringp convnum) (string= convnum "") | |
| 173 (string= string "") )) | |
| 174 (setq convlist (nconc convlist (list string convnum))) )) | |
| 175 (setq convlist (nconc convlist (list workkey))) | |
| 176 (cond ((null convlist) nil) | |
| 177 ((and (null (cdr convlist)) (stringp (car convlist))) | |
| 178 (setq current (car convlist)) ) | |
| 179 ;; RAW-LIST $B$NA4MWAG$,J8;zNs!#(B | |
| 180 ((null (memq t (mapcar 'listp convlist))) | |
| 181 (setq current (mapconcat 'identity convlist "")) | |
| 182 (if (and (> skk-henkan-count -1) | |
| 183 (nth skk-henkan-count skk-henkan-list) ) | |
| 184 ;; ("A" "#2" "C") -> ("A" ("$B0l(B" . "#2") "C") | |
| 185 (setf (nth skk-henkan-count skk-henkan-list) | |
| 186 (cons key current) ) | |
| 187 (setq skk-henkan-list | |
| 188 (nconc skk-henkan-list (list (cons key current))) ))) | |
| 189 ;; #4 | |
| 190 (t (let ((l (mapcar (function (lambda (e) (cons key e))) | |
| 191 (skk-flatten-list (delete "" convlist)) ))) | |
| 192 (setq current (cdr (car l))) | |
| 193 (if (and (> skk-henkan-count -1) | |
| 194 (nth skk-henkan-count skk-henkan-list) ) | |
| 195 (progn | |
| 196 (setf (nth skk-henkan-count skk-henkan-list) (car l)) | |
| 197 (setq skk-henkan-list (skk-middle-list | |
| 198 skk-henkan-list | |
| 199 (1+ skk-henkan-count) | |
| 200 (cdr l) ))) | |
| 201 (setq skk-henkan-list (nconc skk-henkan-list l)) )))) | |
| 202 current )))) | |
| 203 | |
| 204 ;;;###skk-autoload | |
| 205 (defun skk-numeric-convert*7 () | |
| 206 (let ((skk-henkan-count skk-henkan-count) | |
| 207 (n 7) ) | |
| 208 (while (and (> n 0) (nth skk-henkan-count skk-henkan-list)) | |
| 209 (skk-numeric-convert (skk-get-current-candidate)) | |
| 210 (setq skk-henkan-count (1+ skk-henkan-count) | |
| 211 n (1- n) )) | |
| 212 (if skk-recompute-numerals-key | |
| 213 (skk-uniq-numerals) ))) | |
| 214 | |
| 215 (defun skk-raw-number-to-skk-rep (string) | |
| 216 (setq string (skk-raw-number-to-skk-rep-1 | |
| 217 string "[$B#0(B-$B#9(B][$B0l6e8^;0;M<7FsH,O;(B]" "#9" 0 )) | |
| 218 (setq string (skk-raw-number-to-skk-rep-1 | |
| 219 string "\\(^\\|[^#0-9]\\)\\([0-9]+\\)" "#0" 2 )) | |
| 220 (setq string (skk-raw-number-to-skk-rep-1 | |
| 221 string "[$B#0(B-$B#9(B]+" "#1" 0 )) | |
| 222 (setq string (skk-raw-number-to-skk-rep-1 | |
| 223 string "\\([$B0l6e8^;0;M<7FsH,O;==(B][$B==I4@iK|2/C{5~(B]\\)+" "#3" 0 )) | |
| 224 ;; (mapcar 'char-to-string | |
| 225 ;; (sort | |
| 226 ;; '(?$B0l(B ?$BFs(B ?$B;0(B ?$B;M(B ?$B8^(B ?$BO;(B ?$B<7(B ?$BH,(B ?$B6e(B ?$B!;(B) '<)) | |
| 227 ;; --> ("$B!;(B" "$B0l(B" "$B6e(B" "$B8^(B" "$B;0(B" "$B;M(B" "$B<7(B" "$BFs(B" "$BH,(B" "$BO;(B") | |
| 228 ;; | |
| 229 ;; [$B!;(B-$B6e(B] $B$H$$$&@55,I=8=$,;H$($J$$$N$G!"@8$N$^$^$D$C$3$s$G$*$/!#(B | |
| 230 (skk-raw-number-to-skk-rep-1 string "[$B!;0l6e8^;0;M<7FsH,O;(B]+" "#2" 0)) | |
| 231 | |
| 232 (defun skk-raw-number-to-skk-rep-1 (string key type place) | |
| 233 (let ((enable-multibyte-characters t)) | |
| 234 (save-match-data | |
| 235 (while (string-match key string) | |
| 236 (setq string (concat (substring string 0 (match-beginning place)) | |
| 237 type | |
| 238 (substring string (match-end place)) ))) | |
| 239 string ))) | |
| 240 | |
| 241 (defun skk-flatten-list (list) | |
| 242 ;; $BM?$($i$l$?%j%9%H$N3FMWAG$+$iAH$_9g$;2DG=$JJ8;zNs$NO"@\$r:n$j!"%j%9%H$GJV(B | |
| 243 ;; $B$9!#(B | |
| 244 ;; (("A" "B") "1" ("X" "Y")) -> ("A1X" "A1Y" "B1X" "B1Y") | |
| 245 (do ((result | |
| 246 (if (atom (car list)) (list (car list)) (car list)) | |
| 247 (mapcan (function | |
| 248 (lambda (a) | |
| 249 (mapcar (function (lambda (b) (concat a b))) | |
| 250 (if (atom (car tail)) (list (car tail)) | |
| 251 (car tail) )))) | |
| 252 result )) | |
| 253 (tail (cdr list) (cdr tail)) ) | |
| 254 ((null tail) result) )) | |
| 255 | |
| 256 (defun skk-num-exp (num type) | |
| 257 ;; ascii $B?t;z$N(B NUM $B$r(B TYPE $B$K=>$$JQ49$7!"JQ498e$NJ8;zNs$rJV$9!#(B | |
| 258 ;; TYPE $B$O2<5-$NDL$j!#(B | |
| 259 ;; 0 -> $BL5JQ49(B | |
| 260 ;; 1 -> $BA43Q?t;z$XJQ49(B | |
| 261 ;; 2 -> $B4A?t;z$XJQ49(B | |
| 262 ;; 3 -> $B4A?t;z$XJQ49(B ($B0L<h$j$r$9$k(B) | |
| 263 ;; 4 -> $B$=$N?t;z$=$N$b$N$r%-!<$K$7$F<-=q$r:F8!:w(B | |
| 264 ;; 9 -> $B>-4}$G;HMQ$9$k?t;z(B ("$B#3;M(B" $B$J$I(B) $B$KJQ49(B | |
| 265 (let ((fun (cdr (assq type skk-num-type-list)))) | |
| 266 (if fun (funcall fun num)) )) | |
| 267 | |
| 268 (defun skk-zenkaku-num-str (num) | |
| 269 ;; ascii $B?t;z$N(B NUM $B$rA43Q?t;z$NJ8;zNs$KJQ49$7!"JQ498e$NJ8;zNs$rJV$9!#(B | |
| 270 ;; $BNc$($P(B "45" $B$r(B "$B#4#5(B" $B$KJQ49$9$k!#(B | |
| 271 (let ((candidate | |
| 272 (mapconcat (function (lambda (c) (cdr (assq c skk-num-alist-type1)))) | |
| 273 num "" ))) | |
| 274 (if (not (string= candidate "")) | |
| 275 candidate ))) | |
| 276 | |
| 277 (defun skk-kanji-num-str (num) | |
| 278 ;; ascii $B?t;z(B NUM $B$r4A?t;z$NJ8;zNs$KJQ49$7!"JQ498e$NJ8;zNs$rJV$9!#(B | |
| 279 ;; $BNc$($P!"(B"45" $B$r(B "$B;M8^(B" $B$KJQ49$9$k!#(B | |
| 280 (save-match-data | |
| 281 (if (not (string-match "\\.[0-9]" num)) | |
| 282 (let ((candidate | |
| 283 (mapconcat (function (lambda (c) | |
| 284 (cdr (assq c skk-num-alist-type2)) )) | |
| 285 num "" ))) | |
| 286 (if (not (string= candidate "")) | |
| 287 candidate ))))) | |
| 288 | |
| 289 (defun skk-kanji-num-str2 (num) | |
| 290 ;; ascii $B?t;z(B NUM $B$r4A?t;z$NJ8;zNs$KJQ49$7(B ($B0L<h$j$r$9$k(B)$B!"JQ498e$NJ8;zNs$r(B | |
| 291 ;; $BJV$9!#Nc$($P(B "1021" $B$r(B "$B@iFs==0l(B" $B$KJQ49$9$k!#(B | |
| 292 (save-match-data | |
| 293 (if (not (string-match "\\.[0-9]" num)) | |
| 294 (let ((str (skk-kanji-num-str2-subr num))) | |
| 295 (if (string= "" str) "$B!;(B" str) )))) | |
| 296 | |
| 297 (defun skk-kanji-num-str2-subr (num) | |
| 298 ;; skk-kanji-num-str2 $B$N%5%V%k!<%A%s!#(B | |
| 299 ;; | |
| 300 ;; Known Bug; $B"&(B 100000000 $B$rJQ49$9$k$H!"(B"$B0l2/K|(B" $B$K$J$C$F$7$^$&(B...$B!#$G$b$=$s(B | |
| 301 ;; $B$JJQ49$r;H$&?M$O$$$J$$$+$J!"$H;W$&$HD>$95$NO$,M/$+$J$$(B...$B!#(B | |
| 302 ;; --> Fixed $B$N%O%:(B...$B!#(B | |
| 303 (let ((len (length num)) | |
| 304 prevchar modulo ) | |
| 305 (mapconcat | |
| 306 (function | |
| 307 (lambda (char) | |
| 308 ;; $B0L(B: $B0l(B $B==(B $BI4(B $B@i(B $BK|(B $B==K|(B $BI4K|(B $B@iK|(B $B2/(B | |
| 309 ;; modulo: 1 --> 2 --> 3 --> 0 -> 1 --> 2 ---> 3 ---> 0 ---> 1 | |
| 310 (setq modulo (mod len 4)) | |
| 311 (prog1 | |
| 312 (if (eq len 1) | |
| 313 ;; 1 $B7e$G(B 0 $B$G$J$$?t!#(B | |
| 314 (if (not (eq char ?0)) ;?0 | |
| 315 ;; $B0L$rI=$o$94A?t;z0J30$N4A?t;z!#(B | |
| 316 (cdr (assq char skk-num-alist-type2)) ) | |
| 317 (concat | |
| 318 ;; $B0L$rI=$o$94A?t;z0J30$N4A?t;z!#(B | |
| 319 (if (or | |
| 320 ;; 2 $B7e0J>e$G!"$3$N0L$N?t$O(B 0, 1 $B0J30$N?t;z!#(B | |
| 321 ;; ?0 == 48, ?1 == 49 | |
| 322 (null (memq char '(?0 ?1))) | |
| 323 ;; 2 $B7e0J>e$G!"$3$N0L$N?t$O(B 1 $B$G!"0L$,$=$N0L$rI=$o$94A?t;z(B | |
| 324 ;; $B$K(B "$B0l(B" $B$rJ;5-$9$Y$-(B ($BNc$($P!"(B"$B0l2/(B" $B$J$I!#(B"$B2/(B" $B$G$O$*(B | |
| 325 ;; $B$+$7$$(B) $B$H$-!#(B | |
| 326 (and (eq char ?1) (eq modulo 1)) ) | |
| 327 (cdr (assq char skk-num-alist-type2)) ) | |
| 328 ;; $B0L$rI=$o$94A?t;z!#(B | |
| 329 (if (and (not (eq prevchar ?0)) | |
| 330 (not (and (eq char ?0) (not (eq modulo 1))) )) | |
| 331 (cond ((cdr (assq modulo '((2 . "$B==(B") (3 . "$BI4(B") (0 . "$B@i(B"))))) | |
| 332 ((cdr (assq len '((5 . "$BK|(B") (9 . "$B2/(B") (13 . "$BC{(B") | |
| 333 (17 . "$B5~(B") )))) | |
| 334 (t (skk-error "$B7e$,Bg$-$9$.$^$9!*(B" | |
| 335 "Too big number!" )))))) | |
| 336 (setq len (1- len) | |
| 337 prevchar char ) ))) | |
| 338 num "" ))) | |
| 339 | |
| 340 (defun skk-shogi-num-str (num) | |
| 341 ;; ascii $B?t;z$N(B NUM $B$r>-4}$G;HMQ$5$l$k?t;zI=5-$KJQ49$9$k!#(B | |
| 342 ;; $BNc$($P(B "34" $B$r(B "$B#3;M(B" $B$KJQ49$9$k!#(B | |
| 343 (save-match-data | |
| 344 (if (and (eq (length num) 2) | |
| 345 (not (string-match "\\.[0-9]" num)) ) | |
| 346 (let ((candidate | |
| 347 (concat (cdr (assq (aref num 0) skk-num-alist-type1)) | |
| 348 (cdr (assq (aref num 1) skk-num-alist-type2)) ))) | |
| 349 (if (not (string= candidate "")) | |
| 350 candidate ))))) | |
| 351 | |
| 352 (defun skk-recompute-numerals (num) | |
| 353 ;; #4 $B$N8+=P$7$KBP$7!"(Bskk-henkan-key $B$KBeF~$5$l$??t;z$=$N$b$N$r:FEY8!:w$9$k!#(B | |
| 354 (let (result) | |
| 355 ;; with-temp-buffer $B$@$H2?8N>e<j$/$f$+$J$$(B...$B!)(B $B3NDj$5$l$F$7$^$&!#(B | |
| 356 ;;(with-temp-buffer | |
| 357 (save-excursion | |
| 358 (set-buffer (get-buffer-create " *skk-work*")) | |
| 359 ;; $B%+%l%s%H%P%C%U%!$N%P%C%U%!%m!<%+%kJQ?t$K1F6A$r5Z$\$5$J$$$h$&!"%o!<%-(B | |
| 360 ;; $B%s%0%P%C%U%!$X0lC6F($2$k(B | |
| 361 (let ((skk-current-search-prog-list skk-search-prog-list) | |
| 362 (skk-henkan-key num) | |
| 363 skk-henkan-okurigana skk-okuri-char skk-use-numeric-conversion ) | |
| 364 ;; $B%+%l%s%H$NJQ49$OAw$j$J$7(B (skk-henkan-okurigana $B$H(B skk-okuri-char $B$O(B | |
| 365 ;; $B$$$:$l$b(B nil) $B$@$,!"JL%P%C%U%!(B (work $B%P%C%U%!(B) $B$KF~$C$F$$$k$N$G!"G0(B | |
| 366 ;; $B$N$?$a!"(Bnil $B$rF~$l$F$*$/!#(B | |
| 367 (while skk-current-search-prog-list | |
| 368 (setq result (skk-nunion result (skk-search))) ))) | |
| 369 ;; $B$3$3$G(B with-temp-buffer $B$r=P$FJQ49$r9T$J$C$F$$$k%+%l%s%H%P%C%U%!$KLa$k(B | |
| 370 ;; ($B%P%C%U%!%m!<%+%kCM$G$"$k(B skk-henkan-list $B$rA`:n$7$?$$$?$a(B)$B!#(B | |
| 371 (setq skk-recompute-numerals-key num) | |
| 372 (if result | |
| 373 (if (null (cdr result)) ;;(eq (length result) 1) | |
| 374 (car result) | |
| 375 result ) | |
| 376 ;; $BJQ49$G$-$J$+$C$?$i85$N?t;z$r$=$N$^$^JV$7$F$*$/!#(B | |
| 377 num ))) | |
| 378 | |
| 379 ;;;###skk-autoload | |
| 380 (defun skk-uniq-numerals () | |
| 381 (if (or (not skk-uniq-numerals) (null skk-henkan-list)) | |
| 382 nil | |
| 383 (save-match-data | |
| 384 (let ((n1 -1) n2 e1 e2 e3 | |
| 385 ;; 1 $B$D$G$b(B 2 $B7e0J>e$N?t;z$,$"$l$P!"(B#2 $B$H(B #3 $B$G$O(B uniq $B$7$J$$!#(B | |
| 386 (type2and3 (> 2 (apply 'max (mapcar 'length skk-num-list)))) | |
| 387 type2 type3 index2 index3 head2 head3 tail2 tail3 | |
| 388 kanji-flag mc-flag enable-multibyte-characters case-fold-search ) | |
| 389 (while (setq n1 (1+ n1) e1 (nth n1 skk-henkan-list)) | |
| 390 ;; cons cell $B$G$J$1$l$P(B skk-nunion $B$G=hM}:Q$_$J$N$G!"=EJ#$O$J$$!#(B | |
| 391 (if (consp e1) | |
| 392 ;; (car e1) $B$H(B equal $B$N$b$N$,>C$($k$N$@$+$i(B e1 $B<+?H$,>C$($k$3(B | |
| 393 ;; $B$H$O$J$$!#(B | |
| 394 (setq skk-henkan-list (delete (car e1) skk-henkan-list) | |
| 395 skk-henkan-list (delete (cdr e1) skk-henkan-list) )) | |
| 396 (if (not (and skk-recompute-numerals-key (consp e1))) | |
| 397 nil | |
| 398 ;; ("#4" . "xxx") $B$r4^$`8uJd$,(B skk-henkan-list $B$NCf$K$"$k!#(B | |
| 399 (setq n2 -1) | |
| 400 (while (setq n2 (1+ n2) e2 (nth n2 skk-henkan-list)) | |
| 401 (if (and (not (= n1 n2)) (consp e2) | |
| 402 ;; $BNc$($P(B ("#4" . "$B0l(B") $B$H(B ("#2" . "$B0l(B") $B$,JBB8$7$F$$(B | |
| 403 ;; $B$k>l9g!#(B | |
| 404 (string= (cdr e1) (cdr e2)) ) | |
| 405 (setq skk-henkan-list (delq e2 skk-henkan-list)) ))) | |
| 406 (if (not type2and3) | |
| 407 nil | |
| 408 ;; 1 $B7e$N?t;z$rJQ49$9$k:]$K!"(Bskk-henkan-list $B$K(B #2 $B%(%s%H%j$H(B #3 | |
| 409 ;; $B%(%s%H%j$,$"$l$P!"(B#2 $B$b$7$/$O(B #3 $B%(%s%H%j$N$&$A!"$h$j8eJ}$K$"$k(B | |
| 410 ;; $B$b$N$r>C$9!#(B | |
| 411 (setq e3 (if (consp e1) (car e1) e1)) | |
| 412 ;; e3 $B$O(B "#2" $B$N$h$&$K?tCMJQ49$r<($9J8;zNs$N$_$H$O8B$i$J$$$N$G!"(B | |
| 413 ;; member $B$O;H$($J$$!#(B | |
| 414 (cond ((string-match "#2" e3) | |
| 415 (setq type2 e1 | |
| 416 index2 n1 | |
| 417 head2 (substring e3 0 (match-beginning 0)) | |
| 418 tail2 (substring e3 (match-end 0)) )) | |
| 419 ((string-match "#3" e3) | |
| 420 (setq type3 e1 | |
| 421 index3 n1 | |
| 422 head3 (substring e3 0 (match-beginning 0)) | |
| 423 tail3 (substring e3 (match-end 0)) ))))) | |
| 424 (if (and type2and3 type2 type3 | |
| 425 ;; $B?tCMJQ49$r<($9J8;zNs(B "#[23]" $B$NA08e$NJ8;zNs$bF10l$N$H(B | |
| 426 ;; $B$-$N$_(B uniq $B$r9T$J$&!#(B | |
| 427 (string= head2 head3) (string= tail2 tail3)) | |
| 428 (if (> index2 index3) | |
| 429 ;; "#3" $B$NJ}$,A0$K$"$k!#(B | |
| 430 (setq skk-henkan-list (delq type2 skk-henkan-list)) | |
| 431 ;; $BJQ?t(B type[23] $B$NCM$O!"(Bskk-henkan-list $B$+$iD>@\Cj=P$7$?$b(B | |
| 432 ;; $B$N$@$+$i(B delete $B$G$J$/!"(Bdelq $B$G==J,!#(B | |
| 433 (setq skk-henkan-list (delq type3 skk-henkan-list)) )))))) | |
| 434 | |
| 435 ;;;###skk-autoload | |
| 436 (defun skk-adjust-numeric-henkan-data (key) | |
| 437 (let (numexp orglen val) | |
| 438 (if (or (and (string-match "#[012349]" key) | |
| 439 (setq numexp key) ) | |
| 440 (and (setq numexp (skk-raw-number-to-skk-rep key)) | |
| 441 (not (string= key numexp)) )) | |
| 442 (progn | |
| 443 (setq orglen (length skk-henkan-list) | |
| 444 ;; skk-henkan-list $B$ND4@0$O!"(Bskk-numeric-convert $B$NCf$G9T$J$C(B | |
| 445 ;; $B$F$/$l$k!#(B | |
| 446 val (skk-numeric-convert numexp) ) | |
| 447 (if (= (length skk-henkan-list) (1+ orglen)) | |
| 448 ;; #4 $B$GJ#?t$N8uJd$KJQ49$G$-$?>l9g$O3NDj$7$J$$!#(B | |
| 449 (setq skk-kakutei-flag t) )) | |
| 450 (setq skk-henkan-list (nconc skk-henkan-list (list key)) | |
| 451 skk-kakutei-flag t | |
| 452 val key )) | |
| 453 val )) | |
| 454 | |
| 455 ;;;###skk-autoload | |
| 456 (defun skk-init-numeric-conversion-variables () | |
| 457 ;; skk-use-numeric-convert $B4XO"$NJQ?t$r=i4|2=$9$k!#(B | |
| 458 (setq skk-num-list nil | |
| 459 skk-recompute-numerals-key nil )) | |
| 460 | |
| 461 ;;;###skk-autoload | |
| 462 (defun skk-numeric-midasi-word () | |
| 463 ;; type4 $B$N?tCM:FJQ49$,9T$J$o$l$?$H$-$O!"?tCM<+?H$rJV$7!"$=$l0J30$N?tCMJQ49(B | |
| 464 ;; $B$G$O!"(Bskk-henkan-key $B$rJV$9!#$3$s$J>.$5$J4X?t$r:n$i$J$-$c$J$i$J$$$N$O!"(B | |
| 465 ;; skk-use-numeric-conversion $B$K4XO"$9$kJQ?t$r(B skk-num.el $B$K=8Ls$7$?L5M}$,=P(B | |
| 466 ;; $B$?7k2L$+(B...$B!#(B | |
| 467 (or skk-recompute-numerals-key skk-henkan-key) ) | |
| 468 | |
| 469 ;;;###skk-autoload | |
| 470 (defun skk-update-jisyo-for-numerals (noconvword word &optional purge) | |
| 471 ;; $B?t;z<+?H$r8+=P$78l$H$7$F<-=q$N%"%C%W%G!<%H$r9T$J$&!#(B | |
| 472 (if (and skk-recompute-numerals-key | |
| 473 (save-match-data (string-match "#4" noconvword)) ) | |
| 474 (let ((skk-henkan-key skk-recompute-numerals-key)) | |
| 475 (message "%S" skk-recompute-numerals-key) | |
| 476 (skk-update-jisyo word purge) ))) | |
| 477 | |
| 478 ;;;###skk-autoload | |
| 479 (defun skk-num (str) | |
| 480 ;; $B?t;z$r(B skk-number-style $B$NCM$K=>$$JQ49$9$k!#(B | |
| 481 ;; skk-date $B$N%5%V%k!<%A%s!#(B | |
| 482 (mapconcat (function | |
| 483 (lambda (c) | |
| 484 (cond ((or (not skk-number-style) (eq skk-number-style 0)) | |
| 485 (char-to-string c) ) | |
| 486 ((or (eq skk-number-style t) (eq skk-number-style 1)) | |
| 487 (cdr (assq c skk-num-alist-type1)) ) | |
| 488 (t (cdr (assq c skk-num-alist-type2))) ))) | |
| 489 str "" )) | |
| 490 | |
| 491 (run-hooks 'skk-num-load-hook) | |
| 492 | |
| 493 (provide 'skk-num) | |
| 494 ;;; skk-num.el ends here |