code.delx.au - gnu-emacs-elpa/blob - packages/uni-confusables/gen-confusables.el

   1 ;;; gen-confusables.el --- generate uni-confusables.el from confusables.txt
   2
   3 ;; Copyright (C) 2011  Teodor Zlatanov
   4
   5 ;; Author: Teodor Zlatanov <tzz@lifelogs.com>
   6
   7 ;; This program is free software; you can redistribute it and/or modify
   8 ;; it under the terms of the GNU General Public License as published by
   9 ;; the Free Software Foundation, either version 3 of the License, or
  10 ;; (at your option) any later version.
  11
  12 ;; This program is distributed in the hope that it will be useful,
  13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;; GNU General Public License for more details.
  16
  17 ;; You should have received a copy of the GNU General Public License
  18 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  19
  20 ;;; Commentary:
  21
  22 ;;; Code:
  23
  24 (require 'cl)
  25
  26 (defvar gen-confusables-char-table-single)
  27 (defvar gen-confusables-char-table-multiple)
  28
  29 (defun gen-confusables-read (file)
  30   (interactive "fConfusables filename: \n")
  31   (flet ((reader (h) (string-to-number h 16)))
  32     (let ((stable (make-char-table 'confusables-single-script))
  33           (mtable (make-char-table 'confusables-multiple-script))
  34           (count 0)
  35           (confusable-line-regexp (concat "^\\([[:xdigit:]]+\\)" ; \x+
  36                                           " ;\t"
  37                                           ;; \x+ separated by spaces
  38                                           "\\([[:space:][:xdigit:]]+\\)"
  39                                           " ;\t"
  40                                           "\\([SM]\\)[LA]"))) ; SL, SA, ML, MA
  41       (setq gen-confusables-char-table-single stable)
  42       (setq gen-confusables-char-table-multiple mtable)
  43       (with-temp-buffer
  44         (insert-file-contents file)
  45         (goto-char (point-min))
  46         (while (re-search-forward confusable-line-regexp nil t)
  47           (incf count)
  48           (when (and (called-interactively-p)
  49                      (zerop (mod count 100)))
  50             (message "processed %d lines" count))
  51           (let* ((from (match-string 1))
  52                  (to (match-string 2))
  53                  (class (match-string 3))
  54                  (table (if (string-equal "S" class) stable mtable)))
  55             (set-char-table-range
  56              table
  57              (reader from)
  58              (concat (mapcar 'reader (split-string to))))))))))
  59
  60 (defun gen-confusables-write (file)
  61   (interactive "FDumped filename: \n")
  62   (let ((coding-system-for-write 'utf-8-emacs))
  63     (with-temp-file file
  64       (insert ";; Copyright (C) 1991-2009, 2010 Unicode, Inc.
  65 ;; This file was generated from the Unicode confusables list at
  66 ;; http://www.unicode.org/Public/security/revision-04/confusables.txt.
  67 ;; See lisp/international/README in the Emacs trunk
  68 ;; for the copyright and permission notice.\n\n")
  69       (dolist (type '(single multiple))
  70         (let* ((tablesym (intern (format "uni-confusables-char-table-%s" type)))
  71                (oursym (intern (format "gen-confusables-char-table-%s" type)))
  72                (ourtable (symbol-value oursym))
  73                (ourtablename (symbol-name oursym))
  74                (tablename (symbol-name tablesym))
  75                (prop (format "confusables-%s-script" type))
  76                props)
  77           (insert (format "(defvar %s (make-char-table '%s))\n\n"
  78                           tablename prop))
  79           (map-char-table
  80            (lambda (k v) (setq props (cons k (cons v props))))
  81            ourtable)
  82
  83           (insert (format "(let ((k nil) (v nil) (ranges '%S))\n" props))
  84           (insert (format "
  85   (while ranges
  86      (setq k (pop ranges)
  87            v (pop ranges))
  88      (set-char-table-range %s k v)))\n\n" tablename))
  89
  90           (insert (format "(ert-deftest uni-confusables-test-%s ()\n" type))
  91
  92           (dolist (offset '(100 200 800 3000 3500))
  93             (insert (format "
  94   (should (string-equal
  95            (char-table-range %s %d)
  96            %S))\n"
  97                             tablename
  98                             (nth (* 2 offset) props)
  99                             (nth (1+ (* 2 offset)) props))))
 100           (insert ")\n\n")))
 101       (insert "
 102 ;; Local Variables:
 103 ;; coding: utf-8
 104 ;; no-byte-compile: t
 105 ;; End:
 106
 107 ;; uni-confusables.el ends here"))))
 108
 109 (provide 'gen-confusables)
 110 ;;; gen-confusables.el ends here