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