;;;; psgml-charent.el
;;; Last edited: Mon Nov 28 22:18:09 1994 by lenst@lysistrate (Lennart Staflin)
;;; $Id: psgml-charent.el,v 1.2 1994/12/04 13:55:04 lenst Released $

;; 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)
(require 'psgml-parse)


;;;; Variable declarations

(defvar sgml-display-char-list-filename
  "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))))))



;;; psgml-charent.el ends here
