Source

latin-unity / latin-unity-tests.el

stephent 3ca4871 


























































































stephent 57dbe9a 
stephent 3ca4871 
stephent 57dbe9a 
stephent 3ca4871 



stephent 57dbe9a 
stephent 3ca4871 


stephent 57dbe9a 
stephent 3ca4871 
stephent 57dbe9a 
stephent 3ca4871 
stephent 57dbe9a 
stephent 3ca4871 

stephent 57dbe9a 
stephent 3ca4871 

stephent 57dbe9a 




stephent 3ca4871 





















;;; latin-tests-unity.el ---  Test the latin-unity package

;; Copyright (C) 2002 Free Software Foundation, Inc

;; Author: Stephen J. Turnbull
;; Keywords: mule, charsets
;; Created: 2002 October 20
;; Last-modified: 2002 October 20

;; This file is part of XEmacs.

;; XEmacs 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.

;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.


;;; Commentary:

;; Mule bogusly considers the various ISO-8859 extended character sets
;; as disjoint, when ISO 8859 itself clearly considers them to be subsets
;; of a larger character set.  The latin-unity package provides functions
;; which determine the list of coding systems which can encode all of the
;; characters in the buffer.  This library tests the functionality.

;;  Requires mule-ucs, but easy to generalize.

;; 

;;; Code:

(defconst latin-unity-was-active
  (memq 'latin-unity-sanity-check write-region-pre-hook))

(unless latin-unity-was-active (latin-unity-install))

;; save variables we intend to trash
(put 'latin-unity-test 'ucs-list latin-unity-ucs-list)
(put 'latin-unity-test 'preapproved
     latin-unity-preapproved-coding-system-list)
(put 'latin-unity-test 'preferred
     latin-unity-preferred-coding-system-list)
(put 'latin-unity-test 'default buffer-file-coding-system)

(unwind-protect
    (progn
      (with-temp-buffer
	(setq latin-unity-preapproved-coding-system-list '(buffer-default))
	;; #### need to check error conditions and stuff too
	;; Successful remapping
	(mapc (lambda (test)
		;; The way we should do the successful tests is to have
		;; two coding systems, the buffer's current one, and the
		;; target.  We set/bind preapproved-coding-system-list to
		;; the target.
		;; better yet, target should be the preapproved list
		(let ((current (car test))
		      (target (cadr test))
		      (string (caddr test)))
		  (setq buffer-file-coding-system current)
		  (setq latin-unity-preapproved-coding-system-list
			(list target))
		  (goto-char (point-max))
		  (let ((a (point)))
		    (insert string)
		    (let ((b (point))
			  (coding-system-for-read target))
		      (insert "\n")
		      (write-region a b "/tmp/test-latin-unity")
		      (goto-char (+ (point)
				    (second (insert-file-contents
					     "/tmp/test-latin-unity"))))
		      (eval
		       `(Assert (string= ,(buffer-substring a b)
					 ,(buffer-substring (1+ b)
							    (point)))))))))
	      (list
	       ;; Erwan David's example
	       (list 'iso-8859-1 'iso-8859-15
		     (format "test accentu%c, avec %curo."
			     ;; LATIN SMALL LETTER E WITH ACUTE 
			     (make-char 'latin-iso8859-1 #xE9)
			     ;; EURO SIGN
			     (make-char 'latin-iso8859-15 #xA4)))
	       ;; We had problems with plain Latin-1 :-(
	       (list 'iso-8859-1 'iso-8859-1
		     (format "Ville Skytt%c  <ville.skytta@xemacs.org>"
			     ;; LATIN SMALL LETTER A WITH DIAERESIS
			     (make-char 'latin-iso8859-1 #xE4)))
	       (list 'iso-8859-1 'iso-8859-2
		     (format "f%cr Hrvoje Nik%ci%c"
			     ;; LATIN SMALL LETTER U WITH DIAERESIS
			     (make-char 'latin-iso8859-1 #xFC)
			     ;; LATIN SMALL LETTER S WITH CARON
			     (make-char 'latin-iso8859-2 #xB9)
			     ;; LATIN SMALL LETTER C WITH ACUTE
			     (make-char 'latin-iso8859-2 #xE6)))
	       (list 'iso-8859-1 'utf-8
		     (format "f%cr Hrvoje, %cclept Nik%ci%c"
			     ;; LATIN SMALL LETTER U WITH DIAERESIS
			     (make-char 'latin-iso8859-1 #xFC)
			     ;; LATIN SMALL LETTER Y WITH DIAERESIS
			     (make-char 'latin-iso8859-1 #xFF)
			     ;; LATIN SMALL LETTER S WITH CARON
			     (make-char 'latin-iso8859-2 #xB9)
			     ;; LATIN SMALL LETTER C WITH ACUTE ACCENT
			     (make-char 'latin-iso8859-2 #xE6)))
	       )
	     ))

      ;; do interactive tests
      (when (interactive-p)
	(message "No interactive tests yet."))

      )

  ;; unwind forms

  ;; restore variables we trashed
  (setq latin-unity-ucs-list (get 'latin-unity-test 'ucs-list))
  (setq latin-unity-preapproved-coding-system-list
	(get 'latin-unity-test 'preapproved))
  (setq latin-unity-preferred-coding-system-list
	(get 'latin-unity-test 'preferred))
  (setq buffer-file-coding-system (get 'latin-unity-test 'default))

  ;; conditionally uninstall
  (unless latin-unity-was-active (latin-unity-uninstall)))

;;; end of latin-unity-tests.el