;;; pure-cs.el --- Generic function and loader for PURE coding-system module

;; Copyright (C) 2000-2001 by Project Pure.

;; Author: SHIMADA Mitsunobu <simm@pure.fan.gr.jp>
;; Keywords: PURE, coding-system

;; $Id: pure-cs.el,v 1.7.2.1 2001/12/12 16:07:07 simm Exp $

;; This file 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, or (at your option)
;; any later version.

;; This file 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, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; PURE means "Primitive Universal Relay-chat Environment"
;; CS means coding-system

;;; Code:

(defvar pure-cs-default-coding-system 'ctext
  "Default encode coding-system")

(cond ((featurep 'xemacs)
       (require 'pure-cs-xmas))
      ((and (boundp 'emacs-major-version) (<= 20 emacs-major-version))
       (require 'pure-cs-e20))
      ((featurep 'mule)
       (require 'pure-cs-mule2))
      ((boundp 'NEMACS)
       (require 'pure-cs-nemacs))
      (t (require 'pure-cs-se)))

;; (require 'pure-cs-japanese)

(or (fboundp 'pure-cs-buffer-unibyte)
    (defun pure-cs-buffer-unibyte (&optional buf)
      "Set buffer for unibyte character."
      nil))

(or (fboundp 'pure-cs-buffer-multibyte)
    (defun pure-cs-buffer-multibyte (&optional buf)
      "Set buffer for multibyte character."
      t))

;;
;; from pure-cs-detect.el
;;

(defun pure-cs-detect-primitive (string coding)
  "Judge kind of coding system of STRING. Result is below:
  7bit string: value of `pure-cs-default-coding-system'
  8bit string: CODING"
  (if (string-match "[\015\012]" string)
      ;; Delete CR & LF
      (with-temp-buffer
	(insert string)
	(goto-char (point-min))
	(while (not (eobp))
	  (skip-chars-forward "^\015\012")
	  (while (or (eq 13 (char-after (point))) (eq 10 (char-after (point))))
	    (delete-char 1)))
	(pure-cs-detect-primitive (buffer-substring (point-min) (point-max)) coding))
    (if (string-match "^[\000-\177]+$" string) pure-cs-default-coding-system coding)))

(defun pure-cs-detect-region (beg end coding &optional func)
  "Detect coding system of the region (BEG to END).
  7bit string: value of `pure-cs-default-coding-system'
  8bit string: CODING (if CODING is non-nil)
               result of FUNC evaluation (if CODING is nil)"
  (or (pure-cs-detect-primitive (buffer-substring beg end) coding)
      (funcall func beg end)))

(defun pure-cs-detect-string (string coding &optional func)
  "Detect coding system of STRING.
  7bit string: value of `pure-cs-default-coding-system'
  8bit string: CODING (if CODING is non-nil)
               result of FUNC evaluation (if CODING is nil)"
  (or (pure-cs-detect-primitive string coding)
      (with-temp-buffer
	(pure-cs-buffer-unibyte)
	(insert string)
	(funcall func (point-min) (point-max)))))

;;
;; decode method
;;

(defconst pure-cs-iso2022-short-regexp  "[\116\117\176]")
(defconst pure-cs-iso646-ank-regexp "\050[\100-\175]")
(defvar pure-cs-hiding-char ?*)

(defun pure-cs-hide-region (beg end &optional char)
  "Hide escape-sequenced code from region.
Hidden code are displayed as CHAR or `pure-cs-hiding-char'"
  (let (pt)
    (save-excursion
      (goto-char beg)
      (narrow-to-region beg end)
      (while (re-search-forward "\033" nil t)
	(if (null pt)
	    (setq pt (1- (point)))
	  (if (looking-at pure-cs-iso646-ank-regexp)
	      (let ((tmpstr
		     (decode-coding-string (buffer-substring pt (match-end 0))
					   (if (featurep 'xemacs) 'ctext 'x-ctext)))
		    (nchars (if pt (- (match-end 0) pt) 3)))
		(goto-char pt)
		(delete-char nchars)
		(insert (make-string nchars (or char pure-cs-hiding-char)))
		(add-text-properties pt (point) (list 'pure-cs-decode tmpstr) (current-buffer))
		(setq pt nil nchars nil))))))))

(defun pure-cs-unhide-region (beg end coding)
  "Decode region with coding-system CODING, with text-property retains."
  (let (pt tmpstr (result ""))
    (save-excursion
      (goto-char beg)
      (narrow-to-region beg end)
      (pure-cs-hide-region beg end)
      (while (not (eobp))
	(goto-char (or (next-property-change (setq pt (point))) (point-max)))
	(setq result (concat result
			     (or (get-text-property pt 'pure-cs-decode)
				 (decode-coding-string (buffer-substring pt (point)) coding))))
	(delete-region pt (point)))
      (pure-cs-buffer-multibyte)
      (insert result)
      (prog1 result
	(pure-cs-buffer-unibyte)))))
	    
(defun pure-cs-unhide-string (string coding)
  "Decode STRING with coding-system CODING, with text-property retains."
  (with-temp-buffer
    (pure-cs-buffer-unibyte)
    (insert string)
    (pure-cs-decode-region (point-min) (point-max) coding)))

;; That's all
(provide 'pure-cs)

;;; pure-cs.el ends here