nxml-maint.el 3.4 KB

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