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