From e8f2cc26e712f42f6391fa52cd67c3e791096f1e Mon Sep 17 00:00:00 2001 From: YAMAMOTO Mitsuharu Date: Sun, 25 May 2014 19:17:24 -0700 Subject: [PATCH] * admin/mac/uvs.el: New file. Generates ../src/macuvs.h. (Backport from trunk) --- admin/ChangeLog | 4 + admin/mac/uvs.el | 213 +++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 217 insertions(+) create mode 100644 admin/mac/uvs.el diff --git a/admin/ChangeLog b/admin/ChangeLog index 68bf62070b..1ba338dcc7 100644 --- a/admin/ChangeLog +++ b/admin/ChangeLog @@ -1,3 +1,7 @@ +2014-05-26 YAMAMOTO Mitsuharu + + * mac/uvs.el: New file. Generates ../src/macuvs.h. + 2014-05-11 Glenn Morris * find-gc.el: Move here from ../lisp/emacs-lisp. diff --git a/admin/mac/uvs.el b/admin/mac/uvs.el new file mode 100644 index 0000000000..a9a0c9120d --- /dev/null +++ b/admin/mac/uvs.el @@ -0,0 +1,213 @@ +;;; uvs.el --- utility for UVS (format 14) cmap subtables in OpenType fonts. + +;; Copyright (C) 2014 Free Software Foundation, Inc. + +;; Author: YAMAMOTO Mitsuharu + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; To extract a C array definition of a UVS table for the Adobe-Japan1 +;; character collection from an IVD Sequences file, execute +;; $ emacs -batch -l uvs.el \ +;; --eval '(uvs-print-table-ivd "IVD_Sequences.txt" "Adobe-Japan1")' \ +;; > uvs.h + +;;; Code: + +(defun uvs-fields-total-size (fields) + (apply '+ (mapcar (lambda (field) (get field 'uvs-field-size)) fields))) + +;;; Fields in Format 14 header. +(defconst uvs-format-14-header-fields + '(format length num-var-selector-records)) +(put 'format 'uvs-field-size 2) +(put 'length 'uvs-field-size 4) +(put 'num-var-selector-records 'uvs-field-size 4) +(defconst uvs-format-14-header-size + (uvs-fields-total-size uvs-format-14-header-fields)) + +;;; Fields in Variation Selector Record. +(defconst uvs-variation-selector-record-fields + '(var-selector default-uvs-offset non-default-uvs-offset)) +(put 'var-selector 'uvs-field-size 3) +(put 'default-uvs-offset 'uvs-field-size 4) +(put 'non-default-uvs-offset 'uvs-field-size 4) +(defconst uvs-variation-selector-record-size + (uvs-fields-total-size uvs-variation-selector-record-fields)) + +;;; Fields in Non-Default UVS Table. +(defconst uvs-non-default-uvs-table-header-fields '(num-uvs-mappings)) +(put 'num-uvs-mappings 'uvs-field-size 4) +(defconst uvs-non-default-uvs-table-header-size + (uvs-fields-total-size uvs-non-default-uvs-table-header-fields)) + +;;; Fields in UVS Mapping. +(defconst uvs-uvs-mapping-fields '(unicode-value glyph-id)) +(put 'unicode-value 'uvs-field-size 3) +(put 'glyph-id 'uvs-field-size 2) +(defconst uvs-uvs-mapping-size + (uvs-fields-total-size uvs-uvs-mapping-fields)) + +(defun uvs-alist-from-ivd (collection-id sequence-id-to-glyph-function) + "Create UVS alist from IVD Sequences and COLLECTION-ID. +The IVD (Ideographic Variation Database) Sequences are obtained +from the contents of the current buffer, and should be in the +form of IVD_Sequences.txt specified in Unicode Technical Standard +#37. COLLECTION-ID is a string specifying the identifier of the +collection to extract (e.g., \"Adobe-Japan1\"). +SEQUENCE-ID-TO-GLYPH-FUNC is a function to convert an identifier +string of the sequence to a glyph number. UVS alist is of the +following form: + ((SELECTOR1 . ((BASE11 . GLYPH11) (BASE12 . GLYPH12) ...)) + (SELECTOR2 . ((BASE21 . GLYPH21) (BASE22 . GLYPH22) ...)) ...), +where selectors and bases are sorted in ascending order." + (let (uvs-alist) + (goto-char (point-min)) + (while (re-search-forward + (concat "^[[:blank:]]*" + "\\([[:xdigit:]]+\\) \\([[:xdigit:]]+\\)" + "[[:blank:]]*;[[:blank:]]*" + "\\(?:" (regexp-quote collection-id) "\\)" + "[[:blank:]]*;[[:blank:]]*" + "\\([^\n[:blank:]]+\\)" + "[[:blank:]]*$") nil t) + (let* ((base (string-to-number (match-string 1) 16)) + (selector (string-to-number (match-string 2) 16)) + (sequence-id (match-string 3)) + (glyph (funcall sequence-id-to-glyph-function sequence-id))) + (let ((selector-bgs (assq selector uvs-alist)) + (base-glyph (cons base glyph))) + (if selector-bgs + (setcdr selector-bgs (cons base-glyph (cdr selector-bgs))) + (push (cons selector (list base-glyph)) uvs-alist))))) + (dolist (selector-bgs uvs-alist) + (setcdr selector-bgs + (sort (cdr selector-bgs) + (lambda (bg1 bg2) (< (car bg1) (car bg2)))))) + (sort uvs-alist (lambda (sb1 sb2) (< (car sb1) (car sb2)))))) + +(defun uvs-int-to-bytes (value size) + "Convert integer VALUE to a list of SIZE bytes. +The most significant byte comes first." + (let (result) + (dotimes (i size) + (push (logand value #xff) result) + (setq value (lsh value -8))) + result)) + +(defun uvs-insert-fields-as-bytes (fields &rest values) + "Insert VALUES for FIELDS as a sequence of bytes to the current buffer. +VALUES and FIELDS are lists of integers and field symbols, +respectively. Byte length of each value is determined by the +'uvs-field-size' property of the corresponding field." + (while fields + (let ((field (car fields)) + (value (car values))) + (insert (apply 'unibyte-string + (uvs-int-to-bytes value (get field 'uvs-field-size)))) + (setq fields (cdr fields) values (cdr values))))) + +(defun uvs-insert-alist-as-bytes (uvs-alist) + "Insert UVS-ALIST as a sequence of bytes to the current buffer." + (let* ((nrecords (length uvs-alist)) ; # of selectors + (total-nmappings + (apply '+ (mapcar + (lambda (selector-bgs) (length (cdr selector-bgs))) + uvs-alist))) + (non-default-offset + (+ uvs-format-14-header-size + (* uvs-variation-selector-record-size nrecords)))) + (uvs-insert-fields-as-bytes uvs-format-14-header-fields + 14 + (+ uvs-format-14-header-size + (* uvs-variation-selector-record-size + nrecords) + (* uvs-non-default-uvs-table-header-size + nrecords) + (* uvs-uvs-mapping-size total-nmappings)) + nrecords) + (dolist (selector-bgs uvs-alist) + (uvs-insert-fields-as-bytes uvs-variation-selector-record-fields + (car selector-bgs) + 0 ; No Default UVS Tables. + non-default-offset) + (setq non-default-offset + (+ non-default-offset + uvs-non-default-uvs-table-header-size + (* (length (cdr selector-bgs)) uvs-uvs-mapping-size)))) + (dolist (selector-bgs uvs-alist) + (uvs-insert-fields-as-bytes uvs-non-default-uvs-table-header-fields + (length (cdr selector-bgs))) + (dolist (base-glyph (cdr selector-bgs)) + (uvs-insert-fields-as-bytes uvs-uvs-mapping-fields + (car base-glyph) + (cdr base-glyph)))))) + +(defun uvs-dump (&optional bytes-per-line separator separator-eol line-prefix) + "Print the current buffer as in representation of C array contents." + (or bytes-per-line (setq bytes-per-line 8)) + (or separator (setq separator ", ")) + (or separator-eol (setq separator-eol ",")) + (or line-prefix (setq line-prefix " ")) + (goto-char (point-min)) + (while (> (- (point-max) (point)) bytes-per-line) + (princ line-prefix) + (princ (mapconcat (lambda (byte) (format "0x%02x" byte)) + (string-to-unibyte + (buffer-substring (point) (+ (point) bytes-per-line))) + separator)) + (princ separator-eol) + (terpri) + (forward-char bytes-per-line)) + (princ line-prefix) + (princ (mapconcat (lambda (byte) (format "0x%02x" byte)) + (string-to-unibyte + (buffer-substring (point) (point-max))) + separator)) + (terpri)) + +(defun uvs-print-table-ivd (filename collection-id + &optional sequence-id-to-glyph-func) + "Print a C array definition of a UVS table for IVD Sequences. +FILENAME specifies the IVD Sequences file. COLLECTION-ID is a +string specifying the identifier of the collection to +extract (e.g., \"Adobe-Japan1\"). SEQUENCE-ID-TO-GLYPH-FUNC is a +function to convert an identifier string of the sequence to a +glyph number, and nil means to convert \"CID\\+[0-9]+\" to the +corresponding number." + (or sequence-id-to-glyph-func + (setq sequence-id-to-glyph-func + (lambda (sequence-id) + (string-match "\\`CID\\+\\([[:digit:]]+\\)\\'" sequence-id) + (string-to-number (match-string 1 sequence-id))))) + (let ((uvs-alist + (with-temp-buffer + (insert-file-contents filename) + (setq uvs-alist (uvs-alist-from-ivd collection-id + sequence-id-to-glyph-func))))) + (princ + (format "static const unsigned char mac_uvs_table_%s_bytes[] =\n {\n" + (replace-regexp-in-string "[^_[:alnum:]]" "_" + (downcase collection-id)))) + (with-temp-buffer + (set-buffer-multibyte nil) + (uvs-insert-alist-as-bytes uvs-alist) + (uvs-dump)) + (princ " };\n"))) + +;;; uvs.el ends here -- 2.20.1