Commit | Line | Data |
---|---|---|
8cd39fb3 MH |
1 | ;;; nxml-maint.el --- commands for maintainers of nxml-*.el |
2 | ||
dcb8ac09 | 3 | ;; Copyright (C) 2003, 2007, 2008 Free Software Foundation, Inc. |
8cd39fb3 MH |
4 | |
5 | ;; Author: James Clark | |
6 | ;; Keywords: XML | |
7 | ||
c7f70ccd | 8 | ;; This file is part of GNU Emacs. |
8cd39fb3 | 9 | |
c7f70ccd GM |
10 | ;; GNU Emacs is free software; you can redistribute it and/or modify |
11 | ;; it under the terms of the GNU General Public License as published by | |
12 | ;; the Free Software Foundation; either version 3, or (at your option) | |
13 | ;; any later version. | |
8cd39fb3 | 14 | |
c7f70ccd GM |
15 | ;; GNU Emacs is distributed in the hope that it will be useful, |
16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
18 | ;; GNU General Public License for more details. | |
19 | ||
20 | ;; You should have received a copy of the GNU General Public License | |
21 | ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
22 | ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, | |
23 | ;; Boston, MA 02110-1301, USA. | |
8cd39fb3 MH |
24 | |
25 | ;;; Commentary: | |
26 | ||
27 | ;;; Code: | |
28 | ||
29 | ;;; Generating files with Unicode char names. | |
30 | ||
31 | (require 'nxml-uchnm) | |
32 | ||
33 | (defun nxml-create-unicode-char-name-sets (file) | |
34 | "Generate files containing char names from Unicode standard." | |
35 | (interactive "fUnicodeData file: ") | |
c7f70ccd GM |
36 | (mapc (lambda (block) |
37 | (let ((nameset (nxml-unicode-block-char-name-set (nth 0 block)))) | |
38 | (save-excursion | |
39 | (find-file (concat (get nameset 'nxml-char-name-set-file) | |
40 | ".el")) | |
41 | (erase-buffer) | |
42 | (insert "(nxml-define-char-name-set '") | |
43 | (prin1 nameset (current-buffer)) | |
44 | (insert "\n '())\n") | |
45 | (goto-char (- (point) 3))))) | |
46 | nxml-unicode-blocks) | |
8cd39fb3 MH |
47 | (save-excursion |
48 | (find-file file) | |
49 | (goto-char (point-min)) | |
50 | (let ((blocks nxml-unicode-blocks) | |
51 | code name) | |
52 | (while (re-search-forward "^\\([0-9A-F]+\\);\\([^<;][^;]*\\);" | |
53 | nil | |
54 | t) | |
55 | (setq code (string-to-number (match-string 1) 16)) | |
56 | (setq name (match-string 2)) | |
57 | (while (and blocks | |
58 | (> code (nth 2 (car blocks)))) | |
59 | (setq blocks (cdr blocks))) | |
60 | (when (and (<= (nth 1 (car blocks)) code) | |
61 | (<= code (nth 2 (car blocks)))) | |
62 | (save-excursion | |
63 | (find-file (concat (get (nxml-unicode-block-char-name-set | |
64 | (nth 0 (car blocks))) | |
65 | 'nxml-char-name-set-file) | |
66 | ".el")) | |
67 | (insert "(") | |
68 | (prin1 name (current-buffer)) | |
69 | (insert (format " #x%04X)\n " code)))))))) | |
70 | ||
71 | ;;; Parsing target repertoire files from ucs-fonts. | |
72 | ;; This is for converting the TARGET? files in | |
73 | ;; http://www.cl.cam.ac.uk/~mgk25/download/ucs-fonts.tar.gz | |
74 | ;; into a glyph set. | |
75 | ||
76 | (defun nxml-insert-target-repertoire-glyph-set (file var) | |
77 | (interactive "fTarget file: \nSVariable name: ") | |
78 | (let (lst head) | |
79 | (save-excursion | |
80 | (set-buffer (find-file-noselect file)) | |
81 | (goto-char (point-min)) | |
82 | (while (re-search-forward "^ *\\([a-FA-F0-9]\\{2\\}\\)[ \t]+" nil t) | |
83 | (let ((row (match-string 1)) | |
84 | (eol (save-excursion (end-of-line) (point)))) | |
85 | (while (re-search-forward "\\([a-FA-F0-9]\\{2\\}\\)-\\([a-FA-F0-9]\\{2\\}\\)\\|\\([a-FA-F0-9]\\{2\\}\\)" eol t) | |
86 | (setq lst | |
87 | (cons (if (match-beginning 3) | |
88 | (concat "#x" row (match-string 3)) | |
89 | (concat "(#x" row (match-string 1) | |
90 | " . #x" row (match-string 2) ")")) | |
91 | lst)))))) | |
92 | (setq lst (nreverse lst)) | |
93 | (insert (format "(defconst %s\n [" var)) | |
94 | (while lst | |
95 | (setq head (car lst)) | |
96 | (setq lst (cdr lst)) | |
97 | (insert head) | |
98 | (when (= (length head) 6) | |
99 | (while (and lst (= (length (car lst)) 6)) | |
100 | (insert " ") | |
101 | (insert (car lst)) | |
102 | (setq lst (cdr lst)))) | |
103 | (when lst (insert "\n "))) | |
104 | (insert "])\n"))) | |
105 | ||
106 | (provide 'nxml-maint) | |
107 | ||
ab4c34c6 | 108 | ;; arch-tag: 2cff6b55-12af-47db-90da-a91f782f435a |
8cd39fb3 | 109 | ;;; nxml-maint.el ends here |