Mercurial > hg > xemacs-beta
diff lisp/psgml/psgml-charent.el @ 0:376386a54a3c r19-14
Import from CVS: tag r19-14
author | cvs |
---|---|
date | Mon, 13 Aug 2007 08:45:50 +0200 |
parents | |
children | ac2d302a0011 |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/psgml/psgml-charent.el Mon Aug 13 08:45:50 2007 +0200 @@ -0,0 +1,120 @@ +;;;; psgml-charent.el +;;; Last edited: Mon Nov 28 22:18:09 1994 by lenst@lysistrate (Lennart Staflin) +;;; $Id: psgml-charent.el,v 1.1.1.1 1996/12/18 03:35:18 steve Exp $ + +;; Copyright (C) 1994 Lennart Staflin + +;; Author: Steinar Bang, Falch Hurtigtrykk as., Oslo, 940711 +;; Lennart Staflin <lenst@lysator.liu.se> +;; +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License +;; as published by the Free Software Foundation; either version 2 +;; of the License, or (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + + +;;;; Commentary: + +;; Functions to convert character entities into displayable characters +;; and displayable characters back into character entities. + + +;;;; Code: + +(provide 'psgml-charent) + + +;;;; Variable declarations + +(defvar sgml-display-char-list-filename + (expand-file-name sgml-data-directory "iso88591.map") + "*Name of file holding relations between character codes and character +names of displayable characters") + +(defvar sgml-display-char-alist-cache nil) + + +;;;; Function declarations + +(defun sgml-display-char-alist () + "Return the current display character alist. +Alist with entity name as key and display character as content." + (unless (file-exists-p sgml-display-char-list-filename) + (error "No display char file: %s" + sgml-display-char-list-filename)) + (sgml-cache-catalog sgml-display-char-list-filename + 'sgml-display-char-alist-cache + (function sgml-read-display-char-alist))) + +(defun sgml-read-display-char-alist () + (let (key disp-char alist) + (while (re-search-forward "^\\([0-9]+\\)[ \t]+\\(.+\\)$" nil t) + (setq key (buffer-substring (match-beginning 2) (match-end 2))) + (setq disp-char + (char-to-string + (string-to-number + (buffer-substring (match-beginning 1) (match-end 1))))) + (push (cons key disp-char) + alist)) + alist)) + +(defun sgml-charent-to-dispchar-alist () + "Association list to hold relations of the type + (CHARACTER-NAME . CHARACTER) + where + CHARACTER-NAME is a string holding a character name + CHARACTER is a string holding a single displayable character" + (sgml-need-dtd) + (let ((display-chars (sgml-display-char-alist)) + (alist nil)) + (sgml-map-entities + (function + (lambda (entity) + (let ((char (cdr (assoc (sgml-entity-text entity) + display-chars)))) + (when char + (push (cons (sgml-entity-name entity) char) alist))))) + (sgml-dtd-entities sgml-dtd-info)) + + alist)) + + +(defun sgml-charent-to-display-char () + "Replace character entities with their display character equivalents" + (interactive) + (let ((charent-to-char + (sgml-charent-to-dispchar-alist)) + charent replacement) + (save-excursion + (goto-char (point-min)) + (sgml-with-parser-syntax + (while (re-search-forward "&\\(\\w\\(\\w\\|\\s_\\)+\\);?" nil t) + (setq charent (buffer-substring (match-beginning 1) (match-end 1))) + (if (setq replacement (cdr (assoc charent charent-to-char))) + (replace-match replacement t t))))))) + +(defun sgml-display-char-to-charent () + "Replace displayable characters with their character entity equivalents" + (interactive) + (let ((case-fold-search nil)) + (save-excursion + (loop for pair in (sgml-charent-to-dispchar-alist) + do (goto-char (point-min)) + (while (search-forward (cdr pair) nil t) + (replace-match (concat "&" (car pair) ";") t t)))))) + + + + +(require 'psgml-parse) + +;;; psgml-charent.el ends here