Mercurial > emacs

comparison lisp/language/japan-util.el @ 22776:1e2bf1acab23

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(japanese-replace-region): New function. (japanese-katakana-region, japanese-hiragana-region, japanese-hankaku-region, japanese-zenkaku-region): Don't change point. Use japanese-replace-region to change text.
author Kenichi Handa <handa@m17n.org>
date Sun, 19 Jul 1998 05:17:35 +0000
parents b054cd9f66df
children 708271862495
comparison
equal deleted inserted replaced
22775:ede5d8c1f929 22776:1e2bf1acab23
80 (if hiragana 80 (if hiragana
81 (if (stringp hiragana) 81 (if (stringp hiragana)
82 (if (> (length hiragana) 1) 82 (if (> (length hiragana) 1)
83 (let ((hira (aref hiragana 0))) 83 (let ((hira (aref hiragana 0)))
84 (put-char-code-property 84 (put-char-code-property
85 hira 'composition 85 hira 'kana-composition
86 (cons (cons (aref hiragana 1) katakana) 86 (cons (cons (aref hiragana 1) katakana)
87 (get-char-code-property hira 'composition))))) 87 (get-char-code-property hira 'kana-composition)))))
88 (put-char-code-property hiragana 'katakana katakana) 88 (put-char-code-property hiragana 'katakana katakana)
89 (put-char-code-property hiragana 'jisx0201 jisx0201))) 89 (put-char-code-property hiragana 'jisx0201 jisx0201)))
90 (when (integerp katakana) 90 (when (integerp katakana)
91 (put-char-code-property katakana 'hiragana hiragana) 91 (put-char-code-property katakana 'hiragana hiragana)
92 (put-char-code-property katakana 'jisx0201 jisx0201)) 92 (put-char-code-property katakana 'jisx0201 jisx0201))
93 (if jisx0201 93 (if jisx0201
94 (if (stringp jisx0201) 94 (if (stringp jisx0201)
95 (if (> (length jisx0201) 1) 95 (if (> (length jisx0201) 1)
96 (let ((kana (aref jisx0201 0))) 96 (let ((kana (aref jisx0201 0)))
97 (put-char-code-property 97 (put-char-code-property
98 kana 'composition 98 kana 'kana-composition
99 (cons (cons (aref jisx0201 1) katakana) 99 (cons (cons (aref jisx0201 1) katakana)
100 (get-char-code-property kana 'composition))))) 100 (get-char-code-property kana 'kana-composition)))))
101 (put-char-code-property jisx0201 'hiragana hiragana) 101 (put-char-code-property jisx0201 'hiragana hiragana)
102 (put-char-code-property jisx0201 'katakana katakana) 102 (put-char-code-property jisx0201 'katakana katakana)
103 (put-char-code-property jisx0201 'jisx0208 katakana))))) 103 (put-char-code-property jisx0201 'jisx0208 katakana)))))
104 104
105 (defconst japanese-symbol-table 105 (defconst japanese-symbol-table
216 (if (stringp obj) 216 (if (stringp obj)
217 (japanese-string-conversion obj 'japanese-zenkaku-region) 217 (japanese-string-conversion obj 'japanese-zenkaku-region)
218 (or (get-char-code-property obj 'jisx0208) 218 (or (get-char-code-property obj 'jisx0208)
219 obj))) 219 obj)))
220 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
221 ;;;###autoload 227 ;;;###autoload
222 (defun japanese-katakana-region (from to &optional hankaku) 228 (defun japanese-katakana-region (from to &optional hankaku)
223 "Convert Japanese `hiragana' chars in the region to `katakana' chars. 229 "Convert Japanese `hiragana' chars in the region to `katakana' chars.
224 Optional argument HANKAKU t means to convert to `hankaku katakana' character 230 Optional argument HANKAKU t means to convert to `hankaku katakana' character
225 of which charset is `japanese-jisx0201-kana'." 231 of which charset is `japanese-jisx0201-kana'."
226 (interactive "r\nP") 232 (interactive "r\nP")
227 (save-restriction 233 (save-restriction
228 (narrow-to-region from to) 234 (narrow-to-region from to)
229 (goto-char (point-min)) 235 (save-excursion
230 (while (re-search-forward "\\cH\\|\\cK" nil t) 236 (goto-char (point-min))
231 (let* ((kana (preceding-char)) 237 (while (re-search-forward "\\cH\\|\\cK" nil t)
232 (composition (get-char-code-property kana 'composition)) 238 (let* ((kana (preceding-char))
233 next slot) 239 (composition (get-char-code-property kana 'kana-composition))
234 (if (and composition (setq slot (assq (following-char) composition))) 240 next slot)
235 (progn 241 (if (and composition (setq slot (assq (following-char) composition)))
236 (delete-region (match-beginning 0) (1+ (point))) 242 (japanese-replace-region (match-beginning 0) (1+ (point))
237 (insert (cdr slot))) 243 (cdr slot))
238 (let ((kata (get-char-code-property 244 (let ((kata (get-char-code-property
239 kana (if hankaku 'jisx0201 'katakana)))) 245 kana (if hankaku 'jisx0201 'katakana))))
240 (if kata 246 (if kata
241 (progn 247 (japanese-replace-region (match-beginning 0) (point)
242 (delete-region (match-beginning 0) (match-end 0)) 248 kata)))))))))
243 (insert kata))))))))) 249
244 250
245 ;;;###autoload 251 ;;;###autoload
246 (defun japanese-hiragana-region (from to) 252 (defun japanese-hiragana-region (from to)
247 "Convert Japanese `katakana' chars in the region to `hiragana' chars." 253 "Convert Japanese `katakana' chars in the region to `hiragana' chars."
248 (interactive "r") 254 (interactive "r")
249 (save-restriction 255 (save-restriction
250 (narrow-to-region from to) 256 (narrow-to-region from to)
251 (goto-char (point-min)) 257 (save-excursion
252 (while (re-search-forward "\\cK\\|\\ck" nil t) 258 (goto-char (point-min))
253 (let* ((kata (preceding-char)) 259 (while (re-search-forward "\\cK\\|\\ck" nil t)
254 (composition (get-char-code-property kata 'composition)) 260 (let* ((kata (preceding-char))
255 next slot) 261 (composition (get-char-code-property kata 'kana-composition))
256 (if (and composition (setq slot (assq (following-char) composition))) 262 next slot)
257 (progn 263 (if (and composition (setq slot (assq (following-char) composition)))
258 (delete-region (match-beginning 0) (1+ (point))) 264 (japanese-replace-region (match-beginning 0) (1+ (point))
259 (insert (get-char-code-property (cdr slot) 'hiragana))) 265 (get-char-code-property
260 (let ((hira (get-char-code-property kata 'hiragana))) 266 (cdr slot) 'hiragana))
261 (if hira 267 (let ((hira (get-char-code-property kata 'hiragana)))
262 (progn 268 (if hira
263 (delete-region (match-beginning 0) (match-end 0)) 269 (japanese-replace-region (match-beginning 0) (point)
264 (insert hira))))))))) 270 hira)))))))))
265 271
266 ;;;###autoload 272 ;;;###autoload
267 (defun japanese-hankaku-region (from to &optional ascii-only) 273 (defun japanese-hankaku-region (from to &optional ascii-only)
268 "Convert Japanese `zenkaku' chars in the region to `hankaku' chars. 274 "Convert Japanese `zenkaku' chars in the region to `hankaku' chars.
269 `Zenkaku' chars belong to `japanese-jisx0208' 275 `Zenkaku' chars belong to `japanese-jisx0208'
270 `Hankaku' chars belong to `ascii' or `japanese-jisx0201-kana'. 276 `Hankaku' chars belong to `ascii' or `japanese-jisx0201-kana'.
271 Optional argument ASCII-ONLY non-nil means to convert only to ASCII char." 277 Optional argument ASCII-ONLY non-nil means to convert only to ASCII char."
272 (interactive "r\nP") 278 (interactive "r\nP")
273 (save-restriction 279 (save-restriction
274 (narrow-to-region from to) 280 (narrow-to-region from to)
275 (goto-char (point-min)) 281 (save-excursion
276 (while (re-search-forward "\\cj" nil t) 282 (goto-char (point-min))
277 (let* ((zenkaku (preceding-char)) 283 (while (re-search-forward "\\cj" nil t)
278 (hankaku (or (get-char-code-property zenkaku 'ascii) 284 (let* ((zenkaku (preceding-char))
279 (and (not ascii-only) 285 (hankaku (or (get-char-code-property zenkaku 'ascii)
280 (get-char-code-property zenkaku 'jisx0201))))) 286 (and (not ascii-only)
281 (if hankaku 287 (get-char-code-property zenkaku 'jisx0201)))))
282 (progn 288 (if hankaku
283 (delete-region (match-beginning 0) (match-end 0)) 289 (japanese-replace-region (match-beginning 0) (match-end 0)
284 (insert hankaku))))))) 290 hankaku)))))))
285 291
286 ;;;###autoload 292 ;;;###autoload
287 (defun japanese-zenkaku-region (from to) 293 (defun japanese-zenkaku-region (from to)
288 "Convert hankaku' chars in the region to Japanese `zenkaku' chars. 294 "Convert hankaku' chars in the region to Japanese `zenkaku' chars.
289 `Zenkaku' chars belong to `japanese-jisx0208' 295 `Zenkaku' chars belong to `japanese-jisx0208'
290 `Hankaku' chars belong to `ascii' or `japanese-jisx0201-kana'." 296 `Hankaku' chars belong to `ascii' or `japanese-jisx0201-kana'."
291 (interactive "r") 297 (interactive "r")
292 (save-restriction 298 (save-restriction
293 (narrow-to-region from to) 299 (narrow-to-region from to)
294 (goto-char (point-min)) 300 (save-excursion
295 (while (re-search-forward "\\ca\\|\\ck" nil t) 301 (goto-char (point-min))
296 (let* ((hankaku (preceding-char)) 302 (while (re-search-forward "\\ca\\|\\ck" nil t)
297 (composition (get-char-code-property hankaku 'composition)) 303 (let* ((hankaku (preceding-char))
298 next slot) 304 (composition (get-char-code-property hankaku 'kana-composition))
299 (if (and composition (setq slot (assq (following-char) composition))) 305 next slot)
300 (progn 306 (if (and composition (setq slot (assq (following-char) composition)))
301 (delete-region (match-beginning 0) (1+ (point))) 307 (japanese-replace-region (match-beginning 0) (1+ (point))
302 (insert (cdr slot))) 308 (cdr slot))
303 (let ((zenkaku (japanese-zenkaku hankaku))) 309 (let ((zenkaku (japanese-zenkaku hankaku)))
304 (if zenkaku 310 (if zenkaku
305 (progn 311 (japanese-replace-region (match-beginning 0) (match-end 0)
306 (delete-region (match-beginning 0) (match-end 0)) 312 zenkaku)))))))))
307 (insert zenkaku)))))))))
308 313
309 ;;;###autoload 314 ;;;###autoload
310 (defun read-hiragana-string (prompt &optional initial-input) 315 (defun read-hiragana-string (prompt &optional initial-input)
311 "Read a Hiragana string from the minibuffer, prompting with string PROMPT. 316 "Read a Hiragana string from the minibuffer, prompting with string PROMPT.
312 If non-nil, second arg INITIAL-INPUT is a string to insert before reading." 317 If non-nil, second arg INITIAL-INPUT is a string to insert before reading."