check-mule.el

   1 (defconst mule-charset-mapping-table-alist
   2   '((arabic-digit "http://www.m17n.org/mule/mappings/arabic0.txt")
   3     (arabic-1-column "http://www.m17n.org/mule/mappings/arabic1.txt")
   4     (arabic-2-column "http://www.m17n.org/mule/mappings/arabic2.txt")
   5     (ipa "http://www.m17n.org/mule/mappings/ipa.txt")
   6     ))
   7
   8 (defvar mule-charset-http-url-root "~/pub/http/")
   9
  10 (defun mule-charset-url-to-filename (url)
  11   (when (string-match "http://" url)
  12     (expand-file-name (substring url (match-end 0))
  13                       mule-charset-http-url-root)))
  14
  15 (defun mule-charset-maybe-retrieve-url (url)
  16   (call-process "wget" nil nil nil
  17                 "-q" "-P" (expand-file-name
  18                            mule-charset-http-url-root) "-m" url))
  19
  20 (defun mule-charset-check-mapping (coded-charset &optional url)
  21   (unless url
  22     (setq url
  23           (car (cdr (assq coded-charset mule-charset-mapping-table-alist)))))
  24   (mule-charset-maybe-retrieve-url url)
  25   (let ((file (mule-charset-url-to-filename url))
  26         buf)
  27     (if (file-exists-p file)
  28         (progn
  29           (setq buf (find-file-noselect file))
  30           (with-current-buffer buf
  31             (goto-char (point-min))
  32             (let (code ucs chr ret)
  33               (while
  34                   (re-search-forward
  35                    "^0x\\([0-9A-F]+\\)\t\\(0x[0-9A-F]+\\( 0x[0-9A-F]+\\)\\)"
  36                    nil t)
  37                 (setq code (string-to-int (match-string 1) 16)
  38                       ucs (match-string 2))
  39                 (if (string-match " " ucs)
  40                     (define-char
  41                       (list (cons coded-charset code)
  42                             (cons '->decomposition
  43                                   (mapcar (lambda (str)
  44                                             (string-to-int
  45                                              (substring str 2) 16))
  46                                           (split-string ucs " ")))))
  47                   (setq ucs (string-to-int ucs 16))
  48                   (setq chr (decode-char coded-charset code))
  49                   (if (or (setq ret (get-char-attribute chr 'ucs))
  50                           (setq ret (get-char-attribute chr 'ucs-mule))
  51                           (setq ret (get-char-attribute chr '=>ucs))
  52                           (setq ret (get-char-attribute chr '->ucs)))
  53                       (unless (= ret ucs)
  54                         (put-char-attribute chr 'ucs-mule ucs))
  55                     (put-char-attribute (decode-char 'ucs ucs)
  56                                         coded-charset code))))))
  57           (kill-buffer buf))
  58       (with-current-buffer "*scratch*"
  59         (insert (format "%s is not found!!!\n" file))))))
  60
  61 (dolist (cell mule-charset-mapping-table-alist)
  62   (mule-charset-check-mapping (car cell)(cadr cell)))