ideo-trans.el

   1 ;;; ideo-trans.el --- Translation utility for Ideographic Strings
   2
   3 ;; Copyright (C) 2003,2004 MORIOKA Tomohiko
   4
   5 ;; Author: MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
   6 ;; Keywords: Ideographs, Character Database, Chaon, CHISE
   7
   8 ;; This file is a part of tomoyo-tools.
   9
  10 ;; This program is free software; you can redistribute it and/or
  11 ;; modify it under the terms of the GNU General Public License as
  12 ;; published by the Free Software Foundation; either version 2, or (at
  13 ;; your option) any later version.
  14
  15 ;; This program is distributed in the hope that it will be useful, but
  16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  18 ;; General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with this program; see the file COPYING.  If not, write to
  22 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24
  25 ;;; Code:
  26
  27 ;;;###autoload
  28 (defun ideo-translate-string-into-simplified-chinese (string)
  29   "Simplify Chinese traditional characters in STRING."
  30   (let (uchr ret)
  31     (mapconcat
  32      (lambda (chr)
  33        (setq uchr
  34              (cond ((setq ret (char-feature chr '=>ucs@gb))
  35                     (setq chr (decode-char '=ucs@gb ret)))
  36                    ((setq ret (char-ucs chr))
  37                     (setq chr (decode-char '=ucs@gb ret))
  38                     (if (setq ret (get-char-attribute chr '=>ucs*))
  39                         (decode-char '=ucs@gb ret)
  40                       chr))
  41                    (t chr)))
  42        (char-to-string
  43         (if (setq ret (encode-char uchr 'chinese-gb12345))
  44             (decode-char 'chinese-gb2312 ret)
  45           chr)))
  46      string "")))
  47
  48 ;;;###autoload
  49 (define-obsolete-function-alias 'ideo-trans-simplify-chinese-string
  50   'ideo-translate-string-into-simplified-chinese)
  51
  52 ;;;###autoload
  53 (defun ideo-translate-string-into-simplified-japanese (string)
  54   "Simplify traditional Kanji characters in STRING."
  55   (let (uchr ret)
  56     (mapconcat
  57      (lambda (chr)
  58        (setq ret (or (char-feature chr '->simplified@JP/Jouyou)
  59                      (char-feature chr '->simplified@JP)
  60                      (char-feature chr '->simplified)))
  61        (char-to-string
  62         (cond ((car ret))
  63               ((setq ret (char-feature chr '=>ucs@jis))
  64                (decode-char '=ucs@jis ret))
  65               ((setq ret (char-ucs chr))
  66                (decode-char '=ucs@jp ret))
  67               (t chr))))
  68      string "")))
  69
  70 ;;;###autoload
  71 (defun ideo-translate-region-into-traditional (start end)
  72   (interactive "r")
  73   (save-excursion
  74     (save-restriction
  75       (narrow-to-region start end)
  76       (goto-char start)
  77       (let (chr ret rret i prompt)
  78         (while (and (skip-chars-forward "\x00-\xFF")
  79                     (not (eobp)))
  80           (setq chr (char-after))
  81           (if (setq ret (or (get-char-attribute chr '<-simplified@JP/Jouyou)
  82                             (get-char-attribute chr '<-simplified@jp-jouyou)
  83                             (get-char-attribute chr '<-simplified@JP)
  84                             (get-char-attribute chr '<-simplified@jp)
  85                             (get-char-attribute chr '<-jp-simplified)
  86                             (get-char-attribute chr '<-simplified)))
  87               (progn
  88                 (if (cdr ret)
  89                     (progn
  90                       (setq i 0)
  91                       (setq prompt
  92                             (concat
  93                              (mapconcat (lambda (cell)
  94                                           (setq i (1+ i))
  95                                           (format "%d. %c" i cell))
  96                                         ret " ")
  97                              " : "))
  98                       (while (and (setq rret
  99                                         (string-to-int
 100                                          (read-string prompt)))
 101                                   (not (and (< 0 rret)
 102                                             (<=  rret (length ret))))))
 103                       (delete-char)
 104                       (insert (nth (1- rret) ret)))
 105                   (delete-char)
 106                   (insert (car ret))))
 107             (or (eobp)
 108                 (forward-char))))))))
 109
 110
 111 ;;; @ End.
 112 ;;;
 113
 114 (provide 'ideo-trans)
 115
 116 ;;; ideo-trans.el ends here