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