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) : %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 ret)
 144        (setq v ret))
 145      nil)
 146    'ideographic-structure)
 147   (map-char-attribute
 148    (lambda (c v)
 149      (unless (equal (setq ret (ideographic-structure-compact v)) v)
 150        (princ (format "Compact %04X (%c) : [apparent] %s -> %s\n"
 151                       (char-int c)
 152                       c
 153                       (ideographic-structure-to-ids v)
 154                       (ideographic-structure-to-ids ret)))
 155        (put-char-attribute c 'ideographic-structure@apparent ret)
 156        (setq v ret))
 157      nil)
 158    'ideographic-structure@apparent)
 159   (map-char-attribute
 160    (lambda (c v)
 161      (unless (equal (setq ret (ideographic-structure-compact v)) v)
 162        (princ (format "Compact %04X (%c) : [apparent/leftmost] %s -> %s\n"
 163                       (char-int c)
 164                       c
 165                       (ideographic-structure-to-ids v)
 166                       (ideographic-structure-to-ids ret)))
 167        (put-char-attribute c 'ideographic-structure@apparent/leftmost ret)
 168        (setq v ret))
 169      nil)
 170    'ideographic-structure@apparent/leftmost)
 171   (princ "done.\n")
 172
 173   (princ "Updating char-feature `ideographic-structure'...")
 174   (save-char-attribute-table 'ideographic-structure)
 175   (save-char-attribute-table 'ideographic-structure@apparent)
 176   (princ "done.\n")
 177
 178   (princ "Updating char-feature `ideographic-products'...")
 179   (ids-update-index)
 180   (when old-p-file
 181     (delete-file old-p-file)))
 182 (princ "done.\n")
 183
 184 ;;; install-ids.el ends hear