ids-read.el

   1 ;;; ids-read.el --- Reader for IDS-* files
   2
   3 ;; Copyright (C) 2002 MORIOKA Tomohiko
   4
   5 ;; Author: MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
   6 ;; Keywords: IDS, IDC, Ideographs, UCS, Unicode
   7
   8 ;; This file is a part of IDS.
   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 (require 'ids)
  28
  29 ;;;###autoload
  30 (defun ids-read-buffer (buffer &optional simplify soft)
  31   (interactive "bBuffer = \nP")
  32   (save-excursion
  33     (set-buffer buffer)
  34     (goto-char (point-min))
  35     (let (line chs ids code char structure)
  36       (while (not (eobp))
  37         (unless (looking-at ";")
  38           (setq line
  39                 (split-string
  40                  (buffer-substring (point-at-bol)(point-at-eol))
  41                  "\t"))
  42           (setq chs (car line)
  43                 ids (nth 2 line))
  44           (setq char
  45                 (cond
  46                  ((string-match "U[-+]\\([0-9A-F]+\\)" chs)
  47                   (decode-char 'ucs
  48                                (string-to-int (match-string 1 chs) 16)))
  49                  ((string-match "J90-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\)"
  50                                 chs)
  51                   (decode-char 'japanese-jisx0208-1990
  52                                (string-to-int (match-string 1 chs) 16)))
  53                  ((string-match "M-\\([0-9]+\\)'" chs)
  54                   (setq code (string-to-int (match-string 1 chs)))
  55                   (map-char-attribute
  56                    (lambda (key val)
  57                      (if (and (eq (car val) code)
  58                               (eq (nth 1 val) 1)
  59                               (null (nthcdr 2 val)))
  60                          key))
  61                    'morohashi-daikanwa))
  62                  ((string-match "M-\\([0-9]+\\)\"" chs)
  63                   (setq code (string-to-int (match-string 1 chs)))
  64                   (map-char-attribute
  65                    (lambda (key val)
  66                      (if (and (eq (car val) code)
  67                               (eq (nth 1 val) 2)
  68                               (null (nthcdr 2 val)))
  69                          key))
  70                    'morohashi-daikanwa))
  71                  ((string-match "M-\\([0-9]+\\)" chs)
  72                   (decode-char 'ideograph-daikanwa
  73                                (string-to-int (match-string 1 chs))))
  74                  ((string-match "MH-\\([0-9]+\\)" chs)
  75                   (setq code (string-to-int (match-string 1 chs)))
  76                   (map-char-attribute
  77                    (lambda (key val)
  78                      (if (and (eq (car val) 'ho)
  79                               (eq (nth 1 val) code)
  80                               (null (nthcdr 2 val)))
  81                          key))
  82                    'morohashi-daikanwa))
  83                  ((string-match "CB\\([0-9]+\\)" chs)
  84                   (decode-char 'ideograph-cbeta
  85                                (string-to-int (match-string 1 chs))))
  86                  ))
  87           (when (and char
  88                      (or (not soft)
  89                          (null
  90                           (get-char-attribute char 'ideographic-structure)))
  91                      (>= (length ids) 3)
  92                      (not (string-match "\\?" ids))
  93                      (consp (setq structure (ids-parse-string ids simplify))))
  94             (put-char-attribute char
  95                                 'ideographic-structure
  96                                 (cdr (car structure))))
  97           )
  98         (forward-line)
  99         ))))
 100
 101 ;;;###autoload
 102 (defun ids-read-file (file &optional simplify soft)
 103   (interactive "fIDS file = \nP")
 104   (with-temp-buffer
 105     (insert-file-contents file)
 106     (ids-read-buffer (current-buffer) simplify soft)))
 107
 108
 109 ;;; @ End.
 110 ;;;
 111
 112 (provide 'ids-read)
 113
 114 ;;; ids-read.el ends here