Mercurial > emacs
annotate lisp/nxml/nxml-maint.el @ 110149:4ac2b883320e
Forgor to save ChangeLog for previous commit.
author | Jan D. <jan.h.d@swipnet.se> |
---|---|
date | Thu, 02 Sep 2010 12:20:20 +0200 |
parents | 1d1d5d9bd884 |
children | 249a1455856a 376148b31b5e |
rev | line source |
---|---|
86361 | 1 ;;; nxml-maint.el --- commands for maintainers of nxml-*.el |
2 | |
106815 | 3 ;; Copyright (C) 2003, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. |
86361 | 4 |
5 ;; Author: James Clark | |
6 ;; Keywords: XML | |
7 | |
86537 | 8 ;; This file is part of GNU Emacs. |
9 | |
94666
d495d4d5452f
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
87665
diff
changeset
|
10 ;; GNU Emacs is free software: you can redistribute it and/or modify |
86537 | 11 ;; it under the terms of the GNU General Public License as published by |
94666
d495d4d5452f
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
87665
diff
changeset
|
12 ;; the Free Software Foundation, either version 3 of the License, or |
d495d4d5452f
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
87665
diff
changeset
|
13 ;; (at your option) any later version. |
86361 | 14 |
86537 | 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. | |
86361 | 19 |
86537 | 20 ;; You should have received a copy of the GNU General Public License |
94666
d495d4d5452f
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
87665
diff
changeset
|
21 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
86361 | 22 |
23 ;;; Commentary: | |
24 | |
25 ;;; Code: | |
26 | |
27 ;;; Generating files with Unicode char names. | |
28 | |
29 (require 'nxml-uchnm) | |
30 | |
31 (defun nxml-create-unicode-char-name-sets (file) | |
32 "Generate files containing char names from Unicode standard." | |
33 (interactive "fUnicodeData file: ") | |
86537 | 34 (mapc (lambda (block) |
35 (let ((nameset (nxml-unicode-block-char-name-set (nth 0 block)))) | |
36 (save-excursion | |
37 (find-file (concat (get nameset 'nxml-char-name-set-file) | |
38 ".el")) | |
39 (erase-buffer) | |
40 (insert "(nxml-define-char-name-set '") | |
41 (prin1 nameset (current-buffer)) | |
42 (insert "\n '())\n") | |
43 (goto-char (- (point) 3))))) | |
44 nxml-unicode-blocks) | |
86361 | 45 (save-excursion |
46 (find-file file) | |
47 (goto-char (point-min)) | |
48 (let ((blocks nxml-unicode-blocks) | |
49 code name) | |
50 (while (re-search-forward "^\\([0-9A-F]+\\);\\([^<;][^;]*\\);" | |
51 nil | |
52 t) | |
53 (setq code (string-to-number (match-string 1) 16)) | |
54 (setq name (match-string 2)) | |
55 (while (and blocks | |
56 (> code (nth 2 (car blocks)))) | |
57 (setq blocks (cdr blocks))) | |
58 (when (and (<= (nth 1 (car blocks)) code) | |
59 (<= code (nth 2 (car blocks)))) | |
60 (save-excursion | |
61 (find-file (concat (get (nxml-unicode-block-char-name-set | |
62 (nth 0 (car blocks))) | |
63 'nxml-char-name-set-file) | |
64 ".el")) | |
65 (insert "(") | |
66 (prin1 name (current-buffer)) | |
67 (insert (format " #x%04X)\n " code)))))))) | |
68 | |
69 ;;; Parsing target repertoire files from ucs-fonts. | |
70 ;; This is for converting the TARGET? files in | |
71 ;; http://www.cl.cam.ac.uk/~mgk25/download/ucs-fonts.tar.gz | |
72 ;; into a glyph set. | |
73 | |
74 (defun nxml-insert-target-repertoire-glyph-set (file var) | |
75 (interactive "fTarget file: \nSVariable name: ") | |
76 (let (lst head) | |
105866
3367f0022cf2
* nxml/xsd-regexp.el (xsdre-gen-categories):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
100908
diff
changeset
|
77 (with-current-buffer (find-file-noselect file) |
86361 | 78 (goto-char (point-min)) |
79 (while (re-search-forward "^ *\\([a-FA-F0-9]\\{2\\}\\)[ \t]+" nil t) | |
80 (let ((row (match-string 1)) | |
81 (eol (save-excursion (end-of-line) (point)))) | |
82 (while (re-search-forward "\\([a-FA-F0-9]\\{2\\}\\)-\\([a-FA-F0-9]\\{2\\}\\)\\|\\([a-FA-F0-9]\\{2\\}\\)" eol t) | |
83 (setq lst | |
84 (cons (if (match-beginning 3) | |
85 (concat "#x" row (match-string 3)) | |
86 (concat "(#x" row (match-string 1) | |
87 " . #x" row (match-string 2) ")")) | |
88 lst)))))) | |
89 (setq lst (nreverse lst)) | |
90 (insert (format "(defconst %s\n [" var)) | |
91 (while lst | |
92 (setq head (car lst)) | |
93 (setq lst (cdr lst)) | |
94 (insert head) | |
95 (when (= (length head) 6) | |
96 (while (and lst (= (length (car lst)) 6)) | |
97 (insert " ") | |
98 (insert (car lst)) | |
99 (setq lst (cdr lst)))) | |
100 (when lst (insert "\n "))) | |
101 (insert "])\n"))) | |
102 | |
103 (provide 'nxml-maint) | |
104 | |
86379 | 105 ;; arch-tag: 2cff6b55-12af-47db-90da-a91f782f435a |
86361 | 106 ;;; nxml-maint.el ends here |