;; Mule tools utility
;;
;; Copyright (C) 1992 Free Software Foundation, Inc.
;; This file is part of Mule (MULtilingual Enhancement of GNU Emacs).

;; Mule is free software distributed in the form of patches to GNU Emacs.
;; 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 1, or (at your option)
;; any later version.

;; Mule 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 GNU Emacs; see the file COPYING.  If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.

;;; 96.3.3 created for Mule Ver. 2.3 by S.Tomura <tomura@etl.go.jp>

(defvar m2ps-util-version "0.08")
;;; Last modified date: Mon Mar  4 15:36:25 1996

(defun m2ps-get-system-font-files ()
  "$DATA-DIRECTORY/CHARSETS を解析し、leading-char と font-file の対応表をつくる。"
  (let ((buffer (generate-new-buffer "*charsets*"))
	(result (make-vector 256 nil)))
    (set-buffer buffer)
    (erase-buffer)
    (insert-file-contents (concat data-directory "CHARSETS"))
    (goto-char (point-min))
    (while (re-search-forward 
	    "^\\([0-9]+\\):[^:\n]+:[0-9]+:[0-9]+:[0-9]+:[0-9]+:[0-9]+:[^:\n]+:\\(.+\\)$"
	    nil t)
      (aset result 
	    (car (read-from-string (buffer-substring (match-beginning 1)
						      (match-end 1))))
	    (buffer-substring (match-beginning 2)
			      (match-end 2)))
      )
    (kill-buffer buffer)
    result))

(defconst *m2ps-system-font-files* (m2ps-get-system-font-files)
  "System が使用する leading-char と font-file の対応表")

(defconst *m2ps-user-font-files* (make-vector 256 nil)
  "user が追加した leading-char と font-file の対応表")

(defun m2ps-initialize-user-font-files ()
  (let ((lc 0))
    (while (< lc 256)
      (aset *m2ps-user-font-files* lc nil)
      (setq lc (1+ lc)))))

;;;###autoload
(defun set-charset-font-file (lc fontfile &optional encoding)
  (if (and (numberp lc)
	   (<= 0 lc)
	   (< lc 256)
	   (character-set lc)
	   (stringp fontfile)
	   (or (null encoding)
	       (numberp encoding)))
      (progn
	(aset *m2ps-user-font-files*
	      lc
	      (if encoding
		  (format "%s:%d" fontfile encoding)
		fontfile))
	t)
    nil))

	
;;;###autoload
(defun unset-charset-font-file (lc)
  (if (and (numberp lc)
	   (<= 0 lc)
	   (< lc 256))
      (aset *m2ps-user-font-files*
	    lc
	    nil))
  t)
	   
(defun charset-font-file (lc)
  (or (aref *m2ps-user-font-files*
	    lc)
      (aref *m2ps-system-font-files*
	    lc)))

;;;###autoload
(defun m2ps-dump-user-configuration (CHARSETS CODINGS)
  (m2ps-dump-charsets CHARSETS)
  (m2ps-dump-codings CODINGS))

;;;###autoload
(defun m2ps-dump-charsets (CHARSETS)
  (let ((buffer (generate-new-buffer "*m2ps*")))
    (let ((standard-output buffer)
	  (charset-other-info-func (function charset-font-file)))
      (print-character-sets))
    (set-buffer buffer)
    (write-file CHARSETS)
    (kill-buffer buffer)))

;;;###autoload
(defun m2ps-dump-codings (CODINGS)
  (let ((buffer (generate-new-buffer "*m2ps*")))
    (let ((standard-output buffer))
      (print-all-coding-systems))
    (set-buffer buffer)
    (write-file CODINGS)
    (kill-buffer buffer)))
