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-Ext-H.txt" load-ids-simplify t)
  46
  47 (install-ids-read-file "IDS-UCS-Ext-I.txt" load-ids-simplify t)
  48
  49 (install-ids-read-file "IDS-UCS-Compat.txt" load-ids-simplify t)
  50
  51 (install-ids-read-file "IDS-UCS-Compat-Supplement.txt" load-ids-simplify t)
  52
  53 (let ((i 1))
  54   (while (<= i 3)
  55     (install-ids-read-file (format "IDS-CNS-%d.txt" i)
  56                            load-ids-simplify t)
  57     (setq i (1+ i))))
  58
  59 (let ((i 1))
  60   (while (<= i 12)
  61     (install-ids-read-file (format "IDS-Daikanwa-%02d.txt" i)
  62                            load-ids-simplify t)
  63     (setq i (1+ i))))
  64
  65 (install-ids-read-file "IDS-Daikanwa-dx.txt" load-ids-simplify t)
  66
  67 (install-ids-read-file "IDS-Daikanwa-ho.txt" load-ids-simplify t)
  68
  69 (install-ids-read-file "IDS-CBETA.txt" load-ids-simplify t)
  70
  71 (install-ids-read-file "IDS-CDP.txt" load-ids-simplify t)
  72 ;; (let ((i 1))
  73 ;;   (while (<= i 12)
  74 ;;     (install-ids-read-file (format "IDS-HZK%02d.txt" i)
  75 ;;                            load-ids-simplify t)
  76 ;;     (setq i (1+ i))))
  77
  78 (install-ids-read-file "IDS-SW-JIGUGE.txt" load-ids-simplify t)
  79
  80 (princ "Generating apparent-structure...")
  81 (let* ((terminal-coding-system 'utf-8-mcs-er)
  82        (feature-dir
  83         (expand-file-name
  84          "feature"
  85          (expand-file-name
  86           "character" chise-system-db-directory)))
  87        (p-file
  88         (expand-file-name "ideographic-products" feature-dir))
  89        old-p-file
  90        a-str ret)
  91   (when (file-exists-p p-file)
  92     (setq old-p-file (make-temp-name p-file))
  93     (rename-file p-file old-p-file))
  94   (ids-update-index 'in-memory)
  95
  96   (map-char-attribute
  97    (lambda (c v)
  98      (unless (equal (setq ret (ideographic-structure-compact v)) v)
  99        (princ (format "Compact %04X (%c) : %s -> %s\n"
 100                       (char-int c)
 101                       c
 102                       (ideographic-structure-to-ids v)
 103                       (ideographic-structure-to-ids ret)))
 104        (put-char-attribute c 'ideographic-structure ret)
 105        (setq v ret))
 106      (unless (setq a-str (get-char-attribute c 'ideographic-structure@apparent))
 107        (when (setq a-str (functional-ideographic-structure-to-apparent-structure v))
 108          (put-char-attribute c 'ideographic-structure@apparent
 109                              (ideographic-structure-compact a-str))))
 110      nil)
 111    'ideographic-structure)
 112
 113   (map-char-attribute
 114    (lambda (c v)
 115      (unless (equal (setq ret (ideographic-structure-compact v)) v)
 116        (princ (format "Compact %04X (%c) : [apparent] %s -> %s\n"
 117                       (char-int c)
 118                       c
 119                       (ideographic-structure-to-ids v)
 120                       (ideographic-structure-to-ids ret)))
 121        (put-char-attribute c 'ideographic-structure@apparent ret)
 122        (setq v ret))
 123      nil)
 124    'ideographic-structure@apparent)
 125
 126   (map-char-attribute
 127    (lambda (c v)
 128      (unless (equal (setq ret (ideographic-structure-compact v)) v)
 129        (princ (format "Compact %04X (%c) : [apparent/leftmost] %s -> %s\n"
 130                       (char-int c)
 131                       c
 132                       (ideographic-structure-to-ids v)
 133                       (ideographic-structure-to-ids ret)))
 134        (put-char-attribute c 'ideographic-structure@apparent/leftmost ret)
 135        (setq v ret))
 136      nil)
 137    'ideographic-structure@apparent/leftmost)
 138
 139   (map-char-attribute
 140    (lambda (c v)
 141      (unless (equal (setq ret (ideographic-structure-compact v)) v)
 142        (princ (format "Compact %04X (%c) : [apparent/rightmost] %s -> %s\n"
 143                       (char-int c)
 144                       c
 145                       (ideographic-structure-to-ids v)
 146                       (ideographic-structure-to-ids ret)))
 147        (put-char-attribute c 'ideographic-structure@apparent/rightmost ret)
 148        (setq v ret))
 149      nil)
 150    'ideographic-structure@apparent/rightmost)
 151
 152   (map-char-attribute
 153    (lambda (c v)
 154      (unless (equal (setq ret (ideographic-structure-compact v)) v)
 155        (princ (format "Compact %04X (%c) : %s -> %s\n"
 156                       (char-int c)
 157                       c
 158                       (ideographic-structure-to-ids v)
 159                       (ideographic-structure-to-ids ret)))
 160        (put-char-attribute c 'ideographic-structure ret)
 161        (setq v ret))
 162      nil)
 163    'ideographic-structure)
 164   (map-char-attribute
 165    (lambda (c v)
 166      (unless (equal (setq ret (ideographic-structure-compact v)) v)
 167        (princ (format "Compact %04X (%c) : [apparent] %s -> %s\n"
 168                       (char-int c)
 169                       c
 170                       (ideographic-structure-to-ids v)
 171                       (ideographic-structure-to-ids ret)))
 172        (put-char-attribute c 'ideographic-structure@apparent ret)
 173        (setq v ret))
 174      nil)
 175    'ideographic-structure@apparent)
 176   (map-char-attribute
 177    (lambda (c v)
 178      (unless (equal (setq ret (ideographic-structure-compact v)) v)
 179        (princ (format "Compact %04X (%c) : [apparent/leftmost] %s -> %s\n"
 180                       (char-int c)
 181                       c
 182                       (ideographic-structure-to-ids v)
 183                       (ideographic-structure-to-ids ret)))
 184        (put-char-attribute c 'ideographic-structure@apparent/leftmost ret)
 185        (setq v ret))
 186      nil)
 187    'ideographic-structure@apparent/leftmost)
 188   (map-char-attribute
 189    (lambda (c v)
 190      (unless (equal (setq ret (ideographic-structure-compact v)) v)
 191        (princ (format "Compact %04X (%c) : [apparent/rightmost] %s -> %s\n"
 192                       (char-int c)
 193                       c
 194                       (ideographic-structure-to-ids v)
 195                       (ideographic-structure-to-ids ret)))
 196        (put-char-attribute c 'ideographic-structure@apparent/rightmost ret)
 197        (setq v ret))
 198      nil)
 199    'ideographic-structure@apparent/rightmost)
 200   (princ "done.\n")
 201
 202   (princ "Updating char-feature `ideographic-structure'...")
 203   (save-char-attribute-table 'ideographic-structure)
 204   (save-char-attribute-table 'ideographic-structure@apparent)
 205   (princ "done.\n")
 206
 207   (princ "Updating char-feature `ideographic-products'...")
 208   (ids-update-index)
 209   (when old-p-file
 210     (delete-file old-p-file)))
 211 (princ "done.\n")
 212
 213 ;;; install-ids.el ends hear