cgit.sxemacs.org Git - packages/blob - xemacs-packages/psgml/psgml-charent.el

   1 ;;;; psgml-charent.el
   2 ;;; Last edited: 1999-12-18 18:54:53 lenst
   3 ;;; $Id: psgml-charent.el,v 1.7 2002/04/25 20:50:27 lenst Exp $
   4
   5 ;; Copyright (C) 1994 Lennart Staflin
   6
   7 ;; Author: Steinar Bang, Falch Hurtigtrykk as., Oslo, 940711
   8 ;;      Lennart Staflin <lenst@lysator.liu.se>
   9 ;;
  10 ;; This program is free software; you can redistribute it and/or
  11 ;; modify it under the terms of the GNU General Public License
  12 ;; as published by the Free Software Foundation; either version 2
  13 ;; of the License, or (at your option) any later version.
  14 ;;
  15 ;; This program 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 this program; if not, write to the Free Software
  22 ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  23
  24 \f
  25 ;;;; Commentary:
  26
  27 ;;  Functions to convert character entities into displayable characters
  28 ;;  and displayable characters back into character entities.
  29
  30 ;; This should either use iso-cvt or do better with a multilingual set of entities
  31
  32 \f
  33 ;;;; Code:
  34
  35 (provide 'psgml-charent)
  36 (require 'psgml-parse)
  37 (eval-when-compile (require 'cl))
  38
  39 \f
  40 ;;;; Variable declarations
  41
  42 (defvar sgml-display-char-list-filename
  43   (expand-file-name "iso88591.map"
  44                     ;; XEmacs change: use data-directory, try "sgml" too.
  45                     (file-name-directory
  46                      (or (locate-data-directory "psgml")
  47                          (locate-data-directory "sgml"))))
  48   "*Name of file holding relations between character codes and character
  49 names of displayable characters.")
  50
  51 (defvar sgml-display-char-alist-cache nil)
  52
  53 \f
  54 ;;;; Function declarations
  55
  56 (defun sgml-display-char-alist ()
  57   "Return the current display character alist.
  58 Alist with entity name as key and display character as content."
  59   (unless (file-exists-p sgml-display-char-list-filename)
  60     (error "No display char file: %s"
  61            sgml-display-char-list-filename))
  62   (sgml-cache-catalog sgml-display-char-list-filename
  63                       'sgml-display-char-alist-cache
  64                       (function sgml-read-display-char-alist)))
  65
  66 (defun sgml-read-display-char-alist ()
  67   (let (key disp-char alist)
  68     (while (re-search-forward "^\\([0-9]+\\)[ \t]+\\(.+\\)$" nil t)
  69       (setq key (buffer-substring (match-beginning 2) (match-end 2)))
  70       (setq disp-char (string-to-number (buffer-substring (match-beginning 1)
  71                                                           (match-end 1))))
  72       (if (fboundp 'unibyte-char-to-multibyte)
  73           (setq disp-char (unibyte-char-to-multibyte disp-char)))
  74       (setq disp-char (char-to-string disp-char))
  75       (push (cons key disp-char)
  76             alist))
  77     alist))
  78
  79 (defun sgml-charent-to-dispchar-alist ()
  80   "Association list to hold relations of the type
  81      (CHARACTER-NAME . CHARACTER)
  82     where
  83      CHARACTER-NAME is a string holding a character name
  84      CHARACTER      is a string holding a single displayable character"
  85   (sgml-need-dtd)
  86   (let ((display-chars (sgml-display-char-alist))
  87         (alist nil))
  88     (sgml-map-entities
  89      (function
  90       (lambda (entity)
  91         (let ((char (cdr (assoc (sgml-entity-text entity)
  92                                 display-chars))))
  93           (when char
  94             (push (cons (sgml-entity-name entity) char) alist)))))
  95      (sgml-dtd-entities sgml-dtd-info))
  96
  97     alist))
  98
  99
 100 (defun sgml-charent-to-display-char ()
 101   "Replace character entities with their display character equivalents"
 102   (interactive)
 103   (let ((charent-to-char
 104          (sgml-charent-to-dispchar-alist))
 105         charent replacement)
 106     (save-excursion
 107       (goto-char (point-min))
 108       (sgml-with-parser-syntax
 109        (while (re-search-forward "&\\(\\w\\(\\w\\|\\s_\\)*\\);?" nil t)
 110          (setq charent (buffer-substring-no-properties
 111                         (match-beginning 1) (match-end 1)))
 112          (if (setq replacement (cdr (assoc charent charent-to-char)))
 113              (replace-match replacement t t)))))))
 114
 115 (defun sgml-display-char-to-charent ()
 116   "Replace displayable characters with their character entity equivalents"
 117   (interactive)
 118   (let ((case-fold-search nil))
 119     (save-excursion
 120       (loop for pair in (sgml-charent-to-dispchar-alist)
 121             do (goto-char (point-min))
 122             (while (search-forward (cdr pair) nil t)
 123               (replace-match (concat "&" (car pair) ";") t t))))))
 124
 125
 126 \f
 127 ;;; psgml-charent.el ends here