check-mule.el

   1 (with-current-buffer "arabic0.txt"
   2   (goto-char (point-min))
   3   (let (code ucs chr ret)
   4     (while (re-search-forward "^0x\\([0-9A-F]+\\)\t0x\\([0-9A-F]+\\)" nil t)
   5       (setq code (string-to-int (match-string 1) 16)
   6             ucs (string-to-int (match-string 2) 16))
   7       (setq chr (decode-char 'arabic-digit code))
   8       (if (or (setq ret (get-char-attribute chr 'ucs))
   9               (setq ret (get-char-attribute chr 'ucs-mule))
  10               (setq ret (get-char-attribute chr '=>ucs))
  11               (setq ret (get-char-attribute chr '->ucs)))
  12           (unless (= ret ucs)
  13             (put-char-attribute chr 'ucs-mule ucs)
  14             )
  15         (put-char-attribute (decode-char 'ucs ucs)
  16                             'arabic-digit code)))))
  17
  18 (with-current-buffer "arabic1.txt"
  19   (goto-char (point-min))
  20   (let (code ucs chr ret)
  21     (while (re-search-forward "^0x\\([0-9A-F]+\\)\t0x\\([0-9A-F]+\\)" nil t)
  22       (setq code (string-to-int (match-string 1) 16)
  23             ucs (string-to-int (match-string 2) 16))
  24       (setq chr (decode-char 'arabic-1-column code))
  25       (if (or (setq ret (get-char-attribute chr 'ucs))
  26               (setq ret (get-char-attribute chr 'ucs-mule))
  27               (setq ret (get-char-attribute chr '=>ucs))
  28               (setq ret (get-char-attribute chr '->ucs)))
  29           (unless (= ret ucs)
  30             (put-char-attribute chr 'ucs-mule ucs)
  31             )
  32         (put-char-attribute (decode-char 'ucs ucs)
  33                             'arabic-1-column code)))))
  34
  35 (with-current-buffer "arabic2.txt"
  36   (goto-char (point-min))
  37   (let (code ucs chr ret)
  38     (while (re-search-forward "^0x\\([0-9A-F]+\\)\t0x\\([0-9A-F]+\\)" nil t)
  39       (setq code (string-to-int (match-string 1) 16)
  40             ucs (string-to-int (match-string 2) 16))
  41       (setq chr (decode-char 'arabic-2-column code))
  42       (if (or (setq ret (get-char-attribute chr 'ucs))
  43               (setq ret (get-char-attribute chr 'ucs-mule))
  44               (setq ret (get-char-attribute chr '=>ucs))
  45               (setq ret (get-char-attribute chr '->ucs)))
  46           (unless (= ret ucs)
  47             (put-char-attribute chr 'ucs-mule ucs)
  48             )
  49         (put-char-attribute (decode-char 'ucs ucs)
  50                             'arabic-2-column code)))))