mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-02-17 01:34:21 +00:00
* admin/mac/uvs.el: New file from Mac port. src/macuvs.h is generated by it.
This commit is contained in:
Jan Djärv
parent
d6e8093a97
commit
cbe8e343e6
2 changed files with 218 additions and 0 deletions
|
|
@ -1,3 +1,8 @@
|
|||
2014-05-25 Jan Djärv <jan.h.d@swipnet.se>
|
||||
|
||||
* mac/uvs.el: New file from Mac port. src/macuvs.h is generated
|
||||
by it.
|
||||
|
||||
2014-05-17 Paul Eggert <eggert@cs.ucla.edu>
|
||||
|
||||
Assume C99 or later (Bug#17487).
|
||||
|
|
|
|||
213
admin/mac/uvs.el
Normal file
213
admin/mac/uvs.el
Normal file
|
|
@ -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 <mituharu@math.s.chiba-u.ac.jp>
|
||||
|
||||
;; 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 <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; 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
|
||||
Loading…
Reference in a new issue