Mercurial > hg > xemacs-beta
annotate lisp/mule/japan-util.el @ 5753:dbd8305e13cb
Warn about non-string non-integer ARG to #'gensym, bytecomp.el.
lisp/ChangeLog addition:
2013-08-21 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el:
* bytecomp.el (gensym):
* bytecomp.el (byte-compile-gensym): New.
Warn that gensym called in a for-effect context is unlikely to be
useful.
Warn about non-string non-integer ARGs, this is incorrect.
Am not changing the function to error with same, most code that
makes the mistake is has no problems, which is why it has survived
so long.
* window-xemacs.el (save-window-excursion/mapping):
* window.el (save-window-excursion):
Call #'gensym with a string, not a symbol.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Wed, 21 Aug 2013 19:02:59 +0100 |
| parents | 308d34e9f07d |
| children |
| rev | line source |
|---|---|
| 778 | 1 ;;; japan-util.el --- utilities for Japanese -*- coding: iso-2022-7bit; -*- |
| 771 | 2 |
| 3 | |
| 4 ;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. | |
| 5 ;; Licensed to the Free Software Foundation. | |
| 778 | 6 ;; Copyright (C) 2001 Free Software Foundation, Inc. |
| 771 | 7 |
| 8 ;; Keywords: mule, multilingual, Japanese | |
| 9 | |
| 10 ;; This file is part of XEmacs. | |
| 11 | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
1196
diff
changeset
|
12 ;; XEmacs is free software: you can redistribute it and/or modify it |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
1196
diff
changeset
|
13 ;; under the terms of the GNU General Public License as published by the |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
1196
diff
changeset
|
14 ;; Free Software Foundation, either version 3 of the License, or (at your |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
1196
diff
changeset
|
15 ;; option) any later version. |
| 771 | 16 |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
1196
diff
changeset
|
17 ;; XEmacs is distributed in the hope that it will be useful, but WITHOUT |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
1196
diff
changeset
|
18 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
1196
diff
changeset
|
19 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
1196
diff
changeset
|
20 ;; for more details. |
| 771 | 21 |
| 22 ;; You should have received a copy of the GNU General Public License | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
1196
diff
changeset
|
23 ;; along with XEmacs. If not, see <http://www.gnu.org/licenses/>. |
| 771 | 24 |
| 778 | 25 ;;; Synched up with: Emacs 21.1 (language/japan-util.el). |
| 26 | |
| 27 ;;; Commentary: | |
| 771 | 28 |
| 29 ;;; Code: | |
| 30 | |
| 31 (defvar sentence-end-save nil) | |
| 32 | |
| 33 ;;;###autoload | |
| 34 (defun setup-japanese-environment-internal () | |
| 35 (cond ((eq system-type 'ms-dos) | |
| 952 | 36 (prefer-coding-system 'shift_jis)) |
| 1196 | 37 (t |
| 952 | 38 (prefer-coding-system 'euc-jp))) |
| 771 | 39 (setq sentence-end-save sentence-end) |
| 40 (setq sentence-end (concat sentence-end "\\|[$B!#!)!*(B]"))) | |
| 41 | |
| 42 (defun exit-japanese-environment () | |
| 43 (setq sentence-end sentence-end-save)) | |
| 44 | |
| 45 (defconst japanese-kana-table | |
| 46 '((?$B$"(B ?$B%"(B ?(I1(B) (?$B$$(B ?$B%$(B ?(I2(B) (?$B$&(B ?$B%&(B ?(I3(B) (?$B$((B ?$B%((B ?(I4(B) (?$B$*(B ?$B%*(B ?(I5(B) | |
| 47 (?$B$+(B ?$B%+(B ?(I6(B) (?$B$-(B ?$B%-(B ?(I7(B) (?$B$/(B ?$B%/(B ?(I8(B) (?$B$1(B ?$B%1(B ?(I9(B) (?$B$3(B ?$B%3(B ?(I:(B) | |
| 48 (?$B$5(B ?$B%5(B ?(I;(B) (?$B$7(B ?$B%7(B ?(I<(B) (?$B$9(B ?$B%9(B ?(I=(B) (?$B$;(B ?$B%;(B ?(I>(B) (?$B$=(B ?$B%=(B ?(I?(B) | |
| 49 (?$B$?(B ?$B%?(B ?(I@(B) (?$B$A(B ?$B%A(B ?(IA(B) (?$B$D(B ?$B%D(B ?(IB(B) (?$B$F(B ?$B%F(B ?(IC(B) (?$B$H(B ?$B%H(B ?(ID(B) | |
| 50 (?$B$J(B ?$B%J(B ?(IE(B) (?$B$K(B ?$B%K(B ?(IF(B) (?$B$L(B ?$B%L(B ?(IG(B) (?$B$M(B ?$B%M(B ?(IH(B) (?$B$N(B ?$B%N(B ?(II(B) | |
| 51 (?$B$O(B ?$B%O(B ?(IJ(B) (?$B$R(B ?$B%R(B ?(IK(B) (?$B$U(B ?$B%U(B ?(IL(B) (?$B$X(B ?$B%X(B ?(IM(B) (?$B$[(B ?$B%[(B ?(IN(B) | |
| 52 (?$B$^(B ?$B%^(B ?(IO(B) (?$B$_(B ?$B%_(B ?(IP(B) (?$B$`(B ?$B%`(B ?(IQ(B) (?$B$a(B ?$B%a(B ?(IR(B) (?$B$b(B ?$B%b(B ?(IS(B) | |
| 53 (?$B$d(B ?$B%d(B ?(IT(B) (?$B$f(B ?$B%f(B ?(IU(B) (?$B$h(B ?$B%h(B ?(IV(B) | |
| 54 (?$B$i(B ?$B%i(B ?(IW(B) (?$B$j(B ?$B%j(B ?(IX(B) (?$B$k(B ?$B%k(B ?(IY(B) (?$B$l(B ?$B%l(B ?(IZ(B) (?$B$m(B ?$B%m(B ?(I[(B) | |
| 55 (?$B$o(B ?$B%o(B ?(I\(B) (?$B$p(B ?$B%p(B "(I2(B") (?$B$q(B ?$B%q(B "(I4(B") (?$B$r(B ?$B%r(B ?(I&(B) | |
| 56 (?$B$s(B ?$B%s(B ?(I](B) | |
| 57 (?$B$,(B ?$B%,(B "(I6^(B") (?$B$.(B ?$B%.(B "(I7^(B") (?$B$0(B ?$B%0(B "(I8^(B") (?$B$2(B ?$B%2(B "(I9^(B") (?$B$4(B ?$B%4(B "(I:^(B") | |
| 58 (?$B$6(B ?$B%6(B "(I;^(B") (?$B$8(B ?$B%8(B "(I<^(B") (?$B$:(B ?$B%:(B "(I=^(B") (?$B$<(B ?$B%<(B "(I>^(B") (?$B$>(B ?$B%>(B "(I?^(B") | |
| 59 (?$B$@(B ?$B%@(B "(I@^(B") (?$B$B(B ?$B%B(B "(IA^(B") (?$B$E(B ?$B%E(B "(IB^(B") (?$B$G(B ?$B%G(B "(IC^(B") (?$B$I(B ?$B%I(B "(ID^(B") | |
| 60 (?$B$P(B ?$B%P(B "(IJ^(B") (?$B$S(B ?$B%S(B "(IK^(B") (?$B$V(B ?$B%V(B "(IL^(B") (?$B$Y(B ?$B%Y(B "(IM^(B") (?$B$\(B ?$B%\(B "(IN^(B") | |
| 61 (?$B$Q(B ?$B%Q(B "(IJ_(B") (?$B$T(B ?$B%T(B "(IK_(B") (?$B$W(B ?$B%W(B "(IL_(B") (?$B$Z(B ?$B%Z(B "(IM_(B") (?$B$](B ?$B%](B "(IN_(B") | |
| 62 (?$B$!(B ?$B%!(B ?(I'(B) (?$B$#(B ?$B%#(B ?(I((B) (?$B$%(B ?$B%%(B ?(I)(B) (?$B$'(B ?$B%'(B ?(I*(B) (?$B$)(B ?$B%)(B ?(I+(B) | |
| 63 (?$B$C(B ?$B%C(B ?(I/(B) | |
| 64 (?$B$c(B ?$B%c(B ?(I,(B) (?$B$e(B ?$B%e(B ?(I-(B) (?$B$g(B ?$B%g(B ?(I.(B) | |
| 65 (?$B$n(B ?$B%n(B "(I\(B") | |
| 66 ("$B$&!+(B" ?$B%t(B "(I3^(B") (nil ?$B%u(B "(I6(B") (nil ?$B%v(B "(I9(B")) | |
| 67 "Japanese JISX0208 Kana character table. | |
| 68 Each element is of the form (HIRAGANA KATAKANA HANKAKU-KATAKANA), where | |
| 69 HIRAGANA and KATAKANA belong to `japanese-jisx0208', | |
| 70 HANKAKU-KATAKANA belongs to `japanese-jisx0201-kana'.") | |
| 71 | |
| 72 ;; Put properties 'katakana, 'hiragana, and 'jix0201 to each Japanese | |
| 73 ;; kana characters for conversion among them. | |
| 74 (let ((l japanese-kana-table) | |
| 75 slot hiragana katakana jisx0201) | |
| 76 (while l | |
| 77 (setq slot (car l) | |
| 78 hiragana (car slot) katakana (nth 1 slot) jisx0201 (nth 2 slot) | |
| 79 l (cdr l)) | |
| 80 (if hiragana | |
| 81 (if (stringp hiragana) | |
| 82 (if (> (length hiragana) 1) | |
| 83 (let ((hira (aref hiragana 0))) | |
| 84 (put-char-code-property | |
| 85 hira 'kana-composition | |
| 86 (cons (cons (aref hiragana 1) katakana) | |
| 87 (get-char-code-property hira 'kana-composition))))) | |
| 88 (put-char-code-property hiragana 'katakana katakana) | |
| 89 (put-char-code-property hiragana 'jisx0201 jisx0201))) | |
| 952 | 90 (when (characterp katakana) |
| 771 | 91 (put-char-code-property katakana 'hiragana hiragana) |
| 92 (put-char-code-property katakana 'jisx0201 jisx0201)) | |
| 93 (if jisx0201 | |
| 94 (if (stringp jisx0201) | |
| 95 (if (> (length jisx0201) 1) | |
| 96 (let ((kana (aref jisx0201 0))) | |
| 97 (put-char-code-property | |
| 98 kana 'kana-composition | |
| 99 (cons (cons (aref jisx0201 1) katakana) | |
| 100 (get-char-code-property kana 'kana-composition))))) | |
| 101 (put-char-code-property jisx0201 'hiragana hiragana) | |
| 102 (put-char-code-property jisx0201 'katakana katakana) | |
| 103 (put-char-code-property jisx0201 'jisx0208 katakana))))) | |
| 104 | |
| 105 (defconst japanese-symbol-table | |
| 106 '((?\$B!!(B ?\ ) (?$B!$(B ?, ?(I$(B) (?$B!%(B ?. ?(I!(B) (?$B!"(B ?, ?(I$(B) (?$B!#(B ?. ?(I!(B) (?$B!&(B nil ?(I%(B) | |
| 107 (?$B!'(B ?:) (?$B!((B ?\;) (?$B!)(B ??) (?$B!*(B ?!) (?$B!+(B nil ?(I^(B) (?$B!,(B nil ?(I_(B) | |
| 778 | 108 (?$B!-(B ?') (?$B!.(B ?`) (?$B!0(B ?^) (?$B!2(B ?_) (?$B!<(B ?- ?(I0(B) (?$B!=(B ?-) (?$B!>(B ?-) |
| 771 | 109 (?$B!?(B ?/) (?$B!@(B ?\\) (?$B!A(B ?~) (?$B!C(B ?|) (?$B!F(B ?`) (?$B!G(B ?') (?$B!H(B ?\") (?$B!I(B ?\") |
| 110 (?\$B!J(B ?\() (?\$B!K(B ?\)) (?\$B!N(B ?[) (?\$B!O(B ?]) (?\$B!P(B ?{) (?\$B!Q(B ?}) | |
| 111 (?$B!R(B ?<) (?$B!S(B ?>) (?$B!\(B ?+) (?$B!](B ?-) (?$B!a(B ?=) (?$B!c(B ?<) (?$B!d(B ?>) | |
| 112 (?$B!l(B ?') (?$B!m(B ?\") (?$B!o(B ?\\) (?$B!p(B ?$) (?$B!s(B ?%) (?$B!t(B ?#) (?$B!u(B ?&) (?$B!v(B ?*) | |
| 113 (?$B!w(B ?@)) | |
| 114 "Japanese JISX0208 symbol character table. | |
| 115 Each element is of the form (SYMBOL ASCII HANKAKU), where SYMBOL | |
| 116 belongs to `japanese-jisx0208', ASCII belongs to `ascii', and HANKAKU | |
| 117 belongs to `japanese-jisx0201-kana'.") | |
| 118 | |
| 119 ;; Put properties 'jisx0208, 'jisx0201, and 'ascii to each Japanese | |
| 120 ;; symbol and ASCII characters for conversion among them. | |
| 121 (let ((l japanese-symbol-table) | |
| 122 slot jisx0208 ascii jisx0201) | |
| 123 (while l | |
| 124 (setq slot (car l) | |
| 125 jisx0208 (car slot) ascii (nth 1 slot) jisx0201 (nth 2 slot) | |
| 126 l (cdr l)) | |
| 127 (if ascii | |
| 128 (progn | |
| 129 (put-char-code-property jisx0208 'ascii ascii) | |
| 130 (put-char-code-property ascii 'jisx0208 jisx0208))) | |
| 131 (if jisx0201 | |
| 132 (progn | |
| 133 (put-char-code-property jisx0208 'jisx0201 jisx0201) | |
| 134 (put-char-code-property jisx0201 'jisx0208 jisx0208))))) | |
| 135 | |
| 136 (defconst japanese-alpha-numeric-table | |
| 137 '((?$B#0(B . ?0) (?$B#1(B . ?1) (?$B#2(B . ?2) (?$B#3(B . ?3) (?$B#4(B . ?4) | |
| 138 (?$B#5(B . ?5) (?$B#6(B . ?6) (?$B#7(B . ?7) (?$B#8(B . ?8) (?$B#9(B . ?9) | |
| 139 (?$B#A(B . ?A) (?$B#B(B . ?B) (?$B#C(B . ?C) (?$B#D(B . ?D) (?$B#E(B . ?E) | |
| 140 (?$B#F(B . ?F) (?$B#G(B . ?G) (?$B#H(B . ?H) (?$B#I(B . ?I) (?$B#J(B . ?J) | |
| 141 (?$B#K(B . ?K) (?$B#L(B . ?L) (?$B#M(B . ?M) (?$B#N(B . ?N) (?$B#O(B . ?O) | |
| 142 (?$B#P(B . ?P) (?$B#Q(B . ?Q) (?$B#R(B . ?R) (?$B#S(B . ?S) (?$B#T(B . ?T) | |
| 143 (?$B#U(B . ?U) (?$B#V(B . ?V) (?$B#W(B . ?W) (?$B#X(B . ?X) (?$B#Y(B . ?Y) (?$B#Z(B . ?Z) | |
| 144 (?$B#a(B . ?a) (?$B#b(B . ?b) (?$B#c(B . ?c) (?$B#d(B . ?d) (?$B#e(B . ?e) | |
| 145 (?$B#f(B . ?f) (?$B#g(B . ?g) (?$B#h(B . ?h) (?$B#i(B . ?i) (?$B#j(B . ?j) | |
| 146 (?$B#k(B . ?k) (?$B#l(B . ?l) (?$B#m(B . ?m) (?$B#n(B . ?n) (?$B#o(B . ?o) | |
| 147 (?$B#p(B . ?p) (?$B#q(B . ?q) (?$B#r(B . ?r) (?$B#s(B . ?s) (?$B#t(B . ?t) | |
| 148 (?$B#u(B . ?u) (?$B#v(B . ?v) (?$B#w(B . ?w) (?$B#x(B . ?x) (?$B#y(B . ?y) (?$B#z(B . ?z)) | |
| 149 "Japanese JISX0208 alpha numeric character table. | |
| 150 Each element is of the form (ALPHA-NUMERIC ASCII), where ALPHA-NUMERIC | |
| 151 belongs to `japanese-jisx0208', ASCII belongs to `ascii'.") | |
| 152 | |
| 153 ;; Put properties 'jisx0208 and 'ascii to each Japanese alpha numeric | |
| 154 ;; and ASCII characters for conversion between them. | |
| 155 (let ((l japanese-alpha-numeric-table) | |
| 156 slot jisx0208 ascii) | |
| 157 (while l | |
| 158 (setq slot (car l) | |
| 159 jisx0208 (car slot) ascii (cdr slot) | |
| 160 l (cdr l)) | |
| 161 (put-char-code-property jisx0208 'ascii ascii) | |
| 162 (put-char-code-property ascii 'jisx0208 jisx0208))) | |
| 163 | |
| 164 ;; Convert string STR by FUNC and return a resulting string. | |
| 165 (defun japanese-string-conversion (str func &rest args) | |
| 166 (let ((buf (get-buffer-create " *Japanese work*"))) | |
| 167 (save-excursion | |
| 168 (set-buffer buf) | |
| 169 (erase-buffer) | |
| 170 (insert str) | |
| 171 (apply func 1 (point) args) | |
| 172 (buffer-string)))) | |
| 173 | |
| 174 ;;;###autoload | |
| 175 (defun japanese-katakana (obj &optional hankaku) | |
| 176 "Convert argument to Katakana and return that. | |
| 177 The argument may be a character or string. The result has the same type. | |
| 178 The argument object is not altered--the value is a copy. | |
| 179 Optional argument HANKAKU t means to convert to `hankaku' Katakana | |
| 180 \(`japanese-jisx0201-kana'), in which case return value | |
| 181 may be a string even if OBJ is a character if two Katakanas are | |
| 182 necessary to represent OBJ." | |
| 183 (if (stringp obj) | |
| 184 (japanese-string-conversion obj 'japanese-katakana-region hankaku) | |
| 185 (or (get-char-code-property obj (if hankaku 'jisx0201 'katakana)) | |
| 186 obj))) | |
| 187 | |
| 188 ;;;###autoload | |
| 189 (defun japanese-hiragana (obj) | |
| 190 "Convert argument to Hiragana and return that. | |
| 191 The argument may be a character or string. The result has the same type. | |
| 192 The argument object is not altered--the value is a copy." | |
| 193 (if (stringp obj) | |
| 194 (japanese-string-conversion obj 'japanese-hiragana-region) | |
| 195 (or (get-char-code-property obj 'hiragana) | |
| 196 obj))) | |
| 197 | |
| 198 ;;;###autoload | |
| 199 (defun japanese-hankaku (obj &optional ascii-only) | |
| 200 "Convert argument to `hankaku' and return that. | |
| 201 The argument may be a character or string. The result has the same type. | |
| 202 The argument object is not altered--the value is a copy. | |
| 203 Optional argument ASCII-ONLY non-nil means to return only ASCII character." | |
| 204 (if (stringp obj) | |
| 205 (japanese-string-conversion obj 'japanese-hankaku-region ascii-only) | |
| 778 | 206 (or (and (not ascii-only) |
| 771 | 207 (get-char-code-property obj 'jisx0201)) |
| 778 | 208 (get-char-code-property obj 'ascii) |
| 771 | 209 obj))) |
| 210 | |
| 211 ;;;###autoload | |
| 212 (defun japanese-zenkaku (obj) | |
| 213 "Convert argument to `zenkaku' and return that. | |
| 214 The argument may be a character or string. The result has the same type. | |
| 215 The argument object is not altered--the value is a copy." | |
| 216 (if (stringp obj) | |
| 217 (japanese-string-conversion obj 'japanese-zenkaku-region) | |
| 218 (or (get-char-code-property obj 'jisx0208) | |
| 219 obj))) | |
| 220 | |
| 221 (defun japanese-replace-region (from to string) | |
| 222 "Replace the region specified by FROM and TO to STRING." | |
| 223 (goto-char from) | |
| 224 (insert string) | |
| 225 (delete-char (- to from))) | |
| 226 | |
| 227 ;;;###autoload | |
| 228 (defun japanese-katakana-region (from to &optional hankaku) | |
| 229 "Convert Japanese `hiragana' chars in the region to `katakana' chars. | |
| 230 Optional argument HANKAKU t means to convert to `hankaku katakana' character | |
| 231 of which charset is `japanese-jisx0201-kana'." | |
| 232 (interactive "r\nP") | |
| 233 (save-restriction | |
| 234 (narrow-to-region from to) | |
| 235 (save-excursion | |
| 236 (goto-char (point-min)) | |
| 237 (while (re-search-forward "\\cH\\|\\cK" nil t) | |
| 238 (let* ((kana (preceding-char)) | |
| 239 (composition | |
| 240 (and (not hankaku) | |
| 241 (get-char-code-property kana 'kana-composition))) | |
| 776 | 242 slot) |
| 771 | 243 (if (and composition (setq slot (assq (following-char) composition))) |
| 244 (japanese-replace-region (match-beginning 0) (1+ (point)) | |
| 245 (cdr slot)) | |
| 246 (let ((kata (get-char-code-property | |
| 247 kana (if hankaku 'jisx0201 'katakana)))) | |
| 248 (if kata | |
| 249 (japanese-replace-region (match-beginning 0) (point) | |
| 250 kata))))))))) | |
| 251 | |
| 252 | |
| 253 ;;;###autoload | |
| 254 (defun japanese-hiragana-region (from to) | |
| 255 "Convert Japanese `katakana' chars in the region to `hiragana' chars." | |
| 256 (interactive "r") | |
| 257 (save-restriction | |
| 258 (narrow-to-region from to) | |
| 259 (save-excursion | |
| 260 (goto-char (point-min)) | |
| 261 (while (re-search-forward "\\cK\\|\\ck" nil t) | |
| 262 (let* ((kata (preceding-char)) | |
| 263 (composition (get-char-code-property kata 'kana-composition)) | |
| 776 | 264 slot) |
| 771 | 265 (if (and composition (setq slot (assq (following-char) composition))) |
| 266 (japanese-replace-region (match-beginning 0) (1+ (point)) | |
| 267 (get-char-code-property | |
| 268 (cdr slot) 'hiragana)) | |
| 269 (let ((hira (get-char-code-property kata 'hiragana))) | |
| 270 (if hira | |
| 271 (japanese-replace-region (match-beginning 0) (point) | |
| 272 hira))))))))) | |
| 273 | |
| 274 ;;;###autoload | |
| 275 (defun japanese-hankaku-region (from to &optional ascii-only) | |
| 276 "Convert Japanese `zenkaku' chars in the region to `hankaku' chars. | |
| 277 `Zenkaku' chars belong to `japanese-jisx0208' | |
| 278 `Hankaku' chars belong to `ascii' or `japanese-jisx0201-kana'. | |
| 279 Optional argument ASCII-ONLY non-nil means to convert only to ASCII char." | |
| 280 (interactive "r\nP") | |
| 281 (save-restriction | |
| 282 (narrow-to-region from to) | |
| 283 (save-excursion | |
| 284 (goto-char (point-min)) | |
| 285 (while (re-search-forward "\\cj" nil t) | |
| 286 (let* ((zenkaku (preceding-char)) | |
| 778 | 287 (hankaku (or (and (not ascii-only) |
| 288 (get-char-code-property zenkaku 'jisx0201)) | |
| 289 (get-char-code-property zenkaku 'ascii)))) | |
| 771 | 290 (if hankaku |
| 291 (japanese-replace-region (match-beginning 0) (match-end 0) | |
| 292 hankaku))))))) | |
| 293 | |
| 294 ;;;###autoload | |
| 295 (defun japanese-zenkaku-region (from to &optional katakana-only) | |
| 296 "Convert hankaku' chars in the region to Japanese `zenkaku' chars. | |
| 297 `Zenkaku' chars belong to `japanese-jisx0208' | |
| 298 `Hankaku' chars belong to `ascii' or `japanese-jisx0201-kana'. | |
| 299 Optional argument KATAKANA-ONLY non-nil means to convert only KATAKANA char." | |
| 300 (interactive "r\nP") | |
| 301 (save-restriction | |
| 302 (narrow-to-region from to) | |
| 303 (save-excursion | |
| 304 (goto-char (point-min)) | |
| 305 (while (or (and katakana-only | |
| 306 (re-search-forward "\\ck" nil t)) | |
| 307 (and (not katakana-only) | |
| 308 (re-search-forward "\\ca\\|\\ck" nil t))) | |
| 309 (let* ((hankaku (preceding-char)) | |
| 310 (composition (get-char-code-property hankaku 'kana-composition)) | |
| 776 | 311 slot) |
| 771 | 312 (if (and composition (setq slot (assq (following-char) composition))) |
| 313 (japanese-replace-region (match-beginning 0) (1+ (point)) | |
| 314 (cdr slot)) | |
| 315 (let ((zenkaku (japanese-zenkaku hankaku))) | |
| 316 (if zenkaku | |
| 317 (japanese-replace-region (match-beginning 0) (match-end 0) | |
| 318 zenkaku))))))))) | |
| 319 | |
| 320 ;;;###autoload | |
| 321 (defun read-hiragana-string (prompt &optional initial-input) | |
| 322 "Read a Hiragana string from the minibuffer, prompting with string PROMPT. | |
| 323 If non-nil, second arg INITIAL-INPUT is a string to insert before reading." | |
| 324 (read-multilingual-string prompt initial-input "japanese-hiragana")) | |
| 325 | |
| 326 ;; | |
| 327 (provide 'japan-util) | |
| 328 | |
| 329 ;;; japan-util.el ends here |