1 ;;; latin-tests-unity.el --- Test the latin-unity package
3 ;; Copyright (C) 2002 Free Software Foundation, Inc
5 ;; Author: Stephen J. Turnbull
6 ;; Keywords: mule, charsets
7 ;; Created: 2002 October 20
8 ;; Last-modified: 2002 October 20
10 ;; This file is part of XEmacs.
12 ;; XEmacs is free software; you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation; either version 2, or (at your option)
17 ;; XEmacs is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with XEmacs; see the file COPYING. If not, write to the
24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25 ;; Boston, MA 02111-1307, USA.
30 ;; Mule bogusly considers the various ISO-8859 extended character sets
31 ;; as disjoint, when ISO 8859 itself clearly considers them to be subsets
32 ;; of a larger character set. The latin-unity package provides functions
33 ;; which determine the list of coding systems which can encode all of the
34 ;; characters in the buffer. This library tests the functionality.
36 ;; Requires mule-ucs, but easy to generalize.
42 (defconst latin-unity-was-active
43 (memq 'latin-unity-sanity-check write-region-pre-hook))
45 (unless latin-unity-was-active (latin-unity-install))
47 ;; save variables we intend to trash
48 (put 'latin-unity-test 'ucs-list latin-unity-ucs-list)
49 (put 'latin-unity-test 'preapproved
50 latin-unity-preapproved-coding-system-list)
51 (put 'latin-unity-test 'preferred
52 latin-unity-preferred-coding-system-list)
53 (put 'latin-unity-test 'default buffer-file-coding-system)
58 (setq latin-unity-preapproved-coding-system-list '(buffer-default))
59 ;; #### need to check error conditions and stuff too
60 ;; Successful remapping
62 ;; The way we should do the successful tests is to have
63 ;; two coding systems, the buffer's current one, and the
64 ;; target. We set/bind preapproved-coding-system-list to
66 ;; better yet, target should be the preapproved list
67 (let ((current (car test))
69 (string (caddr test)))
70 (setq buffer-file-coding-system current)
71 (setq latin-unity-preapproved-coding-system-list
73 (goto-char (point-max))
77 (coding-system-for-read target))
79 (write-region a b "/tmp/test-latin-unity")
81 (second (insert-file-contents
82 "/tmp/test-latin-unity"))))
84 `(Assert (string= ,(buffer-substring a b)
85 ,(buffer-substring (1+ b)
88 ;; Erwan David's example
89 (list 'iso-8859-1 'iso-8859-15
90 (format "test accentu%c, avec %curo."
91 ;; LATIN SMALL LETTER E WITH ACUTE
92 (make-char 'latin-iso8859-1 #xE9)
94 (make-char 'latin-iso8859-15 #xA4)))
95 ;; We had problems with plain Latin-1 :-(
96 (list 'iso-8859-1 'iso-8859-1
97 (format "Ville Skytt%c <ville.skytta@xemacs.org>"
98 ;; LATIN SMALL LETTER A WITH DIAERESIS
99 (make-char 'latin-iso8859-1 #xE4)))
100 (list 'iso-8859-1 'iso-8859-2
101 (format "f%cr Hrvoje Nik%ci%c"
102 ;; LATIN SMALL LETTER U WITH DIAERESIS
103 (make-char 'latin-iso8859-1 #xFC)
104 ;; LATIN SMALL LETTER S WITH CARON
105 (make-char 'latin-iso8859-2 #xB9)
106 ;; LATIN SMALL LETTER C WITH ACUTE
107 (make-char 'latin-iso8859-2 #xE6)))
108 (list 'iso-8859-1 'utf-8
109 (format "f%cr Hrvoje, %cclept Nik%ci%c"
110 ;; LATIN SMALL LETTER U WITH DIAERESIS
111 (make-char 'latin-iso8859-1 #xFC)
112 ;; LATIN SMALL LETTER Y WITH DIAERESIS
113 (make-char 'latin-iso8859-1 #xFF)
114 ;; LATIN SMALL LETTER S WITH CARON
115 (make-char 'latin-iso8859-2 #xB9)
116 ;; LATIN SMALL LETTER C WITH ACUTE ACCENT
117 (make-char 'latin-iso8859-2 #xE6)))
121 ;; do interactive tests
122 (when (interactive-p)
123 (message "No interactive tests yet."))
129 ;; restore variables we trashed
130 (setq latin-unity-ucs-list (get 'latin-unity-test 'ucs-list))
131 (setq latin-unity-preapproved-coding-system-list
132 (get 'latin-unity-test 'preapproved))
133 (setq latin-unity-preferred-coding-system-list
134 (get 'latin-unity-test 'preferred))
135 (setq buffer-file-coding-system (get 'latin-unity-test 'default))
137 ;; conditionally uninstall
138 (unless latin-unity-was-active (latin-unity-uninstall)))
140 ;;; end of latin-unity-tests.el