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, 2012, 2014  Free Software Foundation, Inc.
   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-lib)
  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   (cl-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           (cl-incf count)
  48           (when (and (called-interactively-p 'interactive)
  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 ";;; uni-confusables.el --- Unicode confusables table
  65 ;; Copyright (C) 1991-2009, 2010 Unicode, Inc.
  66 ;; This file was generated from the Unicode confusables list at
  67 ;; http://www.unicode.org/Public/security/revision-04/confusables.txt.
  68 ;; See lisp/international/README in the Emacs trunk
  69 ;; for the copyright and permission notice.
  70
  71 ;; Version: 0.1
  72 ;; Maintainer: Teodor Zlatanov <tzz@lifelogs.com>
  73
  74 ;;; Code:\n\n")
  75       (dolist (type '(single multiple))
  76         (let* ((tablesym (intern (format "uni-confusables-char-table-%s" type)))
  77                (oursym (intern (format "gen-confusables-char-table-%s" type)))
  78                (ourtable (symbol-value oursym))
  79                (tablename (symbol-name tablesym))
  80                (prop (format "confusables-%s-script" type))
  81                props)
  82           (insert (format "(defvar %s (make-char-table '%s))\n\n"
  83                           tablename prop))
  84           (map-char-table
  85            (lambda (k v) (setq props (cons k (cons v props))))
  86            ourtable)
  87
  88           (insert (format "(let ((k nil) (v nil) (ranges '%S))\n" props))
  89           (insert (format "
  90   (while ranges
  91      (setq k (pop ranges)
  92            v (pop ranges))
  93      (set-char-table-range %s k v)))\n\n" tablename))
  94
  95           (insert (format "(ert-deftest uni-confusables-test-%s ()\n" type))
  96
  97           (dolist (offset '(100 200 800 3000 3500))
  98             (insert (format "
  99   (should (string-equal
 100            (char-table-range %s %d)
 101            %S))\n"
 102                             tablename
 103                             (nth (* 2 offset) props)
 104                             (nth (1+ (* 2 offset)) props))))
 105           (insert ")\n\n")))
 106       ;; Use \s escapes in the string, so that this text isn't mis-recognized
 107       ;; as applying to this file, but only to the generated file.
 108       (insert "
 109 ;;\sLocal\sVariables:
 110 ;;\scoding: utf-8
 111 ;;\sno-byte-compile: t
 112 ;;\sEnd:
 113
 114 ;;; uni-confusables.el ends here"))))
 115
 116 (provide 'gen-confusables)
 117 ;;; gen-confusables.el ends here