install-ids.el

   1 ;;; install-ids.el --- installer of IDS files.
   2
   3 ;;; Code:
   4
   5 (setq load-ids-simplify nil)
   6
   7 (defun install-ids-read-file (file simplify soft)
   8   (princ "Loading ")
   9   (princ file)
  10   (princ "...")
  11   (ids-read-file file simplify soft)
  12   (princ "done.\n"))
  13
  14
  15 ;; (mount-char-attribute-table 'ideographic-products)
  16 ;; (map-char-attribute
  17 ;;  (lambda (c v)
  18 ;;    (remove-char-attribute c 'ideographic-products)
  19 ;;    nil)
  20 ;;  'ideographic-products)
  21
  22
  23 (install-ids-read-file "IDS-JIS-X0208-1990.txt" load-ids-simplify t)
  24
  25 (install-ids-read-file "IDS-UCS-Basic.txt" load-ids-simplify t)
  26
  27 (install-ids-read-file "IDS-UCS-Ext-A.txt" load-ids-simplify t)
  28
  29 (let ((i 1))
  30   (while (<= i 6)
  31     (install-ids-read-file (format "IDS-UCS-Ext-B-%d.txt" i)
  32                            load-ids-simplify t)
  33     (setq i (1+ i))))
  34
  35 (install-ids-read-file "IDS-UCS-Ext-C.txt" load-ids-simplify t)
  36
  37 (install-ids-read-file "IDS-UCS-Ext-D.txt" load-ids-simplify t)
  38
  39 (install-ids-read-file "IDS-UCS-Ext-E.txt" load-ids-simplify t)
  40
  41 (install-ids-read-file "IDS-UCS-Ext-F.txt" load-ids-simplify t)
  42
  43 (install-ids-read-file "IDS-UCS-Ext-G.txt" load-ids-simplify t)
  44
  45 (install-ids-read-file "IDS-UCS-Compat.txt" load-ids-simplify t)
  46
  47 (let ((i 1))
  48   (while (<= i 3)
  49     (install-ids-read-file (format "IDS-CNS-%d.txt" i)
  50                            load-ids-simplify t)
  51     (setq i (1+ i))))
  52
  53 (let ((i 1))
  54   (while (<= i 12)
  55     (install-ids-read-file (format "IDS-Daikanwa-%02d.txt" i)
  56                            load-ids-simplify t)
  57     (setq i (1+ i))))
  58
  59 (install-ids-read-file "IDS-Daikanwa-dx.txt" load-ids-simplify t)
  60
  61 (install-ids-read-file "IDS-Daikanwa-ho.txt" load-ids-simplify t)
  62
  63 (install-ids-read-file "IDS-CBETA.txt" load-ids-simplify t)
  64
  65 (install-ids-read-file "IDS-CDP.txt" load-ids-simplify t)
  66 ;; (let ((i 1))
  67 ;;   (while (<= i 12)
  68 ;;     (install-ids-read-file (format "IDS-HZK%02d.txt" i)
  69 ;;                            load-ids-simplify t)
  70 ;;     (setq i (1+ i))))
  71
  72 (install-ids-read-file "IDS-SW-JIGUGE.txt" load-ids-simplify t)
  73
  74 (princ "Generating apparent-structure...")
  75 (let* ((terminal-coding-system 'utf-8-mcs-er)
  76        (feature-dir
  77         (expand-file-name
  78          "feature"
  79          (expand-file-name
  80           "character" chise-system-db-directory)))
  81        (p-file
  82         (expand-file-name "ideographic-products" feature-dir))
  83        old-p-file
  84        a-str ret)
  85   (when (file-exists-p p-file)
  86     (setq old-p-file (make-temp-name p-file))
  87     (rename-file p-file old-p-file))
  88   (ids-update-index 'in-memory)
  89
  90   (map-char-attribute
  91    (lambda (c v)
  92      (unless (equal (setq ret (ideographic-structure-compact v)) v)
  93        (princ (format "Compact %04X (%c) : %s -> %s\n"
  94                       (char-int c)
  95                       c
  96                       (ideographic-structure-to-ids v)
  97                       (ideographic-structure-to-ids ret)))
  98        (put-char-attribute c 'ideographic-structure ret)
  99        (setq v ret))
 100      (unless (setq a-str (get-char-attribute c 'ideographic-structure@apparent))
 101        (when (setq a-str (functional-ideographic-structure-to-apparent-structure v))
 102          (put-char-attribute c 'ideographic-structure@apparent
 103                              (ideographic-structure-compact a-str))))
 104      nil)
 105    'ideographic-structure)
 106
 107   (map-char-attribute
 108    (lambda (c v)
 109      (unless (equal (setq ret (ideographic-structure-compact v)) v)
 110        (princ (format "Compact %04X (%c) : [apparent] %s -> %s\n"
 111                       (char-int c)
 112                       c
 113                       (ideographic-structure-to-ids v)
 114                       (ideographic-structure-to-ids ret)))
 115        (put-char-attribute c 'ideographic-structure@apparent ret)
 116        (setq v ret))
 117      nil)
 118    'ideographic-structure@apparent)
 119
 120   (map-char-attribute
 121    (lambda (c v)
 122      (unless (equal (setq ret (ideographic-structure-compact v)) v)
 123        (princ (format "Compact %04X (%c) : %s -> %s\n"
 124                       (char-int c)
 125                       c
 126                       (ideographic-structure-to-ids v)
 127                       (ideographic-structure-to-ids ret)))
 128        (put-char-attribute c 'ideographic-structure ret)
 129        (setq v ret))
 130      nil)
 131    'ideographic-structure)
 132   (map-char-attribute
 133    (lambda (c v)
 134      (unless (equal (setq ret (ideographic-structure-compact v)) v)
 135        (princ (format "Compact %04X (%c) : [apparent] %s -> %s\n"
 136                       (char-int c)
 137                       c
 138                       (ideographic-structure-to-ids v)
 139                       (ideographic-structure-to-ids ret)))
 140        (put-char-attribute c 'ideographic-structure@apparent ret)
 141        (setq v ret))
 142      nil)
 143    'ideographic-structure@apparent)
 144   (princ "done.\n")
 145
 146   (princ "Updating char-feature `ideographic-structure'...")
 147   (save-char-attribute-table 'ideographic-structure)
 148   (save-char-attribute-table 'ideographic-structure@apparent)
 149   (princ "done.\n")
 150
 151   (princ "Updating char-feature `ideographic-products'...")
 152   (ids-update-index)
 153   (when old-p-file
 154     (delete-file old-p-file)))
 155 (princ "done.\n")
 156
 157 ;;; install-ids.el ends hear