lisp/nxml/nxml-maint.el

   1 ;;; nxml-maint.el --- commands for maintainers of nxml-*.el  -*- lexical-binding:t -*-
   2
   3 ;; Copyright (C) 2003, 2007-2018 Free Software Foundation, Inc.
   4
   5 ;; Author: James Clark
   6 ;; Keywords: wp, hypermedia, languages, XML
   7
   8 ;; This file is part of GNU Emacs.
   9
  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 of the License, or
  13 ;; (at your option) any later version.
  14
  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.  If not, see <https://www.gnu.org/licenses/>.
  22
  23 ;;; Commentary:
  24
  25 ;;; Code:
  26
  27 ;;; Parsing target repertoire files from ucs-fonts.
  28 ;; This is for converting the TARGET? files in
  29 ;; http://www.cl.cam.ac.uk/~mgk25/download/ucs-fonts.tar.gz
  30 ;; into a glyph set.
  31
  32 (defun nxml-insert-target-repertoire-glyph-set (file var)
  33   (interactive "fTarget file: \nSVariable name: ")
  34   (let (lst head)
  35     (with-current-buffer (find-file-noselect file)
  36       (goto-char (point-min))
  37       (while (re-search-forward "^ *\\([a-FA-F0-9]\\{2\\}\\)[ \t]+" nil t)
  38         (let ((row (match-string 1))
  39               (eol (line-end-position)))
  40           (while (re-search-forward "\\([a-FA-F0-9]\\{2\\}\\)-\\([a-FA-F0-9]\\{2\\}\\)\\|\\([a-FA-F0-9]\\{2\\}\\)" eol t)
  41             (setq lst
  42                   (cons (if (match-beginning 3)
  43                             (concat "#x" row (match-string 3))
  44                         (concat "(#x" row (match-string 1)
  45                                 " . #x" row (match-string 2) ")"))
  46                         lst))))))
  47     (setq lst (nreverse lst))
  48     (insert (format "(defconst %s\n  [" var))
  49     (while lst
  50       (setq head (car lst))
  51       (setq lst (cdr lst))
  52       (insert head)
  53       (when (= (length head) 6)
  54         (while (and lst (= (length (car lst)) 6))
  55           (insert " ")
  56           (insert (car lst))
  57           (setq lst (cdr lst))))
  58       (when lst (insert "\n   ")))
  59     (insert "])\n")))
  60
  61 (provide 'nxml-maint)
  62
  63 ;;; nxml-maint.el ends here