Tcl Japanization Patch This file is a patch for Tcl7.6 to be Japanized. The Japanization of Tcl7.6 for windows version is done by Mr. Hiroaki NAKAMURA, and the Japanization for mac version is not done, yet. This patch kit contains: + Modifications to the Tcl7.6 source code - Tcl interpreter is modified so that scripts containing kanji are parsed and executed correctly. + Some new tcl commands for handling Japanese text. + A document describing the specification of the kanji handling in Tcl (both Japanese and English version are provided for your convenience). See the documents included in this patch for details. To apply this patch, you should cd to the top directory of the Tcl7.6 source tree (the directory containing tcl*.c files), and do: patch -p < thisFile This patch creates following directory and files: README.JP changes.JP doc.jp/ doc.jp/README doc.jp/TclJP.man doc.jp/TclJP.jman generic/tclKanjiUtil.c tests/kanji.euc tests/kanji.jis tests/kanji.sjis tests/kanji.test If you are using a symbolic link tree, you will need to create new links. Building process of the Japanized version is the same as the original one. See README.JP and README files, and follow the instructions. There is a document describing this Japanization in doc.jp directory. You may want to read it before building. If you find any problems in applying patch, compiling or whatever it is, send a report to "tcl-jp-bugs@sra.co.jp". Please don't forget to include a brief description of your environment such as your machine type and OS version. If you have any questions about Tcl7.6jp for Windows version, please send an e-mail to Mr. Hiroaki NAKAMURA (hnakamur@da2.so-net.or.jp) directly. Yoshiyuki Nishinaka (nisinaka@sra.co.jp) Makoto Ishisone (ishisone@sra.co.jp) Hiroshi Sako (sakoh@sra.co.jp) Software Research Associates, Inc. diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tcl7.6/README.JP ./README.JP *** ../tcl7.6/README.JP Thu Jan 1 09:00:00 1970 --- ./README.JP Fri Oct 18 13:14:02 1996 *************** *** 0 **** --- 1,78 ---- + The Japanization of Tcl + + by Yoshiyuki Nishinaka (nisinaka@sra.co.jp) + Makoto Ishisone (ishisone@sra.co.jp) + Hiroshi Sako (sakoh@sra.co.jp) + Software Research Associates, Inc. + + + 1. Introduction + --------------- + + Here we provide a patch kit for enabling Tcl to handle Japanese characters + (kanji). + + The patch kit contains: + + + Modifications to the Tcl source code + - Tcl interpreter is modified so that scripts containing kanji are + parsed and executed correctly. + + Some new tcl commands for handling Japanese text. + + A document describing the specification of the kanji handling in Tcl + (Both Japanese and English versions are provided for your convenience). + + A Japanese translation of Tcl language manuals. + + The Japanization is self-contained -- it doesn't require any + internationalization support of the OS (i.e. no mb* and wc* routines are + needed) nor the Window system (so it should be compiled and run on + X11R4... not tested, though). + + + 2. Some selected features + ------------------------- + + The Japanization includes the following features: + + + The Tcl interpreter automatically recognizes the type of kanji code, so + users do not have to worry about the kanji code of scripts. + + New Tcl commands for handling kanji I/O code and kanji strings. + + Please refer to the document for details. + + + 3. Compile & Installation + ------------------------- + + Just follow the steps of the original Tcl. + + Note that this Japanization requires one additional compiler flags (-DKANJI). + So if you don't use `configure` to generate the default Makefile (i.e. using + customized one), don't forget to modify it accordingly. + + No library file (usually installed in "/usr/local/lib/tcl") is modified for + the Japanization. So any scripts for the original version can also work with + the libraries of this Japanized Tcl. + + + 4. Test + ------- + + We provide a test suite 'tcl/tests/kanji.test' for the Japanized Tcl. + + + 5. Acknowledgment + ----------------- + + Special thanks to Mr. Hiroaki NAKAMURA (hnakamur@da2.so-net.or.jp) for + contributing the Japanization patches for Windows version. + + + 6. Bug report + ------------- + + Please report comments & bugs via e-mail to: + + tcl-jp-bugs@sra.co.jp + + Please don't forget to include a brief description of your environment + such as your machine type, OS version or X library version. diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tcl7.6/changes.JP ./changes.JP *** ../tcl7.6/changes.JP Thu Jan 1 09:00:00 1970 --- ./changes.JP Sun Nov 24 14:53:09 1996 *************** *** 0 **** --- 1,88 ---- + Release tcl7.6jp, November 24, 1996 + + (new release) Modified for the Tcl7.6. + + (new release) Modified for the Tcl7.5p1. + + (feature change) Eliminated exported global variables (they don't work with + Windows DLLs). The arrays of Kanji Encode/Decode functions (Tcl_KanjiEncode + and Tcl_KanjiDecode) are replaced with C functions (Tcl_KanjiEncode() and + Tcl_KanjiDecode()). + + Release tcl7.5jp_alpha, April 25, 1996 + + (new release) Modified for the Tcl7.5. + + (new feature) A set of patches for Windows is contributed from + Mr. Hiroaki NAKAMURA. + + (new release) Modified for the Tcl7.5b3. + + (new release) Modified for the Tcl7.5b1. + + (new release) Modified for the Tcl7.5a2. + + Release tcl7.4p3jp, December 11, 1995 + + Release tcl7.4jp, September 25, 1995 + + (bug fix) A comment line will be continued if the last character of + the line is a kanji which second byte is '\'. + + (bug fix) KANJI was always defined in tclKanjiUtil.c. + + Release tcl7.4jp-beta, August 1, 1995 + + Release tcl7.4jp-alpha, July 12, 1995 + + (new release) Some modifications according to the new release. + + Release tcl7.3jp-update3, May 24, 1995 + + (documentation error) Modified some doc.jp files. + + (bug fix) Fixed a bug in TclWordEnd where it couldn't find an end of + a word if it contains a kanji character with some special characters + like '{' or '['. + + Release tcl7.3jp-update2, August 25, 1994 + + (documentation error) Typo in doc.jp/library.n. + + (bug fix) Fixed bug in Tcl_ParseVar where it couldn't parse kanji + variable name properly. + + Release tcl7.3jp-update1, February 14, 1994 + + (feature change) Changed default JIS encoding to use ESC-(-B for ASCII + character set. + + (bug fix & new feature) Added Tcl_KanjiEnd function to find a string + ends with a kanji character or not. The problem occured when a kanji + string ends with the specical character '{'. In some places, like + Tcl_AppendElement, '{' was treated as a beginning of a list even if it + was the last character of a kanji string. + + (bug fix) The second file descriptor for a pipe was not registered to + the arrary 'tclOpenFiles'. This caused a core dump when you open a + command and try to 'puts' kanji strings. + + Release tcl7.3jp, December 7, 1993 + + (new feature) Modified tclUtil.c to behave like the original Tcl when + the current locale is set to 'C'. In this case, the kanji handling is + disabled. + + (configuration change) Eliminated 'ctype-fix.h': this file was introduced + to fix the bug in the original Tcl/Tk. Since the bug fix is incorporated + into the original source code, this local bug fix is no longer needed. + + (bug fix) Fixed bug in TclCopyAndCollaspe where it deletes '\' in kanji + strings. + + (document translation) Supplied several translations of man pages since + Tcl.n was broken into pieces. + + Release tk3.2jp-update1, August 26, 1993 + + Release tk3.2jp, July 9, 1993 diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tcl7.6/doc.jp/README ./doc.jp/README *** ../tcl7.6/doc.jp/README Thu Jan 1 09:00:00 1970 --- ./doc.jp/README Fri Oct 18 13:14:03 1996 *************** *** 0 **** --- 1,11 ---- + This directory contains the following documents: + + TclJP.man -- overview of the Tcl Japanization (written in English) + TclJP.jman -- overview of the Tcl Japanization (written in Japanese) + + Note: + + + The Japasese documents (TclJP.jman and *.n) are encoded in EUC kanji code. + + All documents need man.macros which resides in doc directory, + so you may need to do "ln -s ../doc/man.macros ." before processing + with troff or nroff. diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tcl7.6/doc.jp/TclJP.jman ./doc.jp/TclJP.jman *** ../tcl7.6/doc.jp/TclJP.jman Thu Jan 1 09:00:00 1970 --- ./doc.jp/TclJP.jman Fri Oct 18 13:14:03 1996 *************** *** 0 **** --- 1,200 ---- + '\" + '\" Copyright (c) 1993 Software Research Associates, Inc. + '\" Permission to use, copy, modify, and distribute this software and its + '\" documentation for any purpose and without fee is hereby granted, provided + '\" that the above copyright notice appear in all copies and that both that + '\" copyright notice and this permission notice appear in supporting + '\" documentation, and that the name of Software Research Associates not be + '\" used in advertising or publicity pertaining to distribution of the + '\" software without specific, written prior permission. Software Research + '\" Associates makes no representations about the suitability of this software + '\" for any purpose. It is provided "as is" without express or implied + '\" warranty. + '\" + '\" $Id: TclJP.jman,v 1.1 1996/03/29 08:21:46 nisinaka Exp $ + ' + .so man.macros + .de UL + \\$1\l'|0\(ul'\\$2 + .. + .HS TclJP tcl + .if n .na + .BS + .SH "̾Á°" + TclJapanization \- overview of Tcl Japanization + .BE + + .SH "¤Ï¤¸¤á¤Ë" + ¤³¤Î¥É¥­¥å¥á¥ó¥È¤Ç¤Ï Tcl ¤ËÂФ·¤Æ¹Ô¤Ã¤¿ÆüËܸ첽¤Î³µÍפòÀâÌÀ¤·¤Þ¤¹¡£ + ÆüËܸ첽¤Îºî¶È³µÍפϼ¡¤ÎÄ̤ê¤Ç¤¹¡£ + .RS + .nf + + ¡¦¥¹¥¯¥ê¥×¥È¤ËÆüËܸì¤ò½ñ¤¯¤³¤È¤¬¤Ç¤­¤ë¡£ + ¡¦ÆüËܸì¤Îʸ»úÎó¤ò°·¤¦¤¿¤á¤Î Tcl ¥³¥Þ¥ó¥É¤ÎÄɲᣠ+ + .fi + .RE + ÆüËܸ첽¤Ï + ¡Ö¤Ç¤­¤ë¤À¤±´Á»ú¥³¡¼¥É¤Ê¤ÉºÙ¤«¤¤¤³¤È¤ò°Õ¼±¤»¤º¤Ë + »È¤¦¤³¤È¤¬¤Ç¤­¤ë¤è¤¦¤Ë¤¹¤ë¡×¡¢¡Ö¥ª¥ê¥¸¥Ê¥ëÈÇÍѤˤ«¤«¤ì¤¿¥¹¥¯¥ê¥×¥È¤â + ¤Ç¤­¤ë¤À¤±¤½¤Î¤Þ¤ÞÆ°ºî¤¹¤ë¤è¤¦¤Ë¤¹¤ë¡×¤È¤¤¤¦Êý¿Ë¤Î¤â¤È¤Ë + ¹Ô¤¤¤Þ¤·¤¿¡£ + ' + .SH "´Á»ú¥³¡¼¥É" + Tcl ¤Î¥¹¥¯¥ê¥×¥È¤Ë´Á»ú¤ò´Þ¤ó¤ÀÆüËܸì¤Îʸ»úÎó¤ò½ñ¤¯¤³¤È¤¬¤Ç¤­¤Þ¤¹¡£ + ´Á»ú¥³¡¼¥É¤Ï JIS¡¢EUC¡¢¥·¥Õ¥ÈJIS ¤Î 3¼ïÎà¤ò¥µ¥Ý¡¼¥È¤·¤Þ¤¹¡£ + ¤¿¤À¤·¤¤¤ï¤æ¤ë¡ÖȾ³Ñ¤«¤Ê¡×¤Ï»È¤¨¤Þ¤»¤ó¡£ + .PP + ¥¹¥¯¥ê¥×¥È¤òÆɤàºÝ¤Ë»ÈÍѤµ¤ì¤Æ¤¤¤ë´Á»ú¥³¡¼¥É¤ò¼«Æ°È½Äꤹ¤ë¤Î¤Ç¡¢ + ¥¹¥¯¥ê¥×¥È¤Î´Á»ú¥³¡¼¥É¤ò¤¢¤é¤«¤¸¤á»ØÄꤹ¤ëɬÍפϤ¢¤ê¤Þ¤»¤ó¤·¡¢ + °Û¤Ê¤ë´Á»ú¥³¡¼¥É¤Î¥¹¥¯¥ê¥×¥È¥Õ¥¡¥¤¥ë¤òº®¤¼¤Æ¤âÌäÂꤢ¤ê¤Þ¤»¤ó¡£ + ¸½ºß¤Î¼ÂÁõ¤Ç¤Ï°ì¤Ä¤Î¥¹¥¯¥ê¥×¥È¥Õ¥¡¥¤¥ëÃæ¤Ç°Û¤Ê¤ë´Á»ú¥³¡¼¥É¤òº®¤¼¤Æ + »ÈÍѤ¹¤ë¤³¤È¤Þ¤Ç¤Ç¤­¤ë¤è¤¦¤Ë¤Ê¤Ã¤Æ¤¤¤Þ¤¹¤¬¡¢ + ¤³¤Î¤è¤¦¤Ê¤³¤È¤Ï¤·¤Ê¤¤¤è¤¦¤Ë¤·¤Æ¤¯¤À¤µ¤¤¡£ + .PP + ¥¹¥¯¥ê¥×¥È¤ÏÆɤ߹þ¤ß¤ÎºÝ¡¢¼«Æ°Åª¤ËÆÃÄê¤Î´Á»ú¥³¡¼¥É¤ËÊÑ´¹¤µ¤ì¤Þ¤¹¡£ + ¤³¤Î´Á»ú¥³¡¼¥É¤Î¤³¤È¤ò¡ÖÆâÉô¥³¡¼¥É¡×¤È¸Æ¤Ó¤Þ¤¹¡£ + ¤Þ¤¿¤½¤ì¤È¤ÏÆÈΩ¤Ë¡¢¥Õ¥¡¥¤¥ëÆþ½ÐÎÏ»þ¤Î¥³¡¼¥É¤òÀßÄꤹ¤ë¤³¤È¤¬¤Ç¤­¤Þ¤¹¡£ + .TP 4 + ÆâÉô¥³¡¼¥É + ¥¹¥¯¥ê¥×¥È¤ÎÆɤ߹þ¤ß¤ÎºÝ¡¢Ê¸»úÎó¤Ï¤½¤ì¤¬¤É¤ó¤Ê´Á»ú¥³¡¼¥É¤Ç¤¢¤Ã¤¿¤È¤·¤Æ¤â + ¼«Æ°Åª¤ËÆÃÄê¤Î´Á»ú¥³¡¼¥É¤ËÊÑ´¹¤µ¤ì¤Þ¤¹¡£°Ê¹ß Tcl ¤Ï¤³¤Î´Á»ú¥³¡¼¥É¤ò + »ÈÍѤ·¤Æ½èÍý¤ò¹Ô¤¤¤Þ¤¹¡£¤³¤Î´Á»ú¥³¡¼¥É¤Î¤³¤È¤ò¡ÖÆâÉô¥³¡¼¥É¡×¤È¸Æ¤Ó¤Þ¤¹¡£ + ÆâÉô¥³¡¼¥É¤Ë¤â JIS¡¢EUC¡¢¥·¥Õ¥ÈJIS ¤¬¤¢¤ê¡¢¤³¤ì¤Ïµ¯Æ°»þ¤Î´Ä¶­ÊÑ¿ô + .B LANG + ¤ÎÃͤˤè¤Ã¤Æ·è¤Þ¤ê¤Þ¤¹¡£¤Þ¤¿¸å½Ò¤¹¤ë \fBkanji internalCode\fP ¥³¥Þ¥ó¥É¤Ë¤è¤Ã¤Æ + Êѹ¹¤¹¤ë¤³¤È¤¬²Äǽ¤Ç¤¹¡£ + .br + ¤¿¤À¤·Æ°ºîÅÓÃæ (¤â¤Ã¤ÈÀµ³Î¤Ë¤¤¤¦¤È¡¢ÆüËܸì¤ò 1ʸ»ú¤Ç¤âÆɤ߹þ¤ó¤À¤¢¤È) ¤Ç + ÆâÉô¥³¡¼¥É¤òÊѤ¨¤ë¤È¡¢¤½¤ì¤Þ¤Ç¤ËÆɤ߹þ¤ó¤ÀÉôʬ¤¬¤ª¤«¤·¤¯¤Ê¤ê¤Þ¤¹¤Î¤Ç + µ¤¤ò¤Ä¤±¤Æ¤¯¤À¤µ¤¤¡£ÆâÉô¥³¡¼¥É¤Ï¤Ç¤­¤ë¤«¤®¤êÊѹ¹¤»¤º¡¢¤É¤¦¤·¤Æ¤â + Êѹ¹¤·¤¿¤¤¤È¤­¤Ë¤Ï¥¹¥¯¥ê¥×¥È¤ÎÀèƬ¤ÇÊѹ¹¤¹¤ë¤Î¤¬ÌµÆñ¤Ç¤¹¡£ + .br + Tcl ÆâÉô¤Ç¤ÏÆüËܸì¤ÏÁ´¤Æ¤³¤ÎÆâÉô¥³¡¼¥É¤Ç°·¤ï¤ì¤ë¤¿¤á¡¢ + Tcl ¥³¥Þ¥ó¥É¤Î¼Â¹Ô·ë²Ì¤ä¥Õ¥¡¥¤¥ëÅù¤Ø¤Î½ÐÎϤˤϥե¡¥¤¥ëÆþ½ÐÎÏ¥³¡¼¥É¤ò + ÀßÄꤷ¤Ê¤¤¤«¤®¤ê¥Ç¥Õ¥©¥ë¥È¤Ç¤³¤Î¥³¡¼¥É¤¬»ÈÍѤµ¤ì¤ë¤³¤È¤Ë¤Ê¤ê¤Þ¤¹¡£ + .TP 4 + ¥Õ¥¡¥¤¥ëÆþÎÏ¥³¡¼¥É + Tcl ¥³¥Þ¥ó¥É \fBgets\fP ¤Çʸ»úÎó¤òÆþÎϤ¹¤ëºÝ¤Ë´Á»ú¥³¡¼¥É¤òÊÑ´¹¤·¤Æ + Æɤ߹þ¤à¤³¤È¤¬¤Ç¤­¤Þ¤¹¡£¥Õ¥¡¥¤¥ë¤Î¸µ¤Î´Á»ú¥³¡¼¥É¤Ç¤Ï¤Ê¤¯¡¢ + ÊÑ´¹¤·¤¿·ë²Ì¤Î´Á»ú¥³¡¼¥É¤ò¥Õ¥¡¥¤¥ëÆþÎÏ¥³¡¼¥É¤È¸Æ¤Ó¤Þ¤¹¡£ + ¤³¤ì¤Ï¥Õ¥¡¥¤¥ë¤´¤È¤ËÀßÄꤹ¤ë¤³¤È¤¬¤Ç¤­¤Þ¤¹¡£ + JIS¡¢EUC¡¢¥·¥Õ¥ÈJIS ¤Î¾¡¢¡ÖÊÑ´¹¤·¤Ê¤¤¡×¤Ä¤Þ¤ê¥Õ¥¡¥¤¥ë¤ËÆþ¤Ã¤Æ¤¤¤ë + ¥Ç¡¼¥¿¤Î¤Þ¤ÞÆɤ߹þ¤à¤È¤¤¤¦»ØÄ꤬¤Ç¤­¤Þ¤¹¡£ + ¥Ç¥Õ¥©¥ë¥ÈÃͤϡÖÊÑ´¹¤·¤Ê¤¤¡×¤Ç¤¹¡£ + .TP 4 + ¥Õ¥¡¥¤¥ë½ÐÎÏ¥³¡¼¥É + Tcl ¥³¥Þ¥ó¥É \fBputs\fP ¤Çʸ»úÎó¤ò½ÐÎϤ¹¤ë»þ¤Ë»ÈÍѤµ¤ì¤ë´Á»ú¥³¡¼¥É¤Ç¤¹¡£ + ¥Õ¥¡¥¤¥ë¤´¤È¤ËÀßÄꤹ¤ë¤³¤È¤¬¤Ç¤­¤Þ¤¹¡£ + JIS¡¢EUC¡¢¥·¥Õ¥ÈJIS ¤Î¾¡¢¡ÖÊÑ´¹¤·¤Ê¤¤¡×¤Ä¤Þ¤ê¤½¤Î¤Þ¤Þ + ½ÐÎϤ¹¤ë¤È¤¤¤¦»ØÄ꤬¤Ç¤­¤Þ¤¹¡£¥Ç¥Õ¥©¥ë¥ÈÃͤϡÖÊÑ´¹¤·¤Ê¤¤¡×¤Ç¤¹¡£ + ' + .SH "ÆüËܸìʸ»úÎó½èÍý¥³¥Þ¥ó¥É" + ÆüËܸì¤ò´Þ¤ó¤Àʸ»úÎó¤ò½èÍý¤¹¤ë¤¿¤á¤Ë + .B kanji + ¥³¥Þ¥ó¥É¤¬Äɲ䵤ì¤Æ¤¤¤Þ¤¹¡£ + .TP 4 + \fBkanji\fP \fIoption\fP ?\fIarg ...\fP? + ¤³¤Î¥³¥Þ¥ó¥É¤ÏÆüËܸì¤ò´Þ¤ó¤Àʸ»úÎó¤ò½èÍý¤¹¤ë¤¿¤á¤Î¤µ¤Þ¤¶¤Þ¤ÊÁàºî¤òÄ󶡤·¤Þ¤¹¡£ + \fIoption\fR °ú¿ô¤Ç¤É¤ó¤ÊÁàºî¤ò¹Ô¤Ê¤¦¤Î¤«¤ò»ØÄꤷ¤Þ¤¹¡£ + .RS + .TP 4 + \fBkanji code \fIstring\fR + \fIstring\fR ¤Î´Á»ú¥³¡¼¥É¤òȽÄꤷ¡¢¤½¤ì¤òÊÖ¤·¤Þ¤¹¡£ + ÊÖ¤µ¤ì¤ëÃÍ¤Ï \fBJIS\fP¡¢\fBSJIS\fP¡¢\fBEUC\fP ¤Ç¤¹¡£ + \fIstring\fR ¤Ë´Á»ú¤¬´Þ¤Þ¤ì¤Æ¤¤¤Ê¤«¤Ã¤¿»þ¤Ë¤Ï "\fBANY\fP" ¤òÊÖ¤·¤Þ¤¹¡£ + .TP 4 + \fBkanji conversion \fIfrom-code\fR \fIto-code\fR \fIstring\fR + \fIfrom-code\fR ¤Çɽ¤µ¤ì¤¿´Á»úʸ»úÎó \fIstring\fR ¤ò + \fIto-code\fR ¤ËÊÑ´¹¤·¤Þ¤¹¡£ + \fIfrom-code\fR¡¢\fIto-code\fR ¤Ë»ØÄꤹ¤ë¤³¤È¤Î¤Ç¤­¤ëÃͤϡ¢ + ¤½¤ì¤¾¤ì \fBJIS\fP¡¢\fBSJIS\fP¡¢\fBEUC\fP ¤Î¤¤¤º¤ì¤«¤Ç¤¹¡£ + .TP 4 + \fBkanji defaultInputCode\fR ?\fIkanji-code\fR? + ¥Õ¥¡¥¤¥ëÆþÎÏ¥³¡¼¥É¤Î¥Ç¥Õ¥©¥ë¥ÈÃͤòÀßÄꤷ¤Þ¤¹¡£ + »ØÄê¤Ç¤­¤ëÃÍ¤Ï \fBJIS\fP¡¢\fBSJIS\fP¡¢\fBEUC\fP¡¢\fBANY\fP ¤Ç¤¹¡£ + \fBANY\fP ¤Î¾ì¹ç¤Ë¤Ï \fBgets\fP ¤Ë¤è¤ëÆɤ߹þ¤ß»þ¤ËÊÑ´¹¤µ¤ì¤Þ¤»¤ó¡£ + \fIkanji-code\fR ¤Î»ØÄ꤬¾Êά¤µ¤ì¤¿¾ì¹ç¡¢¸½ºß¤Î¥Õ¥¡¥¤¥ëÆþÎÏ¥³¡¼¥É¤Î + ¥Ç¥Õ¥©¥ë¥ÈÃͤòÊÖ¤·¤Þ¤¹¡£ + ½é´üÃͤȤ·¤Æ \fBANY\fP ¤¬ÀßÄꤵ¤ì¤Æ¤¤¤Þ¤¹¡£ + .TP 4 + \fBkanji defaultOutputCode\fR ?\fIkanji-code\fR? + ¥Õ¥¡¥¤¥ë½ÐÎÏ¥³¡¼¥É¤Î¥Ç¥Õ¥©¥ë¥ÈÃͤòÀßÄꤷ¤Þ¤¹¡£ + »ØÄê¤Ç¤­¤ëÃÍ¤Ï \fBJIS\fP¡¢\fBSJIS\fP¡¢\fBEUC\fP¡¢\fBANY\fP ¤Ç¤¹¡£ + \fBANY\fP ¤Î¾ì¹ç¤Ë¤Ï \fBputs\fP ¤Ë¤è¤ë½ÐÎÏ»þ¤ËÊÑ´¹¤µ¤ì¤Þ¤»¤ó¡£ + \fIkanji-code\fR ¤Î»ØÄ꤬¾Êά¤µ¤ì¤¿¾ì¹ç¡¢¸½ºß¤Î¥Õ¥¡¥¤¥ë½ÐÎÏ¥³¡¼¥É¤Î + ¥Ç¥Õ¥©¥ë¥ÈÃͤòÊÖ¤·¤Þ¤¹¡£ + ½é´üÃͤȤ·¤Æ \fBANY\fP ¤¬ÀßÄꤵ¤ì¤Æ¤¤¤Þ¤¹¡£ + .TP 4 + \fBkanji inputCode \fIfileId\fP ?\fIkanji-code\fR? + \fIfileId\fP ¤Ç»ØÄꤵ¤ì¤ë¥Õ¥¡¥¤¥ë¤ÎÆþÎÏ¥³¡¼¥É¤ò \fIkanji-code\fR ¤Ë + ÀßÄꤷ¤Þ¤¹¡£ + \fIkanji-code\fR ¤Î»ØÄ꤬¾Êά¤µ¤ì¤¿¾ì¹ç¤Ë¤Ï¸½ºß¤Î¥Õ¥¡¥¤¥ëÆþÎÏ¥³¡¼¥É¤ÎÃͤò + ÊÖ¤·¤Þ¤¹¡£ + .TP 4 + \fBkanji internalCode\fR ?\fIkanji-code\fR? + Tcl ÆâÉô¤Î½èÍý¤Ë»ÈÍѤµ¤ì¤ëÆâÉô¥³¡¼¥É¤ò \fIkanji-code\fR ¤ËÀßÄꤷ¤Þ¤¹¡£ + »ØÄê¤Ç¤­¤ëÃÍ¤Ï \fBJIS\fP¡¢\fBSJIS\fP¡¢\fBEUC\fP ¤Î¤¤¤º¤ì¤«¤Ç¤¹¡£ + ÆâÉô¥³¡¼¥É¤Î½é´üÃͤϴĶ­ÊÑ¿ô + .B LANG + ¤Ë¤è¤Ã¤Æ·è¤Þ¤ê¤Þ¤¹¡£ + .TP 4 + \fBkanji lsearch \fIlist\fR \fIpattern\fR + .TP 4 + \fBklsearch \fIlist\fR \fIpattern\fR + ÆüËܸìÈÇ lsearch ¤Ç¤¹¡£·ë²Ì¤Ï¥Ð¥¤¥Èñ°Ì¤Ç¤Ï¤Ê¤¯¡¢Ê¸»úñ°Ì¤ÇÊÖ¤µ¤ì¤Þ¤¹¡£ + ¾Êά·Á¤È¤·¤Æ "\fBklsearch\fP" ¤È¤¤¤¦¥³¥Þ¥ó¥É¤âÍÑ°Õ¤·¤Æ¤¢¤ê¤Þ¤¹¡£ + .TP 4 + \fBkanji lsort \fIlist\fR + .TP 4 + \fBklsort \fIlist\fR + ÆüËܸìÈÇ \fBlsort\fP ¥³¥Þ¥ó¥É¤Ç¤¹¡£ + ¾Êά·Á¤È¤·¤Æ \fBklsort\fP ¤È¤¤¤¦¥³¥Þ¥ó¥É¤âÍÑ°Õ¤·¤Æ¤¢¤ê¤Þ¤¹¡£ + .TP 4 + \fBkanji outputCode \fIfileId\fP ?\fIkanji-code\fR? + \fIfileId\fP ¤Ç»ØÄꤵ¤ì¤ë¥Õ¥¡¥¤¥ë¤Î½ÐÎÏ¥³¡¼¥É¤ò \fIkanji-code\fR ¤Ë + ÀßÄꤷ¤Þ¤¹¡£ + \fIkanji-code\fR ¤Î»ØÄ꤬¾Êά¤µ¤ì¤¿¾ì¹ç¤Ë¤Ï¸½ºß¤Î¥Õ¥¡¥¤¥ë½ÐÎÏ¥³¡¼¥É¤ÎÃͤò + ÊÖ¤·¤Þ¤¹¡£ + .TP 4 + \fBkanji split \fIstring\fR ?\fIsplitChars\fR? + .TP 4 + \fBksplit \fIstring\fR ?\fIsplitChars\fR? + ÆüËܸìÈǤΠ\fBsplit\fP ¥³¥Þ¥ó¥É¤Ç¤¹¡£ + ¾Êά·Á¤È¤·¤Æ \fBksplit\fP ¤È¤¤¤¦¥³¥Þ¥ó¥É¤âÍÑ°Õ¤·¤Æ¤¢¤ê¤Þ¤¹¡£ + .TP 4 + \fBkanji string \fIoption\fR \fIarg\fR ?\fIarg ...\fR? + .TP 4 + \fBkstring \fIoption\fR \fIarg\fR ?\fIarg ...\fR? + ÆüËܸìÈǤΠ\fBstring\fP ¥³¥Þ¥ó¥É¤Ç¤¹¡£ + ʸ»úÎó¤ò¥Ð¥¤¥Èñ°Ì¤Ç¤Ï¤Ê¤¯¡¢Ê¸»úñ°Ì¤Ç°·¤¤¤Þ¤¹¡£ + ¾Êά·Á¤È¤·¤Æ \fBkstring\fP ¤È¤¤¤¦¥³¥Þ¥ó¥É¤âÍÑ°Õ¤·¤Æ¤¢¤ê¤Þ¤¹¡£ + .RE + .PP + ¤Þ¤¿¡¢ + .B file + ¥³¥Þ¥ó¥É¤ò³ÈÄ¥¤·¤Æ¥Õ¥¡¥¤¥ë¤Î´Á»ú¥³¡¼¥É¤òÄ´¤Ù¤ëµ¡Ç½¤òÄɲ䷤Ƥ¢¤ê¤Þ¤¹¡£ + .TP 4 + \fBfile kanjiCode\fR \fIfilename\fR + \fIfilename\fR ¤Ç»ØÄꤵ¤ì¤ë¥Õ¥¡¥¤¥ë¤Î´Á»ú¥³¡¼¥É¤òÊÖ¤·¤Þ¤¹¡£ + ¤â¤·´Á»ú¤ò´Þ¤ó¤Ç¤¤¤Ê¤±¤ì¤Ð \fBANY\fP ¤òÊÖ¤·¤Þ¤¹¡£ + ' + .SH "¥ª¥ê¥¸¥Ê¥ëÈǤȤζ¦Â¸" + Ä̾ï /usr/local/lib/tcl ¤Î²¼¤Ë¥¤¥ó¥¹¥È¡¼¥ë¤µ¤ì¤ë¥Õ¥¡¥¤¥ë¤Ï¡¢ + Á´¤¯Êѹ¹¤µ¤ì¤Æ¤¤¤Þ¤»¤ó¡£ + ¥ª¥ê¥¸¥Ê¥ëÈǤΤ¿¤á¤Ëºî¤é¤ì¤¿¥é¥¤¥Ö¥é¥ê¤â¥¹¥¯¥ê¥×¥È¤â¡¢ + ²¿¤ÎÊѹ¹¤â¤Ê¤¯ÆüËܸ첽ÈǤÇÍøÍѤ¹¤ë¤³¤È¤¬¤Ç¤­¤Þ¤¹¡£ + ' + .SH "ÌäÂêÅÀ" + \fBregexp/regsub\fP ¤ÏÆüËܸ첽¤·¤Æ¤¢¤ê¤Þ¤»¤ó¡£ + .PP + JIS ¥³¡¼¥É¤Î¥µ¥Ý¡¼¥È¤Ï¤«¤Ê¤ê¤¤¤¤²Ã¸º¤ÊÉôʬ¤¬¤¢¤ê¤Þ¤¹¡£ + EUC ¤«¥·¥Õ¥È JIS ¤ò»ÈÍѤ·¤¿Êý¤¬¤è¤¤¤Ç¤·¤ç¤¦¡£ + ' + .SH "ºî¼Ô" + ¥ª¥ê¥¸¥Ê¥ë¤Î Tcl/Tk ¤Ï¥«¥ê¥Õ¥©¥ë¥Ë¥¢Âç³Ø¥Ð¡¼¥¯¥ì¥¤¹»¤Î John Ousterhout + (ouster@sprite.berkeley.edu) ¤Ë¤è¤Ã¤Æºî¤é¤ì¤Þ¤·¤¿¡£ + ¤³¤ÎÆüËܸ첽¤Ï¼ç¤Ë (³ô)SRA ¤ÎÀ¾Ãæ˧¹¬ (nisinaka@sra.co.jp) ¤Ë¤è¤Ã¤Æ + ¹Ô¤ï¤ì¡¢¼òÆ÷´² (sakoh@sra.co.jp) ¤ª¤è¤ÓÀÐÁ¾º¬¿® (ishisone@sra.co.jp) ¤¬ + ¶¨ÎϤ·¤Þ¤·¤¿¡£ diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tcl7.6/doc.jp/TclJP.man ./doc.jp/TclJP.man *** ../tcl7.6/doc.jp/TclJP.man Thu Jan 1 09:00:00 1970 --- ./doc.jp/TclJP.man Fri Oct 18 13:14:03 1996 *************** *** 0 **** --- 1,215 ---- + '\" + '\" Copyright (c) 1993 Software Research Associates, Inc. + '\" Permission to use, copy, modify, and distribute this software and its + '\" documentation for any purpose and without fee is hereby granted, provided + '\" that the above copyright notice appear in all copies and that both that + '\" copyright notice and this permission notice appear in supporting + '\" documentation, and that the name of Software Research Associates not be + '\" used in advertising or publicity pertaining to distribution of the + '\" software without specific, written prior permission. Software Research + '\" Associates makes no representations about the suitability of this software + '\" for any purpose. It is provided "as is" without express or implied + '\" warranty. + '\" + '\" $Id: TclJP.man,v 1.1 1996/03/29 08:21:48 nisinaka Exp $ + ' + .so man.macros + .de UL + \\$1\l'|0\(ul'\\$2 + .. + .HS TclJP tcl + .if n .na + .BS + .SH NAME + TclJapanization \- overview of Tcl Japanization + .BE + + .SH INTRODUCTION + This document provides an overview of the Japanization of Tcl. + The Japanization includes the following features: + .RS + .nf + + * Parse scripts that contain kanji strings. + * New commands for handling kanji strings. + + .fi + .RE + There are two main policies for the Japanization: + "Users do not have to worry about details like kanji code" + and + "Any scripts for the original Tcl are executable". + ' + .SH "KANJI CODE" + You can include kanji strings in Tcl scripts. + Our Japanization supports three kinds of kanji code: + \fBJIS\fP, \fBEUC\fP, and \fBShift-JIS\fP. + We do not support the kana character set encoded with one byte + (which is, so called, HANKAKU-KANA). + .PP + When the Tcl interpreter parses a script, + it automatically examines the kanji code. + This means that the user does not have to specify the kanji code beforehand + and can write kanji strings without worrying about their kanji code. + Even though the current implementation allows you to use + different kanji codes in a same script file, + we do not recommend mixing different kanji codes. + .PP + The Japanized Tcl maintains a set of codes + that indicate the type of kanji characters + being handled by the Tcl interpreter (the internal code) + and for file I/O (the file input and output codes). + Regardless of the source of input (script or file I/O), + the Tcl interpreter converts strings to the particular kanji code + specified by the user. + .TP 4 + Internal code + Any kanji will be automatically converted into the specifed + kanji code when the Tcl interpreter parses scripts. + Regardless of the original kanji code, + the Tcl interpreter converts kanji strings to this kanji code. + This code is called "internal code". + There are three kinds of kanji code: + \fBJIS\fP, \fBEUC\fP, and \fBShift-JIS\fP. + The internal code is specified by the environment variable + .B LANG + when you execute an application based on Tcl. + You can change the internal code + by \fBkanji internalCode\fP command (which is described later). + .br + If you change the internal code after the first kanji character is recognized, + you may encounter errors. + So we suggest taking care when chaging the internal code. + .br + Since the Tcl interpreter encodes kanji strings with the internal code, + the results of Tcl commands are also encoded with the internal code. + .TP 4 + File input code + When you use the \fBgets\fP command to read strings, + you can convert this kanji code. + Again, regardless of the original kanji code, + the code will be converted to the specified one. + You can specify a file input code for each file + using the \fBkanji inputCode\fP command. + File input codes are: \fBJIS\fP, \fBEUC\fP, \fBShift-JIS\fP, or \fBANY\fP. + \fBANY\fP means that kanji strings are recognized as kanji + but their kanji code will not be changed. + The default of a file input code is \fBANY\fP. + .TP 4 + File output code + When you use \fBputs\fP command to write strings, + you can convert their kanji code. + You can specify a file output code for each file + using the \fBkanji outputCode\fP command. + File output codes are: \fBJIS\fP, \fBEUC\fP, \fBShift-JIS\fP, or \fBANY\fP. + The default of a file output code is \fBANY\fP. + ' + .SH "COMMANDS FOR HANDLING KANJI STRINGS" + The + .B kanji + command handles kanji strings and their kanji code. + .TP 4 + \fBkanji\fP \fIoption\fP ?\fIarg ...\fP? + Perform one of several kanji operations for kanji strings, + depending on \fIoption\fR. + .RS + .TP 4 + \fBkanji code \fIstring\fR + Returns the type of kanji code used to encode \fIstring\fR. + Return value will be either \fBJIS\fP, \fBSJIS\fP, + \fBEUC\fP, or \fBANY\fP. + \fBANY\fP means the \fIstring\fR does not include any kanji strings. + .TP 4 + \fBkanji conversion \fIfrom-code\fR \fIto-code\fR \fIstring\fR + Does the kanji code conversion of \fIstring\fR and returns the + converted string. + \fIFrom-code\fR specifies the kanji code of \fIstring\fR, and + \fIto-code\fR specifies the kanji code to be converted. + The valid kanji codes for \fIfrom-code\fR and \fIto-code\fR are + \fBJIS\fP, \fBSJIS\fP and \fBEUC\fP. + .TP 4 + \fBkanji defaultInputCode\fR ?\fIkanji-code\fR? + Returns the default kanji code for input with the \fBgets\fP command. + If \fIkanji-code\fR is specified, + then change the default file input code. + The return value or the value you can specify will be one of: + \fBJIS\fP, \fBSJIS\fP, \fBEUC\fP, and \fBANY\fP. + \fBANY\fP means that kanji strings are recognized as kanji + but their kanji code will not be converted. + The initial value is always \fBANY\fP. + .TP 4 + \fBkanji defaultOutputCode\fR ?\fIkanji-code\fR? + Returns the default kanji code for output with the \fBputs\fP command. + If \fIkanji-code\fR is specified, + then change the default file output code. + The return value or the value you can specify will be one of: + \fBJIS\fP, \fBSJIS\fP, \fBEUC\fP, and \fBANY\fP. + The initial value is always \fBANY\fP. + .TP 4 + \fBkanji inputCode \fIfileId\fR ?\fIkanji-code\fR? + Returns the file input code of the file \fIfileId\fR. + If \fIkanji-code\fR is specified, + then change the file input code to \fIkanji-code\fR. + .TP 4 + \fBkanji internalCode\fR ?\fIkanji-code\fR? + Returns the current internal code. + If \fIkanji-code\fR is specified, + then change the internal code to \fIkanji-code\fR. + The return value or the value you can specify will be one of: + \fBJIS\fP, \fBSJIS\fP, and \fBEUC\fP. + The initinal value of the internal code is defined by + the environment variable \fBLANG\fP. + .TP 4 + \fBkanji lsearch \fIlist\fR \fIpattern\fR + .TP 4 + \fBklsearch \fIlist\fR \fIpattern\fR + These two are the \fBlsearch\fP command for kanji strings. + It takes the same arguments as the Tcl \fBlsearch\fP command. + .TP 4 + \fBkanji lsort \fIlist\fR + .TP 4 + \fBklsort \fIlist\fR + These two are the \fBlsort\fP command for kanji strings. + It takes the same arguments as the Tcl \fBlsort\fP command. + .TP 4 + \fBkanji outputCode \fIfileId\fP ?\fIkanji-code\fR? + Returns the file output code of the file \fIfileId\fR. + If \fIkanji-code\fR is specified, + then change the file output code to \fIkanji-code\fR. + .TP 4 + \fBkanji string \fIoption\fR \fIarg\fR ?\fIarg ...\fR? + .TP 4 + \fBkstring \fIoption\fR \fIarg\fR ?\fIarg ...\fR? + These two are the \fBstring\fP command for kanji string. + It takes the same arguments as the Tcl \fBstring\fP command. + .RE + .PP + The \fBfile\fP command is also extended + to know what kanji code is used in the file. + .TP 4 + \fBfile kanjiCode\fR \fIfilename\fR + Returns the kanji code of the file. + The \fIfilename\fR gives the name of the file + you want to know its kanji code. + If the file does not include any kanji strings, + this command returns \fBANY\fP. + ' + .SH "COEXISTING WITH THE ORIGINAL TCL" + No library file (usually installed in "/usr/local/lib/tcl") + is modified for the Japanization. + Libraries and scripts written for the original Tcl can be used + with this Japanized Tcl. + ' + .SH PROBLEMS + \fBregexp/regsub\fP are not Japanized, yet. + .PP + The support for JIS code is not complete. + We recommend using EUC or Shift-JIS. + ' + .SH AUTHORS + The original Tcl/Tk was developped by + Dr. John Ousterhout (ouster@sprite.berkeley.edu) + from University of California at Berkeley. + This Japanization is mainly done by Yoshiyuki Nishinaka (nisinaka@sra.co.jp) + from Software Research Associates, Inc. with the supports of + Hiroshi Sako (sakoh@sra.co.jp) and Makoto Ishisone (ishisone@sra.co.jp). diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tcl7.6/generic/tcl.h ./generic/tcl.h *** ../tcl7.6/generic/tcl.h Thu Oct 3 09:17:43 1996 --- ./generic/tcl.h Fri Oct 18 13:14:04 1996 *************** *** 403,408 **** --- 403,470 ---- #define TCL_LINK_STRING 4 #define TCL_LINK_READ_ONLY 0x80 + #ifdef KANJI + /* + * Integer values for KANJI codes + */ + #define TCL_NOT_KANJI -1 + #define TCL_JIS 0 + #define TCL_SJIS 1 + #define TCL_EUC 2 + #define TCL_ANY 3 + + EXTERN char *Tcl_KanjiCodeStr[]; + + #ifndef TCL_DEFAULT_KANJI_CODE + #if defined(__WIN32__) + #define TCL_DEFAULT_KANJI_CODE TCL_SJIS + #else + #define TCL_DEFAULT_KANJI_CODE TCL_EUC + #endif /* __WIN32__ */ + #endif + + /* + * type definition for wide character + */ + #ifndef WCHAR_DEFINED + #define WCHAR_DEFINED + typedef unsigned short wchar; + #endif + + /* + * macros for wide characters + */ + #define ISWKANA(wc) (((wc) & 0x8080) == 0x80) + #define ISWKANJI(wc) (((wc) & 0x8080) == 0x8080) + #define ISWSPACE(wc) (isascii(wc) && isspace(wc)) + #define ISWUPPER(wc) (isascii(wc) && isupper(wc)) + #define ISWLOWER(wc) (isascii(wc) && islower(wc)) + #define ISWALNUM(wc) (isascii(wc) && isalnum(wc)) + #define ISWDIGIT(wc) (isascii(wc) && isdigit(wc)) + + /* + * Tcl_DWString is same as Tcl_DString except that it handles wide strings. + */ + + #define TCL_DWSTRING_STATIC_SIZE 200 + typedef struct Tcl_DWString { + wchar *wstring; /* Points to beginning of string: either + * staticSpace below or a malloc'ed array. */ + int length; /* Number of non-NULL characters in the + * string. */ + int spaceAvl; /* Total number of bytes available for the + * string and its terminating NULL char. */ + wchar staticSpace[TCL_DWSTRING_STATIC_SIZE]; + /* Space to use in common case where string + * is small. */ + } Tcl_DWString; + + #define Tcl_DWStringLength(dwsPtr) ((dwsPtr)->length) + #define Tcl_DWStringValue(dwsPtr) ((dwsPtr)->wstring) + #define Tcl_DWStringTrunc Tcl_DWStringSetLength + + #endif /* KANJI */ + /* * The following declarations either map ckalloc and ckfree to * malloc and free, or they map them to procedures with all sorts *************** *** 1136,1141 **** --- 1198,1249 ---- int mask)); EXTERN int Tcl_Write _ANSI_ARGS_((Tcl_Channel chan, char *s, int slen)); + #ifdef KANJI + EXTERN int Tcl_KanjiEncode _ANSI_ARGS_((int kanjiCode, + unsigned char *ks, wchar *ws)); + EXTERN int Tcl_KanjiDecode _ANSI_ARGS_((int kanjiCode, + wchar *ws, unsigned char *ks)); + EXTERN int Tcl_EncodeJIS _ANSI_ARGS_((unsigned char *ks, wchar *ws)); + EXTERN int Tcl_EncodeSJIS _ANSI_ARGS_((unsigned char *ks, wchar *ws)); + EXTERN int Tcl_EncodeEUC _ANSI_ARGS_((unsigned char *ks, wchar *ws)); + EXTERN int Tcl_EncodeANY _ANSI_ARGS_((unsigned char *ks, wchar *ws)); + EXTERN int Tcl_DecodeJIS _ANSI_ARGS_((wchar *ws, unsigned char *ks)); + EXTERN int Tcl_DecodeSJIS _ANSI_ARGS_((wchar *ws, unsigned char *ks)); + EXTERN int Tcl_DecodeEUC _ANSI_ARGS_((wchar *ws, unsigned char *ks)); + EXTERN int Tcl_DecodeANY _ANSI_ARGS_((wchar *ws, unsigned char *ks)); + EXTERN int Tcl_DefaultKanjiCode _ANSI_ARGS_((void)); + EXTERN int Tcl_KanjiFile _ANSI_ARGS_((Tcl_Interp *interp, + char *fileName, int *kanjiCodePtr)); + EXTERN int Tcl_KanjiCode _ANSI_ARGS_((Tcl_Interp *interp)); + EXTERN int Tcl_KanjiStart _ANSI_ARGS_(( + unsigned char *string, int *kanjiCodePtr)); + EXTERN int Tcl_KanjiEnd _ANSI_ARGS_(( + unsigned char *string, int *kanjiCodePtr)); + EXTERN int Tcl_KanjiLength _ANSI_ARGS_(( + unsigned char *string, int kanjiCode)); + EXTERN int Tcl_KanjiString _ANSI_ARGS_((Tcl_Interp *interp, + char *string, int *kanjiCodePtr)); + EXTERN int Tcl_GetKanjiCode _ANSI_ARGS_((Tcl_Interp *interp, + char *string, int *kanjiCodePtr)); + EXTERN int Tcl_WStrlen _ANSI_ARGS_((wchar *wstr)); + EXTERN wchar * Tcl_WStrcpy _ANSI_ARGS_((wchar *wstr1, wchar *wstr2)); + EXTERN wchar * Tcl_WStrncpy _ANSI_ARGS_((wchar *wstr1, wchar *wstr2, int n)); + EXTERN int Tcl_WStrcmp _ANSI_ARGS_((wchar *wstr1, wchar *wstr2)); + EXTERN int Tcl_WStrncmp _ANSI_ARGS_((wchar *wstr1, wchar *wstr2, int n)); + EXTERN int Tcl_WStringMatch _ANSI_ARGS_((wchar *string, + wchar *pattern)); + EXTERN wchar * Tcl_WStrstr _ANSI_ARGS_((wchar *wstr, wchar *subwstr)); + EXTERN wchar * Tcl_DWStringAppend _ANSI_ARGS_((Tcl_DWString *dwsPtr, + wchar *wstring, int length)); + EXTERN void Tcl_DWStringFree _ANSI_ARGS_((Tcl_DWString *dwsPtr)); + EXTERN void Tcl_DWStringGetResult _ANSI_ARGS_((Tcl_Interp *interp, + Tcl_DWString *dwsPtr)); + EXTERN void Tcl_DWStringInit _ANSI_ARGS_((Tcl_DWString *dwsPtr)); + EXTERN void Tcl_DWStringResult _ANSI_ARGS_((Tcl_Interp *interp, + Tcl_DWString *dwsPtr)); + EXTERN void Tcl_DWStringSetLength _ANSI_ARGS_((Tcl_DWString *dwsPtr, + int length)); + #endif /* KANJI */ #endif /* RESOURCE_INCLUDED */ #endif /* _TCL */ diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tcl7.6/generic/tclBasic.c ./generic/tclBasic.c *** ../tcl7.6/generic/tclBasic.c Fri Sep 20 08:53:32 1996 --- ./generic/tclBasic.c Fri Oct 18 13:14:05 1996 *************** *** 67,72 **** --- 67,79 ---- {"info", Tcl_InfoCmd}, {"interp", Tcl_InterpCmd}, {"join", Tcl_JoinCmd}, + #ifdef KANJI + {"kanji", Tcl_KanjiCmd}, + {"klsearch", Tcl_KlsearchCmd}, + {"klsort", Tcl_KlsortCmd}, + {"ksplit", Tcl_KsplitCmd}, + {"kstring", Tcl_KstringCmd}, + #endif /* KANJI */ {"lappend", Tcl_LappendCmd}, {"lindex", Tcl_LindexCmd}, {"linsert", Tcl_LinsertCmd}, *************** *** 213,218 **** --- 220,230 ---- iPtr->tracePtr = NULL; iPtr->assocData = (Tcl_HashTable *) NULL; iPtr->resultSpace[0] = 0; + #ifdef KANJI + iPtr->kanjiCode = Tcl_DefaultKanjiCode(); + iPtr->kanjiInputCode = TCL_ANY; + iPtr->kanjiOutputCode = TCL_ANY; + #endif /* KANJI */ /* * Create the built-in commands. Do it here, rather than calling *************** *** 1232,1237 **** --- 1244,1253 ---- src += 1; } if (*src == '#') { + #ifdef KANJI + int kanjiCode = TCL_ANY; + src++; + #endif /* KANJI */ while (*src != 0) { if (*src == '\\') { int length; *************** *** 1241,1246 **** --- 1257,1266 ---- src++; termPtr = src; break; + #ifdef KANJI + } else if (Tcl_KanjiStart(src, &kanjiCode)) { + src += Tcl_KanjiLength(src, kanjiCode); + #endif /* KANJI */ } else { src++; } diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tcl7.6/generic/tclCmdAH.c ./generic/tclCmdAH.c *** ../tcl7.6/generic/tclCmdAH.c Thu Oct 3 01:48:47 1996 --- ./generic/tclCmdAH.c Fri Oct 18 13:25:31 1996 *************** *** 946,955 **** --- 946,974 ---- } interp->result = GetTypeFromMode((int) statBuf.st_mode); goto done; + #ifdef KANJI + } else if ((c == 'k') && (strncmp(argv[1], "kanjiCode", length) == 0)) { + int kanjiCode; + + if (argc != 3) { + argv[1] = "kanjiCode"; + goto not3Args; + } + if (Tcl_KanjiFile(interp, fileName, &kanjiCode) == TCL_ERROR) { + result = TCL_ERROR; + goto done; + } + Tcl_SetResult(interp, Tcl_KanjiCodeStr[kanjiCode], 0); + goto done; + #endif /* KANJI */ } else { Tcl_AppendResult(interp, "bad option \"", argv[1], "\": should be atime, copy, delete, dirname, executable, ", + #ifdef KANJI + "exists, extension, isdirectory, isfile, join, kanjiCode, ", + #else "exists, extension, isdirectory, isfile, join, ", + #endif /* KANJI */ "lstat, mtime, mkdir, owned, pathtype, readable, readlink, ", "rename, root, size, split, stat, tail, type, ", "or writable", diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tcl7.6/generic/tclCmdIL.c ./generic/tclCmdIL.c *** ../tcl7.6/generic/tclCmdIL.c Thu Aug 22 05:33:21 1996 --- ./generic/tclCmdIL.c Fri Oct 18 13:14:06 1996 *************** *** 59,64 **** --- 59,68 ---- static int SortCompareProc _ANSI_ARGS_((CONST VOID *first, CONST VOID *second)); + #ifdef KANJI + static int SortKanjiCompareProc _ANSI_ARGS_((CONST VOID *first, + CONST VOID *second)); + #endif /* KANJI */ /* *---------------------------------------------------------------------- *************** *** 708,713 **** --- 712,1536 ---- return TCL_OK; } + #ifdef KANJI + /* + *---------------------------------------------------------------------- + * + * Tcl_KanjiCmd -- + * + * This procedure is invoked to process the "kanji" Tcl command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + + /* ARGSUSED */ + int + Tcl_KanjiCmd(dummy, interp, argc, argv) + ClientData dummy; /* Not used. */ + Tcl_Interp *interp; /* Current interpreter. */ + int argc; /* Number of arguments. */ + char **argv; /* Argument strings. */ + { + register char c; + int length; + + if (argc < 2) { + Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], + " option arg ?arg ...?\"", (char *) NULL); + return TCL_ERROR; + } + c = argv[1][0]; + length = strlen(argv[1]); + if ((c == 'c') && (strncmp(argv[1], "code", length) == 0)) { + int kanjiCode; + + if (argc != 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], + " code string\"", (char *) NULL); + return TCL_ERROR; + } + (void )Tcl_KanjiString(interp, argv[2], &kanjiCode); + Tcl_SetResult(interp, Tcl_KanjiCodeStr[kanjiCode], 0); + return TCL_OK; + } else if ((c == 'c') && (strncmp(argv[1], "conversion", length) == 0) + && (length >= 4)) { + int from, to; + wchar *wstr; + char *str; + + if (argc != 5) { + Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], + " conversion fromCode toCode string\"", (char *) NULL); + return TCL_ERROR; + } + if (Tcl_GetKanjiCode(interp, argv[2], &from) == TCL_ERROR) return TCL_ERROR; + if (Tcl_GetKanjiCode(interp, argv[3], &to) == TCL_ERROR) return TCL_ERROR; + + if (from == to) { + Tcl_SetResult(interp, argv[4], TCL_VOLATILE); + return TCL_OK; + } + wstr = (wchar *)ckalloc((unsigned)(Tcl_KanjiEncode(from, argv[4], NULL) + 1) * 2); + (void) Tcl_KanjiEncode(from, argv[4], wstr); + str = (char *)ckalloc((unsigned)(Tcl_KanjiDecode(to, wstr, NULL) + 1)); + (void) Tcl_KanjiDecode(to, wstr, str); + Tcl_SetResult(interp, str, TCL_VOLATILE); + ckfree((char *)wstr); + ckfree(str); + return TCL_OK; + } else if ((c == 'd') && (strncmp(argv[1], "defaultInputCode", length) == 0) + && (length >= 8)) { + Interp *iPtr = (Interp *)interp; + + if (argc > 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], + " defaultInputCode ?value?\"", (char *) NULL); + return TCL_ERROR; + } + if (argc == 3) { + if (Tcl_GetKanjiCode(interp, argv[2], &(iPtr->kanjiInputCode)) + == TCL_ERROR) { + return TCL_ERROR; + } + } + Tcl_SetResult(interp, Tcl_KanjiCodeStr[iPtr->kanjiInputCode], 0); + return TCL_OK; + } else if ((c == 'd') && (strncmp(argv[1], "defaultOutputCode", length) == 0) + && (length >= 8)) { + Interp *iPtr = (Interp *)interp; + + if (argc > 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], + " defaultOutputCode ?value?\"", (char *) NULL); + return TCL_ERROR; + } + if (argc == 3) { + if (Tcl_GetKanjiCode(interp, argv[2], &(iPtr->kanjiOutputCode)) + == TCL_ERROR) { + return TCL_ERROR; + } + } + Tcl_SetResult(interp, Tcl_KanjiCodeStr[iPtr->kanjiOutputCode], 0); + return TCL_OK; + } else if ((c == 'i') && (strncmp(argv[1], "inputCode", length) == 0) + && (length >= 3)) { + Tcl_Channel chan; + int mode, result; + Tcl_DString ds; + + if (argc != 3 && argc != 4) { + Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], + " inputCode channelId ?value?\"", (char *) NULL); + return TCL_ERROR; + } + + chan = Tcl_GetChannel(interp, argv[2], &mode); + if (chan == (Tcl_Channel) NULL) { + return TCL_ERROR; + } + if ((mode & TCL_READABLE) == 0) { + Tcl_AppendResult(interp, "channel \"", argv[2], + "\" wasn't opened for reading", (char *) NULL); + return TCL_ERROR; + } + if (argc == 4) { + result = Tcl_SetChannelOption(interp, chan, "-inputCode", argv[3]); + if (result != TCL_OK) { + return result; + } + } + Tcl_DStringInit(&ds); + if (Tcl_GetChannelOption(chan, "-inputCode", &ds) != TCL_OK) { + panic("Tcl_KanjiCmd: internal error"); + } + Tcl_DStringResult(interp, &ds); + Tcl_DStringFree(&ds); + return TCL_OK; + } else if ((c == 'i') && (strncmp(argv[1], "internalCode", length) == 0) + && (length >= 3)) { + Interp *iPtr = (Interp *)interp; + + if (argc > 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], + " code ?value?\"", (char *) NULL); + return TCL_ERROR; + } + if (argc == 3) { + if (Tcl_GetKanjiCode(interp, argv[2], &(iPtr->kanjiCode)) == TCL_ERROR) { + return TCL_ERROR; + } + } + Tcl_SetResult(interp, Tcl_KanjiCodeStr[iPtr->kanjiCode], 0); + return TCL_OK; + } else if ((c == 'l') && (strncmp(argv[1], "lsearch", length) == 0) + && (length >= 3)) { + if (argc != 4) { + Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], + " lsearch list pattern\"", (char *) NULL); + return TCL_ERROR; + } + return Tcl_KlsearchCmd(dummy, interp, argc-1, argv+1); + } else if ((c == 'l') && (strncmp(argv[1], "lsort", length) == 0) + && (length >= 3)) { + if (argc != 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], + " lsort list\"", (char *) NULL); + return TCL_ERROR; + } + return Tcl_KlsortCmd(dummy, interp, argc-1, argv+1); + } else if ((c == 'o') && (strncmp(argv[1], "outputCode", length) == 0)) { + Tcl_Channel chan; + int mode, result; + Tcl_DString ds; + + if (argc != 3 && argc != 4) { + Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], + " outputCode channelId ?value?\"", (char *) NULL); + return TCL_ERROR; + } + + chan = Tcl_GetChannel(interp, argv[2], &mode); + if (chan == (Tcl_Channel) NULL) { + return TCL_ERROR; + } + if ((mode & TCL_WRITABLE) == 0) { + Tcl_AppendResult(interp, "channel \"", argv[2], + "\" wasn't opened for writing", (char *) NULL); + return TCL_ERROR; + } + if (argc == 4) { + result = Tcl_SetChannelOption(interp, chan, "-outputCode", argv[3]); + if (result != TCL_OK) { + return result; + } + } + Tcl_DStringInit(&ds); + if (Tcl_GetChannelOption(chan, "-outputCode", &ds) != TCL_OK) { + panic("Tcl_KanjiCmd: internal error"); + } + Tcl_DStringResult(interp, &ds); + Tcl_DStringFree(&ds); + return TCL_OK; + } else if ((c == 's') && (strncmp(argv[1], "split", length) == 0) + && (length >= 2)) { + if (argc != 3 && argc != 4) { + Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], + " split string ?splitChars?\"", (char *) NULL); + return TCL_ERROR; + } + return Tcl_KsplitCmd(dummy, interp, argc-1, argv+1); + } else if ((c == 's') && (strncmp(argv[1], "string", length) == 0) + && (length >= 2)) { + if (argc < 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], + " string option arg ?arg ...?\"", (char *) NULL); + return TCL_ERROR; + } + return Tcl_KstringCmd(dummy, interp, argc-1, argv+1); + } else { + Tcl_AppendResult(interp, "bad option \"", argv[1], + "\": should be code, conversion, defalutInputCode,", + " defaultOutputCode, internalCode, inputCode, lsearch,", + " lsort, outputCode, split, or string", + (char *) NULL); + return TCL_ERROR; + } + } + + /* + *---------------------------------------------------------------------- + * + * Tcl_KlsearchCmd -- + * + * This procedure is invoked to process the "klsearch" Tcl command. + * This is the "lsearch" which handles kanji characters. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + + /* ARGSUSED */ + int + Tcl_KlsearchCmd(notUsed, interp, argc, argv) + ClientData notUsed; /* Not used. */ + Tcl_Interp *interp; /* Current interpreter. */ + int argc; /* Number of arguments. */ + char **argv; /* Argument strings. */ + { + int listArgc; + char **listArgv; + int i, match; + int maxlen; + wchar *string, *pattern; + int kanjiCode = ((Interp *)interp)->kanjiCode; + + if (argc != 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], + " list pattern\"", (char *) NULL); + return TCL_ERROR; + } + if (Tcl_SplitList(interp, argv[1], &listArgc, &listArgv) != TCL_OK) { + return TCL_ERROR; + } + for (i = 0, maxlen = 0; i < listArgc; i++) { + int len; + + len = strlen(listArgv[i]); + if (maxlen < len) maxlen = len; + } + string = (wchar *) ckalloc((unsigned)(maxlen + 1) * 2); + pattern = (wchar *) ckalloc((unsigned)(Tcl_KanjiEncode(kanjiCode, argv[2], NULL) + 1) * 2); + (void) Tcl_KanjiEncode(kanjiCode, argv[2], pattern); + match = -1; + for (i = 0; i < listArgc; i++) { + (void) Tcl_KanjiEncode(kanjiCode, listArgv[i], string); + if (Tcl_WStringMatch(string, pattern)) { + match = i; + break; + } + } + sprintf(interp->result, "%d", match); + ckfree((char *) listArgv); + ckfree((char *) string); + ckfree((char *) pattern); + return TCL_OK; + } + + /* + *---------------------------------------------------------------------- + * + * Tcl_KlsortCmd -- + * + * This procedure is invoked to process the "lsort" Tcl command. + * This is the "lsort" which handles kanji characters. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + + /* ARGSUSED */ + int + Tcl_KlsortCmd(notUsed, interp, argc, argv) + ClientData notUsed; /* Not used. */ + Tcl_Interp *interp; /* Current interpreter. */ + int argc; /* Number of arguments. */ + char **argv; /* Argument strings. */ + { + int listArgc; + char **listArgv; + + if (argc != 2) { + Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], + " list\"", (char *) NULL); + return TCL_ERROR; + } + if (Tcl_SplitList(interp, argv[1], &listArgc, &listArgv) != TCL_OK) { + return TCL_ERROR; + } + qsort((VOID *) listArgv, listArgc, sizeof (char *), SortKanjiCompareProc); + interp->result = Tcl_Merge(listArgc, listArgv); + interp->freeProc = (Tcl_FreeProc *) free; + ckfree((char *) listArgv); + return TCL_OK; + } + + /* + *---------------------------------------------------------------------- + * + * Tcl_KsplitCmd -- + * + * This procedure is invoked to process the "ksplit" Tcl command. + * This is the "split" which handles kanji characters. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + + /* ARGSUSED */ + int + Tcl_KsplitCmd(dummy, interp, argc, argv) + ClientData dummy; /* Not used. */ + Tcl_Interp *interp; /* Current interpreter. */ + int argc; /* Number of arguments. */ + char **argv; /* Argument strings. */ + { + int kanjiCode = ((Interp *)interp)->kanjiCode, code; + wchar *splitChars; + register char *p; + register wchar *wp; + char *elementStart; + char *elementStr; + int i; + + if (argc == 2) { + splitChars = (wchar *)ckalloc((unsigned)(4 + 1) * 2); + (void) Tcl_KanjiEncode(kanjiCode, " \n\t\r", splitChars); + } else if (argc == 3) { + splitChars = (wchar *)ckalloc((unsigned) + (Tcl_KanjiEncode(kanjiCode, argv[2], NULL) + 1) * 2); + (void) Tcl_KanjiEncode(kanjiCode, argv[2], splitChars); + } else { + Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], + " string ?splitChars?\"", (char *) NULL); + return TCL_ERROR; + } + + /* + * Handle the special case of splitting on every character. + */ + + if (*splitChars == 0) { + #define MAX_BYTES_FOR_ONE_WCHAR 10 /* hope this is enough */ + char str[MAX_BYTES_FOR_ONE_WCHAR]; + + for (p = argv[1]; *p != 0; ) { + if (Tcl_KanjiStart(p, &kanjiCode)) { + int num; + char c; + wchar *ws, wstr[2]; + + num = Tcl_KanjiLength(p, kanjiCode); + c = p[num]; + p[num] = 0; + ws = (wchar *) ckalloc((unsigned)(Tcl_KanjiEncode(kanjiCode, p, NULL) + 1) * 2); + (void) Tcl_KanjiEncode(kanjiCode, p, ws); + + wstr[1] = 0; + for (wp = ws; *wp != 0; wp++) { + wstr[0] = *wp; + if (Tcl_KanjiDecode(kanjiCode, wstr, str) >= MAX_BYTES_FOR_ONE_WCHAR) { + panic("Tcl_KsplitCmd : need larger MAX_BYTES_FOR_ONE_WCHAR"); + } + Tcl_AppendElement(interp, str); + } + + ckfree((char *) ws); + p[num] = c; + p += num; + } else { + str[0] = *p; + str[1] = 0; + Tcl_AppendElement(interp, str); + p++; + } + } + goto done; + } + + /* + * Normal case: split on any of a given set of characters. + * Discard instances of the split characters. + */ + + elementStr = (char *) ckalloc((unsigned)(strlen(argv[1]) + 1)); + i = 0; + for (p = argv[1]; *p != 0; ) { + if (Tcl_KanjiStart(p, &kanjiCode)) { + int n; + char c; + wchar *wstr, *wstrp, *start; + + n = Tcl_KanjiLength(p, kanjiCode); + c = p[n]; + p[n] = 0; + wstr = (wchar *) ckalloc((unsigned)(Tcl_KanjiEncode(kanjiCode, p, NULL) + 1) * 2); + (void) Tcl_KanjiEncode(kanjiCode, p, wstr); + + for (wstrp = start = wstr; *wstrp != 0; wstrp++) { + wchar wc = *wstrp; + + for (wp = splitChars; *wp != 0; wp++) { + if (*wp == wc) { + *wstrp = 0; + i += Tcl_KanjiDecode(kanjiCode, start, elementStr+i); + elementStr[i] = 0; + Tcl_AppendElement(interp, elementStr); + i = 0; + *wstrp = wc; + start = wstrp + 1; + break; + } + } + } + if (wstrp != start) { + i += Tcl_KanjiDecode(kanjiCode, start, elementStr+i); + } + ckfree((char *) wstr); + p[n] = c; + p += n; + } else { + for (wp = splitChars; *wp != 0; wp++) { + if (*wp == (wchar )*p) { + elementStr[i] = 0; + Tcl_AppendElement(interp, elementStr); + i = 0; + break; + } + } + if (*wp == 0) elementStr[i++] = *p; + p++; + } + } + if (p != argv[1]) { + elementStr[i] = 0; + Tcl_AppendElement(interp, elementStr); + } + + ckfree((char *) elementStr); + done: + ckfree((char *) splitChars); + return TCL_OK; + #undef MAX_BYTES_FOR_ONE_WCHAR + #undef MAX_BYTES_FOR_AN_ELEMENT + } + + /* + *---------------------------------------------------------------------- + * + * Tcl_KstringCmd -- + * + * This procedure is invoked to process the "kstring" Tcl command. + * This is the "string" which handles kanji characters. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + + /* ARGSUSED */ + int + Tcl_KstringCmd(dummy, interp, argc, argv) + ClientData dummy; /* Not used. */ + Tcl_Interp *interp; /* Current interpreter. */ + int argc; /* Number of arguments. */ + char **argv; /* Argument strings. */ + { + int kanjiCode = ((Interp *)interp)->kanjiCode; + int length; + register char c; + wchar *wstr1, *wstr2; + register wchar *wp, wc; + int match; + int first; + int left = 0, right = 0; + + if (argc < 2) { + Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], + " option arg ?arg ...?\"", (char *) NULL); + return TCL_ERROR; + } + c = argv[1][0]; + length = strlen(argv[1]); + if ((c == 'c') && (strncmp(argv[1], "compare", length) == 0)) { + if (argc != 4) { + Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], + " compare string1 string2\"", (char *) NULL); + return TCL_ERROR; + } + wstr1 = (wchar *)ckalloc((unsigned)(Tcl_KanjiEncode(kanjiCode, argv[2], NULL) + 1) * 2); + (void) Tcl_KanjiEncode(kanjiCode, argv[2], wstr1); + wstr2 = (wchar *)ckalloc((unsigned)(Tcl_KanjiEncode(kanjiCode, argv[3], NULL) + 1) * 2); + (void) Tcl_KanjiEncode(kanjiCode, argv[3], wstr2); + match = Tcl_WStrcmp(wstr1, wstr2); + if (match > 0) { + interp->result = "1"; + } else if (match < 0) { + interp->result = "-1"; + } else { + interp->result = "0"; + } + ckfree((char *)wstr1); + ckfree((char *)wstr2); + return TCL_OK; + } else if ((c == 'f') && (strncmp(argv[1], "first", length) == 0)) { + if (argc != 4) { + Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], + " first string1 string2\"", (char *) NULL); + return TCL_ERROR; + } + first = 1; + + firstLast: + wstr1 = (wchar *)ckalloc((unsigned)(Tcl_KanjiEncode(kanjiCode, argv[2], NULL) + 1) * 2); + (void) Tcl_KanjiEncode(kanjiCode, argv[2], wstr1); + wstr2 = (wchar *)ckalloc((unsigned)(Tcl_KanjiEncode(kanjiCode, argv[3], NULL) + 1) * 2); + (void) Tcl_KanjiEncode(kanjiCode, argv[3], wstr2); + match = -1; + wc = *wstr1; + length = Tcl_WStrlen(wstr1); + for (wp = wstr2; *wp != 0; wp++) { + if (*wp != wc) { + continue; + } + if (Tcl_WStrncmp(wstr1, wp, length) == 0) { + match = wp - wstr2; + if (first) { + break; + } + } + } + sprintf(interp->result, "%d", match); + ckfree((char *)wstr1); + ckfree((char *)wstr2); + return TCL_OK; + } else if ((c == 'i') && (strncmp(argv[1], "index", length) == 0)) { + int index; + + if (argc != 4) { + Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], + " index string charIndex\"", (char *) NULL); + return TCL_ERROR; + } + if (Tcl_GetInt(interp, argv[3], &index) != TCL_OK) { + return TCL_ERROR; + } + if ((index >= 0) && (index < strlen(argv[2]))) { + wchar wstr[2]; + wstr1 = (wchar *)ckalloc((unsigned)(Tcl_KanjiEncode(kanjiCode, argv[2], NULL) + 1) * 2); + (void) Tcl_KanjiEncode(kanjiCode, argv[2], wstr1); + wstr[0] = wstr1[index]; + wstr[1] = 0; + (void) Tcl_KanjiDecode(kanjiCode, wstr, interp->result); + ckfree((char *)wstr1); + } + return TCL_OK; + } else if ((c == 'l') && (strncmp(argv[1], "last", length) == 0) + && (length >= 2)) { + if (argc != 4) { + Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], + " last string1 string2\"", (char *) NULL); + return TCL_ERROR; + } + first = 0; + goto firstLast; + } else if ((c == 'l') && (strncmp(argv[1], "length", length) == 0) + && (length >= 2)) { + if (argc != 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], + " length string\"", (char *) NULL); + return TCL_ERROR; + } + wstr1 = (wchar *)ckalloc((unsigned)(Tcl_KanjiEncode(kanjiCode, argv[2], NULL) + 1) * 2); + (void) Tcl_KanjiEncode(kanjiCode, argv[2], wstr1); + sprintf(interp->result, "%d", Tcl_WStrlen(wstr1)); + ckfree((char *)wstr1); + return TCL_OK; + } else if ((c == 'm') && (strncmp(argv[1], "match", length) == 0)) { + if (argc != 4) { + Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], + " match pattern string\"", (char *) NULL); + return TCL_ERROR; + } + wstr1 = (wchar *)ckalloc((unsigned)(Tcl_KanjiEncode(kanjiCode, argv[2], NULL) + 1) * 2); + (void) Tcl_KanjiEncode(kanjiCode, argv[2], wstr1); + wstr2 = (wchar *)ckalloc((unsigned)(Tcl_KanjiEncode(kanjiCode, argv[3], NULL) + 1) * 2); + (void) Tcl_KanjiEncode(kanjiCode, argv[3], wstr2); + if (Tcl_WStringMatch(wstr2, wstr1) != 0) { + interp->result = "1"; + } else { + interp->result = "0"; + } + ckfree((char *)wstr1); + ckfree((char *)wstr2); + return TCL_OK; + } else if ((c == 'r') && (strncmp(argv[1], "range", length) == 0)) { + int first, last, stringLength; + + if (argc != 5) { + Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], + " range string first last\"", (char *) NULL); + return TCL_ERROR; + } + if (Tcl_GetInt(interp, argv[3], &first) != TCL_OK) { + return TCL_ERROR; + } + wstr1 = (wchar *)ckalloc((unsigned)(Tcl_KanjiEncode(kanjiCode, argv[2], NULL) + 1) * 2); + (void) Tcl_KanjiEncode(kanjiCode, argv[2], wstr1); + stringLength = Tcl_WStrlen(wstr1); + if ((*argv[4] == 'e') + && (strncmp(argv[4], "end", strlen(argv[4])) == 0)) { + last = stringLength-1; + } else { + if (Tcl_GetInt(interp, argv[4], &last) != TCL_OK) { + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, + "expected integer or \"end\" but got \"", + argv[4], "\"", (char *) NULL); + ckfree((char *)wstr1); + return TCL_ERROR; + } + } + if (first < 0) { + first = 0; + } + if (last >= stringLength) { + last = stringLength-1; + } + if (last >= first) { + char *str; + wchar saved; + + wp = wstr1 + last + 1; + saved = *wp; + *wp = 0; + str = (char *)ckalloc((unsigned)(Tcl_KanjiDecode(kanjiCode, wstr1+first, NULL) + 1)); + (void) Tcl_KanjiDecode(kanjiCode, wstr1+first, str); + Tcl_SetResult(interp, str, TCL_VOLATILE); + *wp = saved; + ckfree(str); + } + ckfree((char *)wstr1); + return TCL_OK; + } else if ((c == 't') && (strncmp(argv[1], "tolower", length) == 0) + && (length >= 3)) { + char *str; + + if (argc != 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], + " tolower string\"", (char *) NULL); + return TCL_ERROR; + } + wstr1 = (wchar *)ckalloc((unsigned)(Tcl_KanjiEncode(kanjiCode, argv[2], NULL) + 1) * 2); + (void) Tcl_KanjiEncode(kanjiCode, argv[2], wstr1); + for (wp = wstr1; *wp != 0; wp++) { + if (ISWUPPER(*wp)) { + *wp = tolower((char )*wp); + } + } + str = (char *)ckalloc((unsigned)(Tcl_KanjiDecode(kanjiCode, wstr1, NULL) + 1)); + (void) Tcl_KanjiDecode(kanjiCode, wstr1, str); + Tcl_SetResult(interp, str, TCL_VOLATILE); + ckfree(str); + ckfree((char *)wstr1); + return TCL_OK; + } else if ((c == 't') && (strncmp(argv[1], "toupper", length) == 0) + && (length >= 3)) { + char *str; + + if (argc != 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], + " toupper string\"", (char *) NULL); + return TCL_ERROR; + } + wstr1 = (wchar *)ckalloc((unsigned)(Tcl_KanjiEncode(kanjiCode, argv[2], NULL) + 1) * 2); + (void) Tcl_KanjiEncode(kanjiCode, argv[2], wstr1); + for (wp = wstr1; *wp != 0; wp++) { + if (ISWLOWER(*wp)) { + *wp = toupper((char )*wp); + } + } + str = (char *)ckalloc((unsigned)(Tcl_KanjiDecode(kanjiCode, wstr1, NULL) + 1)); + (void) Tcl_KanjiDecode(kanjiCode, wstr1, str); + Tcl_SetResult(interp, str, TCL_VOLATILE); + ckfree(str); + ckfree((char *)wstr1); + return TCL_OK; + } else if ((c == 't') && (strncmp(argv[1], "trim", length) == 0) + && (length == 4)) { + wchar *trimChars, *wstr; + register wchar *checkPtr; + char *str; + + left = right = 1; + + trim: + if (argc == 4) { + trimChars = (wchar *)ckalloc((unsigned)(Tcl_KanjiEncode(kanjiCode, argv[3], NULL) + 1) * 2); + (void) Tcl_KanjiEncode(kanjiCode, argv[3], trimChars); + } else if (argc == 3) { + trimChars = (wchar *)ckalloc((unsigned)(4 + 1) * 2); + (void) Tcl_KanjiEncode(kanjiCode, " \t\n\r", trimChars); + } else { + Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], + " ", argv[1], " string ?chars?\"", (char *) NULL); + return TCL_ERROR; + } + wstr1 = (wchar *)ckalloc((unsigned)(Tcl_KanjiEncode(kanjiCode, argv[2], NULL) + 1) * 2); + (void) Tcl_KanjiEncode(kanjiCode, argv[2], wstr1); + wp = wstr1; + if (left) { + for (wc = *wp; wc != 0; wp++, wc = *wp) { + for (checkPtr = trimChars; *checkPtr != wc; checkPtr++) { + if (*checkPtr == 0) { + goto doneLeft; + } + } + } + } + doneLeft: + wstr = wp; + if (right) { + wchar *donePtr; + + wp = wstr + Tcl_WStrlen(wstr) - 1; + donePtr = &wstr[-1]; + for (wc = *wp; wp != donePtr; wp--, wc = *wp) { + for (checkPtr = trimChars; *checkPtr != wc; checkPtr++) { + if (*checkPtr == 0) { + goto doneRight; + } + } + } + doneRight: + wp[1] = 0; + } + str = (char *)ckalloc((unsigned)(Tcl_KanjiDecode(kanjiCode, wstr, NULL) + 1)); + (void) Tcl_KanjiDecode(kanjiCode, wstr, str); + Tcl_SetResult(interp, str, TCL_VOLATILE); + ckfree(str); + ckfree((char *)trimChars); + ckfree((char *)wstr1); + return TCL_OK; + } else if ((c == 't') && (strncmp(argv[1], "trimleft", length) == 0) + && (length > 4)) { + left = 1; + argv[1] = "trimleft"; + goto trim; + } else if ((c == 't') && (strncmp(argv[1], "trimright", length) == 0) + && (length > 4)) { + right = 1; + argv[1] = "trimright"; + goto trim; + } else { + Tcl_AppendResult(interp, "bad option \"", argv[1], + "\": should be compare, first, index, last, length, match, ", + "range, tolower, toupper, trim, trimleft, or trimright", + (char *) NULL); + return TCL_ERROR; + } + } + #endif /* KANJI */ + /* *---------------------------------------------------------------------- * *************** *** 1489,1491 **** --- 2312,2329 ---- } return order; } + + #ifdef KANJI + static int + SortKanjiCompareProc(first, second) + CONST VOID *first, *second; /* Elements to be compared. */ + { + unsigned char *s1 = *((unsigned char **) first); + unsigned char *s2 = *((unsigned char **) second); + + for ( ; *s1 == *s2; s1++, s2++) { + if (*s1 == '\0') return 0; + } + return (*s1 - *s2); + } + #endif /* KANJI */ diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tcl7.6/generic/tclIO.c ./generic/tclIO.c *** ../tcl7.6/generic/tclIO.c Thu Oct 3 01:49:00 1996 --- ./generic/tclIO.c Fri Oct 18 13:14:08 1996 *************** *** 161,166 **** --- 161,170 ---- * event handlers ("fileevent") on this * channel. */ int bufSize; /* What size buffers to allocate? */ + #ifdef KANJI + int kanjiInputCode; /* What kanji code to expect for input. */ + int kanjiOutputCode; /* What kanji code to translate for output. */ + #endif /* KANJI */ } Channel; /* *************** *** 1187,1192 **** --- 1191,1200 ---- chanPtr->interestMask = 0; chanPtr->scriptRecordPtr = (EventScriptRecord *) NULL; chanPtr->bufSize = CHANNELBUFFER_DEFAULT_SIZE; + #ifdef KANJI + chanPtr->kanjiInputCode = TCL_ANY; + chanPtr->kanjiOutputCode = TCL_ANY; + #endif /* KANJI */ /* * Link the channel into the list of all channels; create an on-exit *************** *** 2034,2039 **** --- 2042,2055 ---- int srcCopied; /* How many bytes were copied from * the source string? */ char *destPtr; /* Where in line to copy to? */ + #ifdef KANJI + int doConversion; /* Convert the kanji code of the string? */ + int slenOriginal; /* Backup of the origianl slen. */ + int kanjiCode; + char *convertedSrc = NULL; /* The source string was converted + * to an appropriate kanji code. */ + int convertedSlen = 0; /* Actual length of convertedSrc */ + #endif /* KANJI */ chanPtr = (Channel *) chan; *************** *** 2063,2068 **** --- 2079,2100 ---- if (slen < 0) { slen = strlen(srcPtr); + #ifdef KANJI + /* + * The document says that the retrun value would be either + * equal to `slen' or `-1'. So remember the original `slen' + * since the conversion of kanji code might change the length + * of the string. + */ + slenOriginal = slen; + doConversion = 1; + } else { + doConversion = 0; + /* + * There should be a warning that no conversion was happend, + * but no interpreter was given... + */ + #endif /* KANJI */ } /* *************** *** 2071,2076 **** --- 2103,2133 ---- */ crsent = 0; + + #ifdef KANJI + /* + * Now let's convert the kanji code of the string. + * You can assume that the source string is always null terminated. + */ + if (doConversion && Tcl_KanjiString(NULL, srcPtr, &kanjiCode) != TCL_NOT_KANJI) { + int kanjiOutputCode = chanPtr->kanjiOutputCode; + if (kanjiOutputCode != TCL_ANY && kanjiOutputCode != kanjiCode) { + wchar *wstr; + + wstr = (wchar *) ckalloc( + (unsigned)(Tcl_KanjiEncode(kanjiCode, srcPtr, NULL) + 1) * sizeof(wchar)); + (void) Tcl_KanjiEncode(kanjiCode, srcPtr, wstr); + convertedSrc = (char *) ckalloc( + (unsigned)(Tcl_KanjiDecode(kanjiOutputCode, wstr, NULL) + 1)); + convertedSlen = Tcl_KanjiDecode(kanjiOutputCode, wstr, convertedSrc); + ckfree((char *) wstr); + + srcPtr = convertedSrc; + slen = convertedSlen; + } + + } + #endif /* KANJI */ /* * Loop filling buffers and flushing them until all output has been *************** *** 2174,2184 **** --- 2231,2260 ---- if (chanPtr->flags & BUFFER_READY) { if (FlushChannel(NULL, chanPtr, 0) != 0) { + #ifdef KANJI + if (convertedSrc) { + ckfree(convertedSrc); + } + #endif /* KANJI */ return -1; } } } /* Closes "while" */ + #ifdef KANJI + if (convertedSrc) { + ckfree(convertedSrc); + } + + /* + * If the conversion of kanji code was occured, + * return the original length of the source string. + * Is it acceptable??? :-) + */ + if (doConversion) { + return slenOriginal; + } + #endif /* KANJI */ return totalDestCopied; } *************** *** 3041,3046 **** --- 3117,3125 ---- * translated newline. If this is zero * and neither EOF nor BLOCKED is set, * the current line is empty. */ + #ifdef KANJI + int kanjiCode; + #endif /* KANJI */ chanPtr = (Channel *) chan; *************** *** 3095,3100 **** --- 3174,3198 ---- if ((copiedTotal > 0) && (buf[copiedTotal - 1] == '\n')) { copiedTotal--; } + #ifdef KANJI + if (Tcl_KanjiString(NULL, buf, &kanjiCode) != TCL_NOT_KANJI) { + int kanjiInputCode = chanPtr->kanjiInputCode; + if (kanjiInputCode != TCL_ANY && kanjiInputCode != kanjiCode) { + wchar *wstr; + + buf[lineLen] = '\0'; + wstr = (wchar *)ckalloc( + (unsigned)(Tcl_KanjiEncode(kanjiCode, buf, NULL) + 1) * sizeof(wchar)); + (void) Tcl_KanjiEncode(kanjiCode, buf, wstr); + lineLen = Tcl_KanjiDecode(kanjiInputCode, wstr, NULL); + Tcl_DStringSetLength(lineRead, lineLen + offset); + (void) Tcl_KanjiDecode(kanjiInputCode, wstr, buf); + + ckfree((char *)wstr); + return lineLen; + } + } + #endif /* KANJI */ Tcl_DStringSetLength(lineRead, copiedTotal + offset); return copiedTotal; } *************** *** 3710,3715 **** --- 3808,3835 ---- return TCL_OK; } } + #ifdef KANJI + if ((len == 0) || ((len > 1) && (optionName[1] == 'i') && + (strncmp(optionName, "-inputCode", len) == 0))) { + if (len == 0) { + Tcl_DStringAppendElement(dsPtr, "-inputCode"); + } + Tcl_DStringAppendElement(dsPtr, Tcl_KanjiCodeStr[chanPtr->kanjiInputCode]); + if (len > 0) { + return TCL_OK; + } + } + if ((len == 0) || ((len > 1) && (optionName[1] == 'o') && + (strncmp(optionName, "-outputCode", len) == 0))) { + if (len == 0) { + Tcl_DStringAppendElement(dsPtr, "-outputCode"); + } + Tcl_DStringAppendElement(dsPtr, Tcl_KanjiCodeStr[chanPtr->kanjiOutputCode]); + if (len > 0) { + return TCL_OK; + } + } + #endif /* KANJI */ if ((len == 0) || ((len > 1) && (optionName[1] == 't') && (strncmp(optionName, "-translation", len) == 0))) { *************** *** 3915,3920 **** --- 4035,4051 ---- return TCL_OK; } + #ifdef KANJI + if ((len > 1) && (optionName[1] == 'i') && + (strncmp(optionName, "-inputCode", len) == 0)) { + return Tcl_GetKanjiCode(interp, newValue, &(chanPtr->kanjiInputCode)); + } + if ((len > 1) && (optionName[1] == 'o') && + (strncmp(optionName, "-outputCode", len) == 0)) { + return Tcl_GetKanjiCode(interp, newValue, &(chanPtr->kanjiOutputCode)); + } + #endif /* KANJI */ + if ((len > 1) && (optionName[1] == 't') && (strncmp(optionName, "-translation", len) == 0)) { if (Tcl_SplitList(interp, newValue, &argc, &argv) == TCL_ERROR) { *************** *** 4076,4082 **** --- 4207,4217 ---- if (interp != (Tcl_Interp *) NULL) { Tcl_AppendResult(interp, "bad option \"", optionName, "\": should be -blocking, -buffering, -buffersize, ", + #ifdef KANJI + "-eofchar, -inputCode, -outputCode, -translation, ", + #else "-eofchar, -translation, ", + #endif /* KANJI */ "or channel type specific option", (char *) NULL); } diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tcl7.6/generic/tclIOCmd.c ./generic/tclIOCmd.c *** ../tcl7.6/generic/tclIOCmd.c Thu Oct 3 01:49:01 1996 --- ./generic/tclIOCmd.c Fri Oct 18 13:14:08 1996 *************** *** 748,754 **** --- 748,758 ---- Tcl_DStringFree(&ds); Tcl_AppendResult(interp, "bad option \"", argv[2], "\": must be -blocking, -buffering, -buffersize, ", + #ifdef KANJI + "-eofchar, -inputCode, -outputCode, -translation, ", + #else "-eofchar, -translation, ", + #endif /* KANJI */ "or a channel type specific option", (char *) NULL); return TCL_ERROR; } *************** *** 1088,1093 **** --- 1092,1103 ---- if (chan == (Tcl_Channel) NULL) { return TCL_ERROR; } + #ifdef KANJI + (void) Tcl_SetChannelOption(NULL, chan, "-inputCode", + Tcl_KanjiCodeStr[((Interp *)interp)->kanjiInputCode]); + (void) Tcl_SetChannelOption(NULL, chan, "-outputCode", + Tcl_KanjiCodeStr[((Interp *)interp)->kanjiOutputCode]); + #endif /* KANJI */ Tcl_RegisterChannel(interp, chan); Tcl_AppendResult(interp, Tcl_GetChannelName(chan), (char *) NULL); return TCL_OK; diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tcl7.6/generic/tclInt.h ./generic/tclInt.h *** ../tcl7.6/generic/tclInt.h Thu Oct 3 01:48:49 1996 --- ./generic/tclInt.h Fri Oct 18 13:14:09 1996 *************** *** 570,575 **** --- 570,584 ---- * this interpreter is deleted. */ char resultSpace[TCL_RESULT_SIZE+1]; /* Static space for storing small results. */ + + #ifdef KANJI + /* + * Information related to kanji: + */ + int kanjiCode; + int kanjiInputCode; + int kanjiOutputCode; + #endif /* KANJI */ } Interp; /* *************** *** 881,886 **** --- 890,900 ---- EXTERN int TclParseBraces _ANSI_ARGS_((Tcl_Interp *interp, char *string, char **termPtr, ParseValue *pvPtr)); + #ifdef KANJI + EXTERN int TclParseKanji _ANSI_ARGS_((Tcl_Interp *interp, + char *string, int kanjiCode, char **termPtr, + ParseValue *pvPtr)); + #endif /* KANJI */ EXTERN int TclParseNestedCmd _ANSI_ARGS_((Tcl_Interp *interp, char *string, int flags, char **termPtr, ParseValue *pvPtr)); *************** *** 1007,1012 **** --- 1021,1038 ---- Tcl_Interp *interp, int argc, char **argv)); EXTERN int Tcl_JoinCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int argc, char **argv)); + #ifdef KANJI + EXTERN int Tcl_KanjiCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); + EXTERN int Tcl_KlsearchCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); + EXTERN int Tcl_KlsortCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); + EXTERN int Tcl_KsplitCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); + EXTERN int Tcl_KstringCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); + #endif /* KANJI */ EXTERN int Tcl_LappendCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int argc, char **argv)); EXTERN int Tcl_LindexCmd _ANSI_ARGS_((ClientData clientData, diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tcl7.6/generic/tclKanjiUtil.c ./generic/tclKanjiUtil.c *** ../tcl7.6/generic/tclKanjiUtil.c Thu Jan 1 09:00:00 1970 --- ./generic/tclKanjiUtil.c Fri Oct 18 13:14:09 1996 *************** *** 0 **** --- 1,1715 ---- + /* + * tclKanjiUtil.c -- + * + * This file contains utility procedures that are used by many Tcl + * commands. + * + * Copyright (c) 1988-1995 Software Research Associates, Inc. + * Permission to use, copy, modify, and distribute this software and its + * documentation for any purpose and without fee is hereby granted, provided + * that the above copyright notice appear in all copies and that both that + * copyright notice and this permission notice appear in supporting + * documentation, and that the name of Software Research Associates not be + * used in advertising or publicity pertaining to distribution of the + * software without specific, written prior permission. Software Research + * Associates makes no representations about the suitability of this software + * for any purpose. It is provided "as is" without express or implied + * warranty. + */ + + #ifndef lint + static char rcsid[] = "$Header: /ext/cvsroot/tcl/generic/tclKanjiUtil.c,v 1.3 1996/07/05 02:12:27 nisinaka Exp $"; + #endif + + #ifdef KANJI + + #include "tclInt.h" + #include "tclPort.h" + + /* + * If C_LOCALE_SPECIAL is defined, C locale is treated specially. + * When the locale is C, the automatic kanji encoding detection + * feature is disabled, so that any string is recognized as a normal + * (ISO Latin-1) string. + * This makes Japanized Tcl to behave just like the original Tcl. + */ + #define C_LOCALE_SPECIAL + + /* + * For setlocale() call. + */ + #ifdef HAVE_SETLOCALE + #include + #endif + + /* + * This array holds the printable kanji code name corresponding to + * the kanji code defined in tcl.h. + */ + + char *Tcl_KanjiCodeStr[] = { "JIS", "SJIS", "EUC", "ANY" }; + + #ifdef C_LOCALE_SPECIAL + /* + * This variable indicates whether some special Kanji related feature + * is disabled nor not. + */ + static int noKanjiFeature = 0; + #endif /* C_LOCALE_SPECIAL */ + + /* + * Function prototypes for local procedures in this file: + */ + static int EncodingDetection _ANSI_ARGS_((Tcl_Interp *interp, + char *string)); + + #define T_ASCII 0 + #define T_KANJI 1 + #define T_KANA 2 + + /* + *---------------------------------------------------------------------- + * + * Tcl_KanjiEncode -- + * + * Encode kanji string to wide string. + * + * Results: + * Number of the encoded characters. (Not bytes) + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + + int + Tcl_KanjiEncode(kanjiCode, ks, ws) + int kanjiCode; + unsigned char *ks; + wchar *ws; + { + switch (kanjiCode) { + case TCL_JIS: + return Tcl_EncodeJIS(ks, ws); + case TCL_SJIS: + return Tcl_EncodeSJIS(ks, ws); + case TCL_EUC: + return Tcl_EncodeEUC(ks, ws); + case TCL_ANY: + return Tcl_EncodeANY(ks, ws); + default: + panic("Tcl_KanjiEncode: Unknown kanjiCode."); + } + } + + /* + *---------------------------------------------------------------------- + * + * Tcl_KanjiDecode -- + * + * Decode kanji string to wide string. + * + * Results: + * Number of the encoded characters. (Not bytes) + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + + int + Tcl_KanjiDecode(kanjiCode, ws, ks) + int kanjiCode; + wchar *ws; + unsigned char *ks; + { + switch (kanjiCode) { + case TCL_JIS: + return Tcl_DecodeJIS(ws, ks); + case TCL_SJIS: + return Tcl_DecodeSJIS(ws, ks); + case TCL_EUC: + return Tcl_DecodeEUC(ws, ks); + case TCL_ANY: + return Tcl_DecodeANY(ws, ks); + default: + panic("Tcl_KanjiDecode: Unknown kanjiCode."); + } + } + + /* + *---------------------------------------------------------------------- + * + * Tcl_EncodeJIS -- + * + * Encode JIS kanji string to wide string. + * + * Results: + * Number of the encoded characters. (Not bytes) + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + + int + Tcl_EncodeJIS(js, ws) + unsigned char *js; + wchar *ws; + { + int c, c1; + int kanji = T_ASCII; + int n = 0; + + while( c = *js++ ) { + if( c == '\033' ) { + if( !strncmp(js, "$B", 2) || !strncmp(js, "$@", 2)) { + kanji = T_KANJI; + js += 2; + } else if( !strncmp(js, "(J", 2) || !strncmp(js, "(B", 2) ) { + kanji = T_ASCII; + js += 2; + } else if( !strncmp(js, "(I", 2) ) { + kanji = T_KANA; + js += 2; + } else { + if( ws ) *ws++ = c; + n++; + } + } else if( kanji == T_KANJI ) { + c1 = *js++; + if( c1 == '\0' ) break; + if( ws ) *ws++ = (c << 8) | c1 | 0x8080; + n++; + } else { + if( ws ) *ws++ = c | ((kanji == T_KANA) ? 0x80 : 0); + n++; + } + } + if( ws ) *ws = 0; + + return n; + } + + /* + *---------------------------------------------------------------------- + * + * Tcl_DecodeJIS -- + * + * Decode wide string to JIS kanji string. + * + * Results: + * Bytes of the decoded kanji string. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + + int + Tcl_DecodeJIS(ws, js) + wchar *ws; + unsigned char *js; + { + int c; + int kanji = T_ASCII; + int n = 0; + + while( c = *ws++ ) { + switch( c & 0x8080 ) { + case 0: + if( kanji != T_ASCII ) { + if( js ) { + *js++ = '\033'; + *js++ = '('; + *js++ = 'B'; + } + n += 3; + } + if( js ) *js++ = c & 0x7f; + n++; + kanji = T_ASCII; + break; + case 0x80: + if( kanji != T_KANA ) { + if( js ) { + *js++ = '\033'; + *js++ = '('; + *js++ = 'I'; + } + n += 3; + } + if( js ) *js++ = c & 0x7f; + n++; + kanji = T_KANA; + break; + case 0x8080: + if( kanji != T_KANJI ) { + if( js ) { + *js++ = '\033'; + *js++ = '$'; + *js++ = 'B'; + } + n += 3; + } + if( js ) { + *js++ = (c >> 8) & 0x7f; + *js++ = c & 0x7f; + } + n += 2; + kanji = T_KANJI; + break; + } + } + if( kanji != T_ASCII ) { + if( js ) { + *js++ = '\033'; + *js++ = '('; + *js++ = 'B'; + } + n += 3; + } + if( js ) *js = '\0'; + + return n; + } + + /* + *---------------------------------------------------------------------- + * + * Tcl_EncodeSJIS -- + * + * Encode SJIS kanji string to wide string. + * + * Results: + * Number of the encoded characters. (Not bytes) + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + + #define IS_SJIS(c) (((c) >= 0x81 && (c) <= 0x9f) || ((c) >= 0xe0 && (c) <= 0xfc)) + + int + Tcl_EncodeSJIS(ss, ws) + unsigned char *ss; + wchar *ws; + { + int c, c1; + int n = 0; + + while( c = *ss++ ) { + if( IS_SJIS(c) ) { + c1 = *ss++; + c -= (c>=0xa0) ? 0xc1 : 0x81; + if( ws ) { + if( c1 >= 0x9f ) { + *ws++ = ((c<<9) + 0x2200 + c1 - 0x7e) | 0x8080; + } else { + *ws++ = ((c<<9) + 0x2100 + c1 + - ((c1<=0x7e) ? 0x1f : 0x20)) | 0x8080; + } + } + n++; + } else { + if( ws ) *ws++ = c; + n++; + } + } + if( ws ) *ws = 0; + + return n; + } + + /* + *---------------------------------------------------------------------- + * + * Tcl_DecodeSJIS -- + * + * Decode wide string to SJIS kanji string. + * + * Results: + * Bytes of the decoded kanji string. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + + int + Tcl_DecodeSJIS(ws, ss) + wchar *ws; + unsigned char *ss; + { + int c1, c2; + int n = 0; + + while( c1 = *ws++ ) { + switch( c1 & 0x8080 ) { + case 0: + case 0x80: + if( ss ) *ss++ = c1 & 0xff; + n++; + break; + case 0x8080: + c2 = c1 & 0x7f; + c1 = (c1 >> 8) & 0x7f; + if( ss ) { + *ss++ = (c1 - 0x21) / 2 + ((c1 <= 0x5e) ? 0x81 : 0xc1); + if( c1 & 1 ) { /* odd */ + *ss++ = c2 + ((c2 <= 0x5f) ? 0x1f : 0x20); + } else { + *ss++ = c2 + 0x7e; + } + } + n += 2; + break; + } + } + if( ss ) *ss = '\0'; + + return n; + } + + /* + *---------------------------------------------------------------------- + * + * Tcl_EncodeEUC -- + * + * Encode EUC kanji string to wide string. + * + * Results: + * Number of the encoded characters. (Not bytes) + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + + int + Tcl_EncodeEUC(es, ws) + unsigned char *es; + wchar *ws; + { + int c; + int n = 0; + + while( c = *es++ ) { + if( c == 0x8e ) { /* SS2 */ + if( ws ) *ws++ = *es | 0x80; + es++; + n++; + } else if( c == 0x8f ) { /* SS3 */ + c = *es++; + if( ws ) *ws++ = (c << 8) | (*es & 0x7f) | 0x8000; + es++; + n++; + } else if( c & 0x80 ) { + if( ws ) *ws++ = (c << 8) | *es | 0x8080; + es++; + n++; + } else { + if( ws ) *ws++ = c; + n++; + } + } + if( ws ) *ws = 0; + + return n; + } + + /* + *---------------------------------------------------------------------- + * + * Tcl_DecodeEUC -- + * + * Decode wide string to EUC kanji string. + * + * Results: + * Bytes of the decoded kanji string. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + + int + Tcl_DecodeEUC(ws, es) + wchar *ws; + unsigned char *es; + { + int c; + int n = 0; + + while( c = *ws++ ) { + switch( c & 0x8080 ) { + case 0: + if( es ) *es++ = c & 0x7f; + n++; + break; + case 0x80: + if( es ) { + *es++ = 0x8e; /* SS2 */ + *es++ = c & 0xff; + } + n += 2; + break; + case 0x8000: + if( es ) { + *es++ = 0x8f; /* SS3 */ + *es++ = (c >> 8) | 0x80; + *es++ = (c & 0xff) | 0x80; + } + n += 3; + break; + case 0x8080: + if( es ) { + *es++ = c >> 8; + *es++ = c & 0xff; + } + n += 2; + break; + } + } + if( es ) *es = '\0'; + + return n; + } + + /* + *---------------------------------------------------------------------- + * + * Tcl_EncodeANY -- + * + * Encode ANY kanji string to wide string. (as ascii string) + * + * Results: + * Number of the encoded characters. (Not bytes) + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + + int + Tcl_EncodeANY(as, ws) + unsigned char *as; + wchar *ws; + { + int c; + int n = 0; + + while( c = *as++ ) { + if( ws ) *ws++ = c; + n++; + } + if( ws ) *ws = 0; + + return n; + } + + /* + *---------------------------------------------------------------------- + * + * Tcl_DecodeANY -- + * + * Decode wide string to ANY kanji string. (as ascii string) + * + * Results: + * Bytes of the decoded kanji string. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + + int + Tcl_DecodeANY(ws, as) + wchar *ws; + unsigned char *as; + { + int c; + int n = 0; + + while( c = *ws++ ) { + switch( c & 0x8080 ) { + case 0: + case 0x80: + if( as ) *as++ = c & 0xff; + n++; + break; + case 0x8000: + case 0x8080: + if( as ) { + *as++ = c >> 8; + *as++ = c & 0xff; + } + n += 2; + break; + } + } + if( as ) *as = '\0'; + + return n; + } + + /* + *---------------------------------------------------------------------- + * + * Tcl_DefaultKanjiCode -- + * + * Determine the default Kanji code from current locale. + * + * Results: + * This procudure returns a kanji code to be used as a default. + * + * Side effects: + * None. + *---------------------------------------------------------------------- + */ + + int + Tcl_DefaultKanjiCode() + { + char *lang; + int i; + static struct lang { + char *lang; + int code; + } langtab[] = { + "ja_JP.SJIS", TCL_SJIS, + "ja_JP.EUC", TCL_EUC, + "ja_JP.JIS", TCL_JIS, + "ja_JP.mscode", TCL_SJIS, /* from Xsi nls database */ + "ja_JP.ujis", TCL_EUC, /* from Xsi nls database */ + "ja_JP", TCL_EUC, /* IBM */ + "Ja_JP", TCL_SJIS, /* IBM */ + "Jp_JP", TCL_SJIS, /* IBM */ + "japan", TCL_EUC, /* MIPS, NEC */ + #ifdef hpux + "japanese", TCL_SJIS, /* HP */ + #else + "japanese", TCL_EUC, /* SUN */ + #endif + "japanese.sjis",TCL_SJIS, /* HP? */ + "japanese.euc", TCL_EUC, /* HP */ + "japanese-sjis",TCL_SJIS, /* IBM */ + "japanese-ujis",TCL_EUC, /* IBM */ + "C", TCL_ANY, + NULL, 0, + }; + + #ifdef HAVE_SETLOCALE + static int firstcall = 1; + + if (firstcall) { + setlocale(LC_ALL, ""); + firstcall = 0; + } + + lang = setlocale(LC_CTYPE, NULL); + #else /* HAVE_SETLOCALE */ + lang = getenv("LANG"); + #endif /* HAVE_SETLOCALE */ + + if (lang != NULL) { + /* + * If the LANG variable is "C", skip some of the + * Kanji related feature (e.g. automatic encoding detection) + */ + #ifdef C_LOCALE_SPECIAL + if (!strcmp(lang, "C")) noKanjiFeature = 1; + #endif /* C_LOCALE_SPECIAL */ + for (i = 0; langtab[i].lang != NULL; i++) { + if (!strcmp(langtab[i].lang, lang)) { + return langtab[i].code; + } + } + } + return TCL_DEFAULT_KANJI_CODE; + } + + + /* + *---------------------------------------------------------------------- + * + * Tcl_KanjiCode -- + * + * Returns the internal kanji code of the interpreter. + * + * Results: + * The internal kanji code. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + + int + Tcl_KanjiCode(interp) + Tcl_Interp *interp; + { + return ((Interp *)interp)->kanjiCode; + } + + /* + *---------------------------------------------------------------------- + * + * Tcl_KanjiStart -- + * + * Check if the string starts with kanji or not. + * + * KanjiCodePtr is a pointer to an int which specifies + * the encoding of the given string. This procedure + * checks if the first character of the string is a + * kanji. + * + * If the value pointed by kanjiCodePtr is TCL_ANY, + * and if the first character of the string seems to be + * a kanji character, this procedure examines the string + * further, determines the encoding used, and assign the + * encoding value to *kanjiCodePtr. + * + * Results: + * If the first character of the given string is kanji, + * this procedure returns 1. Otherwise 0 is returned. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + + int + Tcl_KanjiStart(string, kanjiCodePtr) + register unsigned char *string; + register int *kanjiCodePtr; + { + register unsigned char c = *string; + + #ifdef C_LOCALE_SPECIAL + if (noKanjiFeature) return 0; + #endif /* C_LOCALE_SPECIAL */ + retry: + switch (*kanjiCodePtr) { + case TCL_ANY: + if (c != '\033' && c < 0x80) return 0; + *kanjiCodePtr = EncodingDetection((Tcl_Interp *)NULL, string); + goto retry; + case TCL_JIS: + return (c == '\033' && string[1] == '$' && + (string[2] == 'B' || string[2] == '@')); + case TCL_SJIS: + return ((0x81 <= c && c <= 0x9f) || (0xe0 <= c && c <= 0xfc)); + case TCL_EUC: + return (c == 0x8e || c == 0x8f || (c & 0x80)); + default: /* TCL_NOT_KANJI */ + return 0; + } + } + + /* + *---------------------------------------------------------------------- + * + * Tcl_KanjiEnd -- + * + * Check if the string ends with kanji or not. + * + * KanjiCodePtr is a pointer to an int which specifies + * the encoding of the given string. This procedure + * checks if the last character of the string is a + * kanji. + * + * If the value pointed by kanjiCodePtr is TCL_ANY, + * and if the last character of the string seems to be + * a kanji character, this procedure examines the string + * further, determines the encoding used, and assign the + * encoding value to *kanjiCodePtr. + * + * Results: + * If the last character of the given string is kanji, + * this procedure returns 1. Otherwise 0 is returned. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + + int + Tcl_KanjiEnd(string, kanjiCodePtr) + register unsigned char *string; + register int *kanjiCodePtr; + { + int len = strlen(string); + unsigned char *p; + int kanjiCode, result; + + #ifdef C_LOCALE_SPECIAL + if (noKanjiFeature) return 0; + #endif /* C_LOCALE_SPECIAL */ + + switch (*kanjiCodePtr) { + case TCL_ANY: + while (*string != 0 && *string != '\033' && *string < 0x80) string++; + break; + case TCL_JIS: + p = string + len; + return (len > 3 && p[-3] == '\033' && p[-2] == '(' && + (p[-1] == 'J' || p[-1] == 'B')); + case TCL_SJIS: + while (len > 0 && string[--len] > 0x3F) ; + string += len; + while (*string != 0 && *string < 0x80) string++; + break; + case TCL_EUC: + while (len > 0 && string[--len] > 0x7F) ; + if (len > 0) string += (len + 1); + break; + default: /* TCL_NOT_KANJI */ + return 0; + } + + if ((len = strlen(string)) < 2) return 0; + for (p = string; *p != 0; p++) { + kanjiCode = *kanjiCodePtr; + if ((result = Tcl_KanjiStart(p, &kanjiCode))) { + p += (Tcl_KanjiLength(p, kanjiCode) - 1); + } + } + return result; + } + + /* + *---------------------------------------------------------------------- + * + * Tcl_KanjiLength -- + * + * Count a byte number of the given kanji sequence. + * + * Results: + * Return value is a byte number of the kanji sequence. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + + int + Tcl_KanjiLength(string, kanjiCode) + register unsigned char *string; + register int kanjiCode; + { + register unsigned char c, *src = string; + + switch( kanjiCode ) { + case TCL_JIS: + while( c = *src++ ) { + if( c == '\033' && *src == '(' && + (*(src+1) == 'J' || *(src+1) == 'B') ) { + src += 3; + break; + } + } + break; + case TCL_SJIS: + while( c = *src++ ) { + if( (c >= 0x81 && c <= 0x9f) || (c >= 0xe0 && c <= 0xfc) ) { + src++; + } else { + break; + } + } + break; + case TCL_EUC: + while( c = *src++ ) { + if( c == 0x8e ) { + src++; + } else if( c == 0x8f ) { + src += 2; + } else if( c & 0x80 ) { + src++; + } else { + break; + } + } + break; + } + + return (int )(src - string - 1); + } + + /* + *---------------------------------------------------------------------- + * + * Tcl_KanjiString -- + * + * Check if the string contains kanji. + * + * Results: + * If the string contains kanji, set its kanji code + * and return TCL_OK. Otherwise return TCL_NOT_KANJI. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + + int + Tcl_KanjiString(interp, string, kanjiCodePtr) + Tcl_Interp *interp; + char *string; + int *kanjiCodePtr; + { + int encoding; + + if ( + #ifdef C_LOCALE_SPECIAL + noKanjiFeature || + #endif /* C_LOCALE_SPECIAL */ + (encoding = EncodingDetection(interp, string)) == TCL_NOT_KANJI) { + *kanjiCodePtr = TCL_ANY; + return TCL_NOT_KANJI; + } else { + *kanjiCodePtr = encoding; + return TCL_OK; + } + } + + /* + *---------------------------------------------------------------------- + * + * EncodingDetection -- + * + * Determine the encoding (kanji code) of the given string. + * This procedure assumes that the given string contains + * only ASCII and kanji (defined by the standard JIS X0208) + * characters. (i.e. no 1byte-kana and no user-defined + * characters are present) + * + * The interp argument is used to retrieve the internal code + * of the interpreter, and the internal code is used to help + * determining the encoding when it is ambiguous. Interp might + * be NULL. + * + * Results: + * The return value is the encoding (kanji code) of the + * given string. If the string contains only ASCII + * characters, TCL_NOT_KANJI will be returned. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + + static int + EncodingDetection(interp, string) + Tcl_Interp *interp; + char *string; + { + unsigned char *s = (unsigned char *)string; + int c; + int kanji_found = 0; + + while ((c = *s++) != '\0') { + if (c == '\033') { + /* + * It might be JIS encoding. The valid JIS + * sequences are: + * ESC $ B ESC $ ( B -- designate JIS X0208 + * ESC $ @ ESC $ ( @ -- designate old JIS X0208 + * ESC ( B -- designate ASCII + * ESC ( J -- designate JIS X0201 + */ + if (((c = *s++) == '$' && + (((c = *s++) == '(' && ((c = *s++) == 'B' || c == '@')) || + (c == 'B' || c == '@'))) || + (c == '(' && ((c = *s++) == 'B' || c == 'J'))) { + return TCL_JIS; + } + } else if (c <= 0x80) { + /* + * ASCII character or 0x80 (which is not a + * valid EUC/SJIS/JIS character) -- skip it + */ + continue; + } else if (c < 0xa1) { + /* SJIS character */ + return TCL_SJIS; + } else if (c < 0xdf) { + /* EUC character */ + return TCL_EUC; + } else if (c <= 0xea) { + /* SJIS or EUC character -- ambiguous */ + /* get the second byte */ + if ((c = *s++) < 0xa1) { + return TCL_SJIS; + } else if (c > 0xfc) { + return TCL_EUC; + } + /* + * Still ambiguous. Continue examining, and + * remember that kanji is found. + */ + kanji_found = 1; + } else if (c <= 0xf4) { + /* EUC character */ + return TCL_EUC; + break; + } + if (c == '\0') break; + } + + if (kanji_found) { + /* + * The given string contains kanji character(s), + * but the encoding cannot be determined. It is + * either SJIS or EUC. So we have to make a guess, + * based on the following hypothesis: + * + * a) It is likely that the encoding of the string + * is the same as the internal encoding of the interpreter, + * which is determined by the environmental variable $LANG. + * b) If above fails (ie the internal code is neither + * SJIS nor EUC), it is likely that the encoding + * is the same as TCL_DEFAULT_KANJI_CODE, which + * is chosen by the installer at compilation time. + */ + int internalCode; + + if (interp != NULL && + ((internalCode = Tcl_KanjiCode(interp)) == TCL_SJIS || + internalCode == TCL_EUC)) { + return internalCode; + } else if (TCL_DEFAULT_KANJI_CODE == TCL_SJIS || + TCL_DEFAULT_KANJI_CODE == TCL_EUC) { + return TCL_DEFAULT_KANJI_CODE; + } + return TCL_EUC; /* no luck. just a wild guess */ + } + + /* no kanji found */ + return TCL_NOT_KANJI; + } + + /* + *---------------------------------------------------------------------- + * + * Tcl_GetKanjiCode -- + * + * Get the kanji code according to the string. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + + int + Tcl_GetKanjiCode(interp, string, kanjiCodePtr) + Tcl_Interp *interp; + char *string; + int *kanjiCodePtr; + { + if( strcmp(string, "JIS") == 0 ) { + *kanjiCodePtr = TCL_JIS; + } else if( strcmp(string, "SJIS") == 0 ) { + *kanjiCodePtr = TCL_SJIS; + } else if( strcmp(string, "EUC") == 0 ) { + *kanjiCodePtr = TCL_EUC; + } else if( strcmp(string, "ANY") == 0 ) { + *kanjiCodePtr = TCL_ANY; + } else { + Tcl_AppendResult(interp, "bad kanjiCode \"", string, + "\": should be JIS, SJIS, EUC, or ANY", (char *) NULL); + return TCL_ERROR; + } + + return TCL_OK; + } + + /* + *---------------------------------------------------------------------- + * + * Tcl_KanjiFile -- + * + * Check if the file contains kanji. + * + * Results: + * If the string contains kanji, set its kanji code + * and return TCL_OK. Otherwise return TCL_ERROR. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + + int + Tcl_KanjiFile(interp, fileName, kanjiCodePtr) + Tcl_Interp *interp; + char *fileName; + int *kanjiCodePtr; + { + Tcl_Channel chan; + Tcl_DString ds, kc; + int length, result = TCL_OK; + + chan = Tcl_OpenFileChannel(interp, fileName, "r", 0); + if (chan == (Tcl_Channel) NULL) { + return TCL_ERROR; + } + + *kanjiCodePtr = TCL_ANY; + Tcl_DStringInit(&ds); + Tcl_DStringInit(&kc); + (void) Tcl_GetChannelOption(chan, "-inputCode", &kc); + (void) Tcl_SetChannelOption(interp, chan, "-inputCode", "ANY"); + while ((length = Tcl_Gets(chan, &ds)) > 0) { + (void) Tcl_KanjiString(interp, Tcl_DStringValue(&ds), kanjiCodePtr); + if (*kanjiCodePtr != TCL_ANY) { + break; + } + } + (void) Tcl_SetChannelOption(interp, chan, "-inputCode", Tcl_DStringValue(&kc)); + Tcl_DStringFree(&ds); + Tcl_DStringFree(&kc); + + if (length < 0) { + if (!Tcl_Eof(chan) && !Tcl_InputBlocked(chan)) { + Tcl_AppendResult(interp, "error reading \"", + Tcl_GetChannelName(chan), "\": ", Tcl_PosixError(interp), + (char *) NULL); + result = TCL_ERROR; + } + } + + if (Tcl_Close(interp, chan) != TCL_OK) { + result = TCL_ERROR; + } + + return result; + } + + /* + *-------------------------------------------------------------- + * + * Tcl_WStrlen -- + * + * Get the length of the wide string. + * + * Results: + * Number of the wide characters. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + + int + Tcl_WStrlen(wstr) + wchar *wstr; + { + int n = 0; + + while( *wstr++ ) n++; + + return n; + } + + /* + *-------------------------------------------------------------- + * + * Tcl_WStrcpy -- + * + * Copy the wide string. + * + * Results: + * Pointer to the original string. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + + wchar * + Tcl_WStrcpy(wstr1, wstr2) + wchar *wstr1, *wstr2; + { + wchar *ans = wstr1; + + while( *wstr1++ = *wstr2++ ) ; + + return( ans ); + } + + /* + *-------------------------------------------------------------- + * + * Tcl_WStrncpy -- + * + * Copy the specific number of wide characters. + * + * Results: + * Pointer to the original string. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + + wchar * + Tcl_WStrncpy(wstr1, wstr2, n) + wchar *wstr1, *wstr2; + int n; + { + wchar *ans = wstr1; + + while( n-- > 0 && (*wstr1++ = *wstr2++) ) ; + + while( n-- > 0 ) *wstr1++ = 0; + + return( ans ); + } + + /* + *-------------------------------------------------------------- + * + * Tcl_WStrcmp -- + * + * Compare two wide strings. + * + * Results: + * Return 0 if two strings are same. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + + int + Tcl_WStrcmp(wstr1, wstr2) + wchar *wstr1, *wstr2; + { + while( *wstr1 && *wstr1 == *wstr2 ) wstr1++, wstr2++; + + return( *wstr1 - *wstr2 ); + } + + /* + *-------------------------------------------------------------- + * + * Tcl_WStrncmp -- + * + * Compare two wide strings. + * + * Results: + * Return 0 if two strings are same. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + + int + Tcl_WStrncmp(wstr1, wstr2, n) + wchar *wstr1, *wstr2; + int n; + { + while( n-- > 0 && *wstr1 && *wstr1 == *wstr2 ) wstr1++, wstr2++; + + if( n < 0 ) return( 0 ); + + return( *wstr1 - *wstr2 ); + } + + /* + *-------------------------------------------------------------- + * + * Tcl_WStrstr -- + * + * Locate the first instance of a substring in a string. + * + * Results: + * If string contains substring, the return value is the + * location of the first matching instance of substring + * in string. If string doesn't contain substring, the + * return value is 0. Matching is done on an exact + * character-for-character basis with no wildcards or special + * characters. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + + wchar * + Tcl_WStrstr(wstr, subwstr) + register wchar *wstr; /* String to search. */ + wchar *subwstr; /* Substring to try to find in string. */ + { + register wchar *a, *b; + + /* First scan quickly through the two strings looking for a + * single-character match. When it's found, then compare the + * rest of the substring. + */ + + b = subwstr; + if (*b == 0) { + return wstr; + } + for ( ; *wstr != 0; wstr += 1) { + if (*wstr != *b) { + continue; + } + a = wstr; + while (1) { + if (*b == 0) { + return wstr; + } + if (*a++ != *b++) { + break; + } + } + b = subwstr; + } + return (wchar *) 0; + } + + /* + *---------------------------------------------------------------------- + * + * Tcl_WStringMatch -- + * + * See if a particular wide string matches a particular pattern. + * + * Results: + * The return value is 1 if string matches pattern, and + * 0 otherwise. The matching operation permits the following + * special characters in the pattern: *?\[] (see the manual + * entry for details on what these mean). + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + + int + Tcl_WStringMatch(string, pattern) + register wchar *string; /* String. */ + register wchar *pattern; /* Pattern, which may contain + * special characters. */ + { + wchar c2; + + while (1) { + /* See if we're at the end of both the pattern and the string. + * If so, we succeeded. If we're at the end of the pattern + * but not at the end of the string, we failed. + */ + + if (*pattern == 0) { + if (*string == 0) { + return 1; + } else { + return 0; + } + } + if ((*string == 0) && (*pattern != '*')) { + return 0; + } + + /* Check for a "*" as the next pattern character. It matches + * any substring. We handle this by calling ourselves + * recursively for each postfix of string, until either we + * match or we reach the end of the string. + */ + + if (*pattern == '*') { + pattern += 1; + if (*pattern == 0) { + return 1; + } + while (1) { + if (Tcl_WStringMatch(string, pattern)) { + return 1; + } + if (*string == 0) { + return 0; + } + string += 1; + } + } + + /* Check for a "?" as the next pattern character. It matches + * any single character. + */ + + if (*pattern == '?') { + goto thisCharOK; + } + + /* Check for a "[" as the next pattern character. It is followed + * by a list of characters that are acceptable, or by a range + * (two characters separated by "-"). + */ + + if (*pattern == '[') { + pattern += 1; + while (1) { + if ((*pattern == ']') || (*pattern == 0)) { + return 0; + } + if (*pattern == *string) { + break; + } + if (pattern[1] == '-') { + c2 = pattern[2]; + if (c2 == 0) { + return 0; + } + if ((*pattern <= *string) && (c2 >= *string)) { + break; + } + if ((*pattern >= *string) && (c2 <= *string)) { + break; + } + pattern += 2; + } + pattern += 1; + } + while ((*pattern != ']') && (*pattern != 0)) { + pattern += 1; + } + goto thisCharOK; + } + + /* If the next pattern character is '/', just strip off the '/' + * so we do exact matching on the character that follows. + */ + + if (*pattern == '\\') { + pattern += 1; + if (*pattern == 0) { + return 0; + } + } + + /* There's no special character. Just make sure that the next + * characters of each string match. + */ + + if (*pattern != *string) { + return 0; + } + + thisCharOK: pattern += 1; + string += 1; + } + } + + /* + *---------------------------------------------------------------------- + * + * Tcl_DWStringInit -- + * + * Initializes a dynamic string, discarding any previous contents + * of the string (Tcl_DWStringFree should have been called already + * if the dynamic string was previously in use). + * + * Results: + * None. + * + * Side effects: + * The dynamic string is initialized to be empty. + * + *---------------------------------------------------------------------- + */ + + void + Tcl_DWStringInit(dwsPtr) + register Tcl_DWString *dwsPtr; /* Pointer to structure for + * dynamic string. */ + { + dwsPtr->wstring = dwsPtr->staticSpace; + dwsPtr->length = 0; + dwsPtr->spaceAvl = TCL_DWSTRING_STATIC_SIZE; + dwsPtr->staticSpace[0] = 0; + } + + /* + *---------------------------------------------------------------------- + * + * Tcl_DWStringAppend -- + * + * Append more characters to the current value of a dynamic string. + * + * Results: + * The return value is a pointer to the dynamic string's new value. + * + * Side effects: + * Length bytes from string (or all of string if length is less + * than zero) are added to the current value of the string. Memory + * gets reallocated if needed to accomodate the string's new size. + * + *---------------------------------------------------------------------- + */ + + wchar * + Tcl_DWStringAppend(dwsPtr, wstring, length) + register Tcl_DWString *dwsPtr; /* Structure describing dynamic + * string. */ + wchar *wstring; /* String to append. If length is + * -1 then this must be + * null-terminated. */ + int length; /* Number of characters from string + * to append. If < 0, then append all + * of string, up to null at end. */ + { + int newSize; + wchar *newString, *dst, *end; + + if (length < 0) { + length = Tcl_WStrlen(wstring); + } + newSize = length + dwsPtr->length; + + /* + * Allocate a larger buffer for the string if the current one isn't + * large enough. Allocate extra space in the new buffer so that there + * will be room to grow before we have to allocate again. + */ + + if (newSize >= dwsPtr->spaceAvl) { + dwsPtr->spaceAvl = newSize*2; + newString = (wchar *) ckalloc((unsigned) (dwsPtr->spaceAvl * sizeof(wchar))); + memcpy((VOID *)newString, (VOID *) dwsPtr->wstring, + (size_t) (dwsPtr->length * sizeof(wchar))); + if (dwsPtr->wstring != dwsPtr->staticSpace) { + ckfree((char *) dwsPtr->wstring); + } + dwsPtr->wstring = newString; + } + + /* + * Copy the new string into the buffer at the end of the old + * one. + */ + + for (dst = dwsPtr->wstring + dwsPtr->length, end = wstring+length; + wstring < end; wstring++, dst++) { + *dst = *wstring; + } + *dst = 0; + dwsPtr->length += length; + return dwsPtr->wstring; + } + + /* + *---------------------------------------------------------------------- + * + * Tcl_DWStringSetLength -- + * + * Change the length of a dynamic string. This can cause the + * string to either grow or shrink, depending on the value of + * length. + * + * Results: + * None. + * + * Side effects: + * The length of dsPtr is changed to length and a null byte is + * stored at that position in the string. If length is larger + * than the space allocated for dsPtr, then a panic occurs. + * + *---------------------------------------------------------------------- + */ + + void + Tcl_DWStringSetLength(dwsPtr, length) + register Tcl_DWString *dwsPtr; /* Structure describing dynamic + * string. */ + int length; /* New length for dynamic string. */ + { + if (length < 0) { + length = 0; + } + if (length >= dwsPtr->spaceAvl) { + wchar *newString; + + dwsPtr->spaceAvl = length+1; + newString = (wchar *) ckalloc((unsigned) (dwsPtr->spaceAvl * sizeof(wchar))); + + /* + * SPECIAL NOTE: must use memcpy, not strcpy, to copy the string + * to a larger buffer, since there may be embedded NULLs in the + * string in some cases. + */ + + memcpy((VOID *) newString, (VOID *) dwsPtr->wstring, + (size_t) (dwsPtr->length * sizeof(wchar))); + if (dwsPtr->wstring != dwsPtr->staticSpace) { + ckfree((char *) dwsPtr->wstring); + } + dwsPtr->wstring = newString; + } + dwsPtr->length = length; + dwsPtr->wstring[length] = 0; + } + + /* + *---------------------------------------------------------------------- + * + * Tcl_DWStringFree -- + * + * Frees up any memory allocated for the dynamic string and + * reinitializes the string to an empty state. + * + * Results: + * None. + * + * Side effects: + * The previous contents of the dynamic string are lost, and + * the new value is an empty string. + * + *---------------------------------------------------------------------- + */ + + void + Tcl_DWStringFree(dwsPtr) + register Tcl_DWString *dwsPtr; /* Structure describing dynamic + * string. */ + { + if (dwsPtr->wstring != dwsPtr->staticSpace) { + ckfree((char *) dwsPtr->wstring); + } + dwsPtr->wstring = dwsPtr->staticSpace; + dwsPtr->length = 0; + dwsPtr->spaceAvl = TCL_DWSTRING_STATIC_SIZE; + dwsPtr->staticSpace[0] = 0; + } + + /* + *---------------------------------------------------------------------- + * + * Tcl_DWStringResult -- + * + * This procedure moves the value of a dynamic string into an + * interpreter as its result. The string itself is reinitialized + * to an empty string. + * + * Results: + * None. + * + * Side effects: + * The string is "moved" to interp's result, and any existing + * result for interp is freed up. DsPtr is reinitialized to + * an empty string. + * + *---------------------------------------------------------------------- + */ + + void + Tcl_DWStringResult(interp, dwsPtr) + Tcl_Interp *interp; /* Interpreter whose result is to be + * reset. */ + Tcl_DWString *dwsPtr; /* Dynamic string that is to become + * the result of interp. */ + { + int kanjiCode = ((Interp *) interp)->kanjiCode; + int length; + char* string; + + length = Tcl_KanjiDecode(kanjiCode, dwsPtr->wstring, NULL); + string = (char *) ckalloc((unsigned) (length + 1)); + (void) Tcl_KanjiDecode(kanjiCode, dwsPtr->wstring, string); + + Tcl_ResetResult(interp); + interp->result = string; + interp->freeProc = (Tcl_FreeProc *) free; + + Tcl_DWStringFree(dwsPtr); + } + + /* + *---------------------------------------------------------------------- + * + * Tcl_DWStringGetResult -- + * + * This procedure moves the result of an interpreter into a + * dynamic string. + * + * Results: + * None. + * + * Side effects: + * The interpreter's result is cleared, and the previous contents + * of dsPtr are freed. + * + *---------------------------------------------------------------------- + */ + + void + Tcl_DWStringGetResult(interp, dwsPtr) + Tcl_Interp *interp; /* Interpreter whose result is to be + * reset. */ + Tcl_DWString *dwsPtr; /* Dynamic string that is to become + * the result of interp. */ + { + Interp *iPtr = (Interp *) interp; + int kanjiCode = iPtr->kanjiCode; + int length; + wchar *wstring; + + length = Tcl_KanjiEncode(kanjiCode, iPtr->result, NULL); + wstring = (wchar *) ckalloc((unsigned) (length * sizeof(wchar))); + (void) Tcl_KanjiEncode(kanjiCode, iPtr->result, wstring); + + if (iPtr->freeProc != NULL) { + (*iPtr->freeProc)(iPtr->result); + iPtr->freeProc = NULL; + } + iPtr->result = iPtr->resultSpace; + iPtr->resultSpace[0] = 0; + + if (dwsPtr->wstring != dwsPtr->staticSpace) { + ckfree((char *) dwsPtr->wstring); + } + dwsPtr->length = Tcl_WStrlen(wstring); + if (dwsPtr->length < TCL_DWSTRING_STATIC_SIZE) { + dwsPtr->wstring = dwsPtr->staticSpace; + dwsPtr->spaceAvl = TCL_DWSTRING_STATIC_SIZE; + Tcl_WStrcpy(dwsPtr->wstring, wstring); + ckfree((char *) wstring); + } else { + dwsPtr->wstring = wstring; + dwsPtr->spaceAvl = dwsPtr->length + 1; + } + } + #endif /* KANJI */ diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tcl7.6/generic/tclParse.c ./generic/tclParse.c *** ../tcl7.6/generic/tclParse.c Sat Sep 7 01:47:30 1996 --- ./generic/tclParse.c Fri Oct 18 13:14:10 1996 *************** *** 307,312 **** --- 307,315 ---- * fully-substituted result of parse. */ { register char *src, *dst, c; + #ifdef KANJI + int kanjiCode = TCL_ANY; + #endif /* KANJI */ src = string; dst = pvPtr->next; *************** *** 324,329 **** --- 327,340 ---- c = *src; src++; + #ifdef KANJI + if( Tcl_KanjiStart(src-1, &kanjiCode) ) { + pvPtr->next = dst; + (void )TclParseKanji(interp, src-1, kanjiCode, termPtr, pvPtr); + src = *termPtr; + dst = pvPtr->next; + } else + #endif /* KANJI */ if (c == termChar) { *dst = '\0'; pvPtr->next = dst; *************** *** 491,496 **** --- 502,510 ---- int level; register char *src, *dst, *end; register char c; + #ifdef KANJI + int kanjiCode = TCL_ANY; + #endif /* KANJI */ src = string; dst = pvPtr->next; *************** *** 503,508 **** --- 517,531 ---- */ while (1) { + #ifdef KANJI + if( Tcl_KanjiStart(src, &kanjiCode) ) { + pvPtr->next = dst; + (void )TclParseKanji(interp, src, kanjiCode, termPtr, pvPtr); + src = *termPtr; + dst = pvPtr->next; + end = pvPtr->end; + } + #endif /* KANJI */ c = *src; src++; if (dst == end) { *************** *** 626,631 **** --- 649,657 ---- char *oldBuffer; /* Used to detect when pvPtr's buffer gets * reallocated, so we can adjust all of the * argv pointers. */ + #ifdef KANJI + int kanjiCode = TCL_ANY; + #endif /* KANJI */ src = string; oldBuffer = pvPtr->buffer; *************** *** 664,669 **** --- 690,703 ---- dst = pvPtr->next; } + #ifdef KANJI + if( Tcl_KanjiStart(src, &kanjiCode) ) { + pvPtr->next = dst; + (void )TclParseKanji(interp, src, kanjiCode, termPtr, pvPtr); + src = *termPtr; + dst = pvPtr->next; + } else + #endif /* KANJI */ if (type == TCL_NORMAL) { copy: *dst = c; *************** *** 933,938 **** --- 967,975 ---- { register char *p; int count; + #ifdef KANJI + int kanjiCode = TCL_ANY; + #endif /* KANJI */ if (semiPtr != NULL) { *semiPtr = 0; *************** *** 969,974 **** --- 1006,1032 ---- p++; } else if (*p == '{') { int braces = 1; + #ifdef KANJI + p++; + while (braces != 0) { + if (Tcl_KanjiStart(p, &kanjiCode)) { + p += Tcl_KanjiLength(p, kanjiCode); + continue; + } else if (*p == '\\') { + (void) Tcl_Backslash(p, &count); + p += count; + continue; + } + if (*p == '}') { + braces--; + } else if (*p == '{') { + braces++; + } else if (*p == 0) { + return p; + } + p++; + } + #else while (braces != 0) { p++; while (*p == '\\') { *************** *** 984,989 **** --- 1042,1048 ---- } } p++; + #endif /* KANJI */ } /* *************** *** 995,1000 **** --- 1054,1064 ---- */ while (1) { + #ifdef KANJI + if (Tcl_KanjiStart(p, &kanjiCode)) { + p += Tcl_KanjiLength(p, kanjiCode); + } else + #endif /* KANJI */ if (*p == '[') { p = ScriptEnd(p+1, 1); if (*p == 0) { *************** *** 1079,1086 **** --- 1143,1158 ---- { register char *p = string; int count; + #ifdef KANJI + int kanjiCode = TCL_ANY; + #endif /* KANJI */ while (*p != term) { + #ifdef KANJI + if (Tcl_KanjiStart(p, &kanjiCode)) { + p += Tcl_KanjiLength(p, kanjiCode); + } else + #endif /* KANJI */ if (*p == '\\') { (void) Tcl_Backslash(p, &count); p += count; *************** *** 1132,1142 **** --- 1204,1228 ---- char *string; /* Pointer to dollar-sign character. */ { register char *p = string+1; + #ifdef KANJI + int kanjiCode = TCL_ANY; + #endif /* KANJI */ if (*p == '{') { + #ifdef KANJI + for (p++; *p != 0; ) { + if (Tcl_KanjiStart(p, &kanjiCode)) { + p += Tcl_KanjiLength(p, kanjiCode); + continue; + } + if (*p == '}') break; + p++; + } + #else for (p++; (*p != '}') && (*p != 0); p++) { /* Empty loop body. */ } + #endif /* KANJI */ return p; } while (isalnum(UCHAR(*p)) || (*p == '_')) { *************** *** 1260,1265 **** --- 1346,1354 ---- #define NUM_CHARS 200 char copyStorage[NUM_CHARS]; ParseValue pv; + #ifdef KANJI + int kanjiCode = TCL_ANY; + #endif /* KANJI */ /* * There are three cases: *************** *** 1282,1287 **** --- 1371,1394 ---- if (*string == '{') { string++; name1 = string; + #ifdef KANJI + for ( ; *string != 0; ) { + if (Tcl_KanjiStart(string, &kanjiCode)) { + string += Tcl_KanjiLength(string, kanjiCode); + continue; + } + if (*string == '}') break; + string++; + } + if (*string == 0) { + Tcl_SetResult(interp, "missing close-brace for variable name", + TCL_STATIC); + if (termPtr != 0) { + *termPtr = string; + } + return NULL; + } + #else while (*string != '}') { if (*string == 0) { Tcl_SetResult(interp, "missing close-brace for variable name", *************** *** 1293,1305 **** --- 1400,1424 ---- } string++; } + #endif /* KANJI */ name1End = string; string++; } else { name1 = string; + #ifdef KANJI + for ( ; *string != 0; ) { + if (Tcl_KanjiStart(string, &kanjiCode)) { + string += Tcl_KanjiLength(string, kanjiCode); + continue; + } + if (!isalnum(UCHAR(*string)) && (*string != '_')) break; + string++; + } + #else while (isalnum(UCHAR(*string)) || (*string == '_')) { string++; } + #endif /* KANJI */ if (string == name1) { if (termPtr != 0) { *termPtr = string; *************** *** 1361,1366 **** --- 1480,1563 ---- } return result; } + + #ifdef KANJI + /* + *---------------------------------------------------------------------- + * + * TclParseKanji -- + * + * This procedure parses a kanji string which code is either + * JIS, SJIS,or EUC, and convert its code if necessary. + * + * Results: + * The return value is (currently) always TCL_OK. If termPtr + * isn't NULL, *termPtr gets filled in with the address of the + * character just after the last one in the variable specifier. + * character just after the matching close-quote. The fully- + * substituted contents of the kanji string are stored in + * standard fashion in *pvPtr, null-terminated with pvPtr->next + * pointing to the terminating null character. + * + * Side effects: + * The buffer space in pvPtr may be enlarged by calling its + * expandProc. + * + *---------------------------------------------------------------------- + */ + + int + TclParseKanji(interp, string, kanjiCode, termPtr, pvPtr) + Tcl_Interp *interp; + char *string; + int kanjiCode; + char **termPtr; + ParseValue *pvPtr; + { + Interp *iPtr = (Interp *)interp; + int length; + + length = Tcl_KanjiLength(string, kanjiCode); + + if( iPtr->kanjiCode == TCL_ANY || iPtr->kanjiCode == kanjiCode ) { + + if( (pvPtr->end - pvPtr->next) <= length ) { + (*pvPtr->expandProc)(pvPtr, length); + } + + strncpy(pvPtr->next, string, length); + + *termPtr = string + length; + pvPtr->next += length; + + } else { + char c; + int n; + wchar *ws; + + c = string[length]; + string[length] = '\0'; + + n = Tcl_KanjiEncode(kanjiCode, string, NULL); + ws = (wchar *)ckalloc((n + 1) * 2); + (void) Tcl_KanjiEncode(kanjiCode, string, ws); + + n = Tcl_KanjiDecode(iPtr->kanjiCode, ws, NULL); + if( (pvPtr->end - pvPtr->next) <= (n+1) ) { + (*pvPtr->expandProc)(pvPtr, (n+1)); + } + (void) Tcl_KanjiDecode(iPtr->kanjiCode, ws, pvPtr->next); + + ckfree((char *) ws); + string[length] = c; + + *termPtr = string + length; + pvPtr->next += n; + } + + return TCL_OK; + } + #endif /* KANJI */ /* *---------------------------------------------------------------------- diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tcl7.6/generic/tclTest.c ./generic/tclTest.c *** ../tcl7.6/generic/tclTest.c Sat Oct 5 02:59:05 1996 --- ./generic/tclTest.c Fri Oct 18 13:14:10 1996 *************** *** 160,165 **** --- 160,169 ---- Tcl_Interp *interp, int argc, char **argv)); static int TestwordendCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int argc, char **argv)); + #ifdef KANJI + static int KanjitestCmd _ANSI_ARGS_((ClientData dummy, + Tcl_Interp *interp, int argc, char **argv)); + #endif /* KANJI */ /* * External (platform specific) initialization routine: *************** *** 259,264 **** --- 263,272 ---- (ClientData) 123); Tcl_CreateMathFunc(interp, "T2", 0, (Tcl_ValueType *) NULL, TestMathFunc, (ClientData) 345); + #ifdef KANJI + Tcl_CreateCommand(interp, "kanjitest", KanjitestCmd, (ClientData) 0, + (Tcl_CmdDeleteProc *) NULL); + #endif /* KANJI */ /* * And finally add any platform specific test commands. *************** *** 874,879 **** --- 882,980 ---- { ckfree(blockPtr - 4); } + #ifdef KANJI + + /* + *---------------------------------------------------------------------- + * + * KanjitestCmd -- + * + * This procedure implements the "kanjitest" command. It is used + * to test kanji extensions of Tcl. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * Creates, deletes, and ivokes handlers. + * + *---------------------------------------------------------------------- + */ + + /* ARGSUSED */ + static int + KanjitestCmd(dummy, interp, argc, argv) + ClientData dummy; /* Not used. */ + Tcl_Interp *interp; /* Current interpreter. */ + int argc; /* Number of arguments. */ + char **argv; /* Argument strings. */ + { + if (argc < 2) { + Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], + " option arg ?arg ...?\"", (char *) NULL); + return TCL_ERROR; + } + if (strcmp(argv[1], "end") == 0) { + int kanjiCode = TCL_ANY; + if (argc < 2) { + Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], + " end stringValue ?kanjiCode?\"", (char *) NULL); + return TCL_ERROR; + } + if (argc == 4) { + if (Tcl_GetKanjiCode(interp, argv[3], &kanjiCode) != TCL_OK) { + return TCL_ERROR; + } + } + if (Tcl_KanjiEnd(argv[2], &kanjiCode)) { + interp->result = "1"; + } else { + interp->result = "0"; + } + } else if (strcmp(argv[1], "start") == 0) { + int kanjiCode = TCL_ANY; + if (argc < 2) { + Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], + " start stringValue ?kanjiCode?\"", (char *) NULL); + return TCL_ERROR; + } + if (argc == 4) { + if (Tcl_GetKanjiCode(interp, argv[3], &kanjiCode) != TCL_OK) { + return TCL_ERROR; + } + } + if (Tcl_KanjiStart(argv[2], &kanjiCode)) { + interp->result = "1"; + } else { + interp->result = "0"; + } + } else if (strcmp(argv[1], "write") == 0) { + Tcl_Channel out; + int length; + + if (argc != 3 && argc != 4) { + Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], + " write string ?length?\"", (char *) NULL); + return TCL_ERROR; + } + out = Tcl_GetStdChannel(TCL_STDOUT); + if (out == (Tcl_Channel) NULL) { + return TCL_ERROR; + } + if (argc == 4) { + if (Tcl_GetInt(interp, argv[3], &length) != TCL_OK) { + return TCL_ERROR; + } + } + sprintf(interp->result, "%d", Tcl_Write(out, argv[2], length)); + } else { + Tcl_AppendResult(interp, "bad option \"", argv[1], + "\": must be start, end, or write", (char *) NULL); + return TCL_ERROR; + } + return TCL_OK; + } + #endif /* KANJI */ /* *---------------------------------------------------------------------- diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tcl7.6/generic/tclUtil.c ./generic/tclUtil.c *** ../tcl7.6/generic/tclUtil.c Thu Aug 22 05:33:26 1996 --- ./generic/tclUtil.c Fri Oct 18 13:14:11 1996 *************** *** 101,106 **** --- 101,109 ---- int openBraces = 0; int inQuotes = 0; int size; + #ifdef KANJI + int kanjiCode = TCL_ANY; + #endif /* KANJI */ /* * Skim off leading white space and check for an opening brace or *************** *** 131,136 **** --- 134,144 ---- */ while (1) { + #ifdef KANJI + if (Tcl_KanjiStart(p, &kanjiCode)) { + p += Tcl_KanjiLength(p, kanjiCode); + } + #endif /* KANJI */ switch (*p) { /* *************** *** 297,304 **** --- 305,324 ---- { register char c; int numRead; + #ifdef KANJI + int kanjiCode = TCL_ANY; + #endif /* KANJI */ for (c = *src; count > 0; src++, c = *src, count--) { + #ifdef KANJI + if (Tcl_KanjiStart(src, &kanjiCode)) { + numRead = Tcl_KanjiLength(src, kanjiCode); + strncpy(dst, src, numRead); + dst += numRead; + src += numRead-1; + count -= numRead-1; + } else + #endif /* KANJI */ if (c == '\\') { *dst = Tcl_Backslash(src, &numRead); dst++; *************** *** 439,444 **** --- 459,467 ---- { int flags, nestingLevel; register char *p; + #ifdef KANJI + int kanjiCode = TCL_ANY; + #endif /* KANJI */ /* * This procedure and Tcl_ConvertElement together do two things: *************** *** 484,489 **** --- 507,518 ---- flags |= USE_BRACES; } for ( ; *p != 0; p++) { + #ifdef KANJI + if (Tcl_KanjiStart(p, &kanjiCode)) { + p += (Tcl_KanjiLength(p, kanjiCode) - 1); + continue; + } + #endif /* KANJI */ switch (*p) { case '{': nestingLevel++; *************** *** 560,565 **** --- 589,597 ---- int flags; /* Flags produced by Tcl_ScanElement. */ { register char *p = dst; + #ifdef KANJI + int kanjiCode = TCL_ANY, length; + #endif /* KANJI */ /* * See the comment block at the beginning of the Tcl_ScanElement *************** *** 596,601 **** --- 628,642 ---- flags |= BRACES_UNMATCHED; } for (; *src != 0 ; src++) { + #ifdef KANJI + if (Tcl_KanjiStart(src, &kanjiCode)) { + length = Tcl_KanjiLength(src, kanjiCode); + strncpy(p, src, length); + src += (length - 1); + p += length; + continue; + } + #endif /* KANJI */ switch (*src) { case ']': case '[': *************** *** 1111,1116 **** --- 1152,1160 ---- register Interp *iPtr = (Interp *) interp; int size, flags; char *dst; + #ifdef KANJI + int kanjiCode = TCL_ANY; + #endif /* KANJI */ /* * See how much space is needed, and grow the append buffer if *************** *** 2112,2118 **** --- 2156,2168 ---- } end--; if (*end != '{') { + #ifdef KANJI + int kanjiCode = TCL_ANY; + if (isspace(UCHAR(*end)) && ((end == start) || (end[-1] != '\\')) + && !Tcl_KanjiEnd(start, &kanjiCode)) { + #else if (isspace(UCHAR(*end)) && ((end == start) || (end[-1] != '\\'))) { + #endif /* KANJI */ return 0; } return 1; diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tcl7.6/mac/tclMacAppInit.c ./mac/tclMacAppInit.c *** ../tcl7.6/mac/tclMacAppInit.c Tue Sep 10 01:28:29 1996 --- ./mac/tclMacAppInit.c Fri Oct 18 13:14:11 1996 *************** *** 22,27 **** --- 22,30 ---- #elif defined(__MWERKS__) # include short InstallConsole _ANSI_ARGS_((short fd)); + #ifdef KANJI + # include + #endif /* KANJI */ #endif #ifdef TCL_TEST *************** *** 170,175 **** --- 173,182 ---- SIOUXSettings.autocloseonquit = true; SIOUXSettings.showstatusline = true; SIOUXSettings.asktosaveonclose = false; + #ifdef KANJI + GetFNum("\pOsaka\201\174\223\231\225\235", &SIOUXSettings.fontid); + SIOUXSettings.fontsize = 12; + #endif /* KANJI */ InstallConsole(0); SIOUXSetTitle("\pTcl Interpreter"); diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tcl7.6/tests/cmdAH.test ./tests/cmdAH.test *** ../tcl7.6/tests/cmdAH.test Fri Oct 11 05:59:06 1996 --- ./tests/cmdAH.test Fri Oct 18 13:28:58 1996 *************** *** 1114,1138 **** test cmdah-23.1 {error conditions} { list [catch {file gorp x} msg] $msg ! } {1 {bad option "gorp": should be atime, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, owned, pathtype, readable, readlink, rename, root, size, split, stat, tail, type, or writable}} test cmdah-23.2 {error conditions} { list [catch {file ex x} msg] $msg ! } {1 {bad option "ex": should be atime, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, owned, pathtype, readable, readlink, rename, root, size, split, stat, tail, type, or writable}} test cmdah-23.3 {error conditions} { list [catch {file is x} msg] $msg ! } {1 {bad option "is": should be atime, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, owned, pathtype, readable, readlink, rename, root, size, split, stat, tail, type, or writable}} test cmdah-23.4 {error conditions} { list [catch {file n x} msg] $msg ! } {1 {bad option "n": should be atime, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, owned, pathtype, readable, readlink, rename, root, size, split, stat, tail, type, or writable}} test cmdah-23.5 {error conditions} { list [catch {file read x} msg] $msg ! } {1 {bad option "read": should be atime, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, owned, pathtype, readable, readlink, rename, root, size, split, stat, tail, type, or writable}} test cmdah-23.6 {error conditions} { list [catch {file s x} msg] $msg ! } {1 {bad option "s": should be atime, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, owned, pathtype, readable, readlink, rename, root, size, split, stat, tail, type, or writable}} test cmdah-23.7 {error conditions} { list [catch {file t x} msg] $msg ! } {1 {bad option "t": should be atime, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, owned, pathtype, readable, readlink, rename, root, size, split, stat, tail, type, or writable}} test cmdah-23.8 {error conditions} { list [catch {file dirname ~woohgy} msg] $msg } {1 {user "woohgy" doesn't exist}} --- 1114,1152 ---- test cmdah-23.1 {error conditions} { list [catch {file gorp x} msg] $msg ! } [jp&orig \ ! {1 {bad option "gorp": should be atime, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, kanjiCode, lstat, mtime, mkdir, owned, pathtype, readable, readlink, rename, root, size, split, stat, tail, type, or writable}} \ ! {1 {bad option "gorp": should be atime, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, owned, pathtype, readable, readlink, rename, root, size, split, stat, tail, type, or writable}}] test cmdah-23.2 {error conditions} { list [catch {file ex x} msg] $msg ! } [jp&orig \ ! {1 {bad option "ex": should be atime, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, kanjiCode, lstat, mtime, mkdir, owned, pathtype, readable, readlink, rename, root, size, split, stat, tail, type, or writable}} \ ! {1 {bad option "ex": should be atime, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, owned, pathtype, readable, readlink, rename, root, size, split, stat, tail, type, or writable}}] test cmdah-23.3 {error conditions} { list [catch {file is x} msg] $msg ! } [jp&orig \ ! {1 {bad option "is": should be atime, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, kanjiCode, lstat, mtime, mkdir, owned, pathtype, readable, readlink, rename, root, size, split, stat, tail, type, or writable}} \ ! {1 {bad option "is": should be atime, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, owned, pathtype, readable, readlink, rename, root, size, split, stat, tail, type, or writable}}] test cmdah-23.4 {error conditions} { list [catch {file n x} msg] $msg ! } [jp&orig \ ! {1 {bad option "n": should be atime, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, kanjiCode, lstat, mtime, mkdir, owned, pathtype, readable, readlink, rename, root, size, split, stat, tail, type, or writable}} \ ! {1 {bad option "n": should be atime, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, owned, pathtype, readable, readlink, rename, root, size, split, stat, tail, type, or writable}}] test cmdah-23.5 {error conditions} { list [catch {file read x} msg] $msg ! } [jp&orig \ ! {1 {bad option "read": should be atime, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, kanjiCode, lstat, mtime, mkdir, owned, pathtype, readable, readlink, rename, root, size, split, stat, tail, type, or writable}} \ ! {1 {bad option "read": should be atime, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, owned, pathtype, readable, readlink, rename, root, size, split, stat, tail, type, or writable}}] test cmdah-23.6 {error conditions} { list [catch {file s x} msg] $msg ! } [jp&orig \ ! {1 {bad option "s": should be atime, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, kanjiCode, lstat, mtime, mkdir, owned, pathtype, readable, readlink, rename, root, size, split, stat, tail, type, or writable}} \ ! {1 {bad option "s": should be atime, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, owned, pathtype, readable, readlink, rename, root, size, split, stat, tail, type, or writable}}] test cmdah-23.7 {error conditions} { list [catch {file t x} msg] $msg ! } [jp&orig \ ! {1 {bad option "t": should be atime, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, kanjiCode, lstat, mtime, mkdir, owned, pathtype, readable, readlink, rename, root, size, split, stat, tail, type, or writable}} \ ! {1 {bad option "t": should be atime, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, owned, pathtype, readable, readlink, rename, root, size, split, stat, tail, type, or writable}}] test cmdah-23.8 {error conditions} { list [catch {file dirname ~woohgy} msg] $msg } {1 {user "woohgy" doesn't exist}} diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tcl7.6/tests/defs ./tests/defs *** ../tcl7.6/tests/defs Fri Oct 11 05:58:53 1996 --- ./tests/defs Fri Oct 18 13:14:12 1996 *************** *** 341,343 **** --- 341,353 ---- } + # Japanized version of Tcl might cause some errors. + # Followings are to avoid such kind of non-essential errors. + + proc jp&orig {jp orig} { + if {[info commands kanji] != "kanji"} { + return $orig + } else { + return $jp + } + } diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tcl7.6/tests/ioCmd.test ./tests/ioCmd.test *** ../tcl7.6/tests/ioCmd.test Thu Aug 22 05:34:45 1996 --- ./tests/ioCmd.test Fri Oct 18 13:14:13 1996 *************** *** 184,190 **** set x [list [catch {fconfigure $f1 froboz} msg] $msg] close $f1 set x ! } {1 {bad option "froboz": must be -blocking, -buffering, -buffersize, -eofchar, -translation, or a channel type specific option}} test iocmd-9.4 {fconfigure command} { list [catch {fconfigure stdin -buffering froboz} msg] $msg } {1 {bad value for -buffering: must be one of full, line, or none}} --- 184,192 ---- set x [list [catch {fconfigure $f1 froboz} msg] $msg] close $f1 set x ! } [jp&orig \ ! {1 {bad option "froboz": must be -blocking, -buffering, -buffersize, -eofchar, -inputCode, -outputCode, -translation, or a channel type specific option}} \ ! {1 {bad option "froboz": must be -blocking, -buffering, -buffersize, -eofchar, -translation, or a channel type specific option}}] test iocmd-9.4 {fconfigure command} { list [catch {fconfigure stdin -buffering froboz} msg] $msg } {1 {bad value for -buffering: must be one of full, line, or none}} *************** *** 198,204 **** set x [fconfigure $f1] close $f1 set x ! } {-blocking 1 -buffering full -buffersize 4096 -eofchar {} -translation lf} test iocmd-9.6 {fconfigure command} { removeFile test1 set f1 [open test1 w] --- 200,208 ---- set x [fconfigure $f1] close $f1 set x ! } [jp&orig \ ! {-blocking 1 -buffering full -buffersize 4096 -eofchar {} -inputCode ANY -outputCode ANY -translation lf} \ ! {-blocking 1 -buffering full -buffersize 4096 -eofchar {} -translation lf}] test iocmd-9.6 {fconfigure command} { removeFile test1 set f1 [open test1 w] *************** *** 209,215 **** lappend x [fconfigure $f1] close $f1 set x ! } {line {-blocking 1 -buffering line -buffersize 3030 -eofchar {} -translation lf}} test iocmd-9.7 {fconfigure command} { removeFile test1 set f1 [open test1 w] --- 213,221 ---- lappend x [fconfigure $f1] close $f1 set x ! } [jp&orig \ ! {line {-blocking 1 -buffering line -buffersize 3030 -eofchar {} -inputCode ANY -outputCode ANY -translation lf}} \ ! {line {-blocking 1 -buffering line -buffersize 3030 -eofchar {} -translation lf}}] test iocmd-9.7 {fconfigure command} { removeFile test1 set f1 [open test1 w] *************** *** 218,236 **** set x [fconfigure $f1] close $f1 set x ! } {-blocking 1 -buffering none -buffersize 4040 -eofchar {} -translation lf} test iocmd-9.8 {fconfigure command} { list [catch {fconfigure a b} msg] $msg } {1 {can not find channel named "a"}} test iocmd-9.9 {fconfigure command} { list [catch {fconfigure stdout -froboz blarfo} msg] $msg ! } {1 {bad option "-froboz": should be -blocking, -buffering, -buffersize, -eofchar, -translation, or channel type specific option}} test iocmd-9.10 {fconfigure command} { list [catch {fconfigure stdout -b blarfo} msg] $msg ! } {1 {bad option "-b": should be -blocking, -buffering, -buffersize, -eofchar, -translation, or channel type specific option}} test iocmd-9.11 {fconfigure command} { list [catch {fconfigure stdout -buffer blarfo} msg] $msg ! } {1 {bad option "-buffer": should be -blocking, -buffering, -buffersize, -eofchar, -translation, or channel type specific option}} test iocmd-9.12 {fconfigure command} { fconfigure stdin -buffers } 4096 --- 224,250 ---- set x [fconfigure $f1] close $f1 set x ! } [jp&orig \ ! {-blocking 1 -buffering none -buffersize 4040 -eofchar {} -inputCode ANY -outputCode ANY -translation lf} \ ! {-blocking 1 -buffering none -buffersize 4040 -eofchar {} -translation lf}] test iocmd-9.8 {fconfigure command} { list [catch {fconfigure a b} msg] $msg } {1 {can not find channel named "a"}} test iocmd-9.9 {fconfigure command} { list [catch {fconfigure stdout -froboz blarfo} msg] $msg ! } [jp&orig \ ! {1 {bad option "-froboz": should be -blocking, -buffering, -buffersize, -eofchar, -inputCode, -outputCode, -translation, or channel type specific option}} \ ! {1 {bad option "-froboz": should be -blocking, -buffering, -buffersize, -eofchar, -translation, or channel type specific option}}] test iocmd-9.10 {fconfigure command} { list [catch {fconfigure stdout -b blarfo} msg] $msg ! } [jp&orig \ ! {1 {bad option "-b": should be -blocking, -buffering, -buffersize, -eofchar, -inputCode, -outputCode, -translation, or channel type specific option}} \ ! {1 {bad option "-b": should be -blocking, -buffering, -buffersize, -eofchar, -translation, or channel type specific option}}] test iocmd-9.11 {fconfigure command} { list [catch {fconfigure stdout -buffer blarfo} msg] $msg ! } [jp&orig \ ! {1 {bad option "-buffer": should be -blocking, -buffering, -buffersize, -eofchar, -inputCode, -outputCode, -translation, or channel type specific option}} \ ! {1 {bad option "-buffer": should be -blocking, -buffering, -buffersize, -eofchar, -translation, or channel type specific option}}] test iocmd-9.12 {fconfigure command} { fconfigure stdin -buffers } 4096 diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tcl7.6/tests/kanji.euc ./tests/kanji.euc *** ../tcl7.6/tests/kanji.euc Thu Jan 1 09:00:00 1970 --- ./tests/kanji.euc Fri Oct 18 13:14:13 1996 *************** *** 0 **** --- 1 ---- + ¤¢¤¤¤¦¤¨¤ª diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tcl7.6/tests/kanji.jis ./tests/kanji.jis *** ../tcl7.6/tests/kanji.jis Thu Jan 1 09:00:00 1970 --- ./tests/kanji.jis Fri Oct 18 13:14:14 1996 *************** *** 0 **** --- 1 ---- + $@$"$$$&$($*(J diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tcl7.6/tests/kanji.sjis ./tests/kanji.sjis *** ../tcl7.6/tests/kanji.sjis Thu Jan 1 09:00:00 1970 --- ./tests/kanji.sjis Fri Oct 18 13:14:14 1996 *************** *** 0 **** --- 1 ---- + ‚ ‚¢‚¤‚¦‚¨ diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tcl7.6/tests/kanji.test ./tests/kanji.test *** ../tcl7.6/tests/kanji.test Thu Jan 1 09:00:00 1970 --- ./tests/kanji.test Fri Oct 18 13:14:14 1996 *************** *** 0 **** --- 1,871 ---- + # Commands covered: kanji + # + # This file contains a collection of tests for one or more of the Tcl + # built-in commands. Sourcing this file into Tcl runs the tests and + # generates output for errors. No output means no errors were found. + # + # Copyright (c) 1993 Software Research Associates, Inc. + # Permission to use, copy, modify, and distribute this software and its + # documentation for any purpose and without fee is hereby granted, provided + # that the above copyright notice appear in all copies and that both that + # copyright notice and this permission notice appear in supporting + # documentation, and that the name of Software Research Associates not be + # used in advertising or publicity pertaining to distribution of the + # software without specific, written prior permission. Software Research + # Associates makes no representations about the suitability of this software + # for any purpose. It is provided "as is" without express or implied + # warranty. + # + # $Header: /ext/cvsroot/tcl/tests/kanji.test,v 1.3 1996/02/19 07:29:06 nisinaka Exp $ + + if {[string compare test [info procs test]] == 1} then {source defs} + + if [catch {set env(LANG)} lang] then { + set lang "" + } else { + unset env(LANG) + } + + catch {exec rm -f kanji.any} + exec cat > kanji.any << aiueo + set kanji(JIS) [exec cat kanji.jis] + set kanji(SJIS) [exec cat kanji.sjis] + set kanji(EUC) [exec cat kanji.euc] + set kanji(ANY) [exec cat kanji.any] + + + # file kanjiCode + + test kanji1.1 {file kanjiCode} {file kanjiCode kanji.jis} JIS + test kanji1.2 {file kanjiCode} {file kanjiCode kanji.sjis} SJIS + test kanji1.3 {file kanjiCode} {file kanjiCode kanji.euc} EUC + test kanji1.4 {file kanjiCode} {file kanjiCode kanji.any} ANY + + + # kanji code + + test kanji2.1 {kanji code: error message} { + list [catch {kanji code} msg] $msg + } {1 {wrong # args: should be "kanji code string"}} + test kanji2.2 {kanji code} {kanji code $kanji(JIS)} JIS + test kanji2.3 {kanji code} {kanji code $kanji(SJIS)} SJIS + test kanji2.4 {kanji code} {kanji code $kanji(EUC)} EUC + test kanji2.5 {kanji code} {kanji code $kanji(ANY)} ANY + + + # kanji internalCode + + test kanji3.1 {kanji internalCode: default value} { + catch {kanji internalCode} default + } 0 + test kanji3.2 {kanji internalCode: set internalCode to JIS} { + list [catch {kanji internalCode JIS} msg] $msg [kanji internalCode] + } {0 JIS JIS} + test kanji3.3 {kanji internalCode: set internalCode to SJIS} { + list [catch {kanji internalCode SJIS} msg] $msg [kanji internalCode] + } {0 SJIS SJIS} + test kanji3.4 {kanji internalCode: set internalCode to EUC} { + list [catch {kanji internalCode EUC} msg] $msg [kanji internalCode] + } {0 EUC EUC} + test kanji3.5 {kanji internalCode: set internalCode to ANY} { + list [catch {kanji internalCode ANY} msg] $msg [kanji internalCode] + } {0 ANY ANY} + test kanji3.6 {kanji internalCode: set internalCode to KANJI, makes error} { + kanji internalCode ANY + list [catch {kanji internalCode KANJI} msg] $msg [kanji internalCode] + } {1 {bad kanjiCode "KANJI": should be JIS, SJIS, EUC, or ANY} ANY} + test kanji3.7 {kanji internalCode JIS} { + catch {unset str} + kanji internalCode JIS + eval "set str(JIS) $kanji(JIS)" + eval "set str(SJIS) $kanji(SJIS)" + eval "set str(EUC) $kanji(EUC)" + list [kanji code $str(JIS)] [kanji code $str(SJIS)] [kanji code $str(EUC)] + } {JIS JIS JIS} + test kanji3.8 {kanji internalCode SJIS} { + catch {unset str} + kanji internalCode SJIS + eval "set str(JIS) $kanji(JIS)" + eval "set str(SJIS) $kanji(SJIS)" + eval "set str(EUC) $kanji(EUC)" + list [kanji code $str(JIS)] [kanji code $str(SJIS)] [kanji code $str(EUC)] + } {SJIS SJIS SJIS} + test kanji3.9 {kanji internalCode EUC} { + catch {unset str} + kanji internalCode EUC + eval "set str(JIS) $kanji(JIS)" + eval "set str(SJIS) $kanji(SJIS)" + eval "set str(EUC) $kanji(EUC)" + list [kanji code $str(JIS)] [kanji code $str(SJIS)] [kanji code $str(EUC)] + } {EUC EUC EUC} + test kanji3.10 {kanji internalCode ANY} { + catch {unset str} + kanji internalCode ANY + eval "set str(JIS) $kanji(JIS)" + eval "set str(SJIS) $kanji(SJIS)" + eval "set str(EUC) $kanji(EUC)" + list [kanji code $str(JIS)] [kanji code $str(SJIS)] [kanji code $str(EUC)] + } {JIS SJIS EUC} + + kanji internalCode $default + + + # kanji inputCode + + test kanji4.1 {kanji inputCode: default value} { + catch {kanji inputCode stdin} default + } 0 + test kanji4.2 {kanji inputCode: error message} { + list [catch {kanji inputCode stdout} msg] $msg + } {1 {channel "stdout" wasn't opened for reading}} + test kanji4.3 {kanji inputCode: set inputCode to JIS} { + list [catch {kanji inputCode stdin JIS} msg] $msg [kanji inputCode stdin] + } {0 JIS JIS} + test kanji4.4 {kanji inputCode: set inputCode to SJIS} { + list [catch {kanji inputCode stdin SJIS} msg] $msg [kanji inputCode stdin] + } {0 SJIS SJIS} + test kanji4.5 {kanji inputCode: set inputCode to EUC} { + list [catch {kanji inputCode stdin EUC} msg] $msg [kanji inputCode stdin] + } {0 EUC EUC} + test kanji4.6 {kanji inputCode: set inputCode to ANY} { + list [catch {kanji inputCode stdin ANY} msg] $msg [kanji inputCode stdin] + } {0 ANY ANY} + test kanji4.7 {kanji inputCode: set inputCode to KANJI, makes error} { + kanji inputCode stdin ANY + list [catch {kanji inputCode stdin KANJI} msg] $msg [kanji inputCode stdin] + } {1 {bad kanjiCode "KANJI": should be JIS, SJIS, EUC, or ANY} ANY} + test kanji4.8 {kanji inputCode} { + catch {unset str} + set fd [open kanji.jis] + kanji inputCode $fd JIS + set str(JIS) [gets $fd] + close $fd + set fd [open kanji.sjis] + kanji inputCode $fd JIS + set str(SJIS) [gets $fd] + close $fd + set fd [open kanji.euc] + kanji inputCode $fd JIS + set str(EUC) [gets $fd] + close $fd + list [kanji code $str(JIS)] [kanji code $str(SJIS)] [kanji code $str(EUC)] + } {JIS JIS JIS} + test kanji4.9 {kanji inputCode} { + catch {unset str} + set fd [open kanji.jis] + kanji inputCode $fd SJIS + set str(JIS) [gets $fd] + close $fd + set fd [open kanji.sjis] + kanji inputCode $fd SJIS + set str(SJIS) [gets $fd] + close $fd + set fd [open kanji.euc] + kanji inputCode $fd SJIS + set str(EUC) [gets $fd] + close $fd + list [kanji code $str(JIS)] [kanji code $str(SJIS)] [kanji code $str(EUC)] + } {SJIS SJIS SJIS} + test kanji4.10 {kanji inputCode} { + catch {unset str} + set fd [open kanji.jis] + kanji inputCode $fd EUC + set str(JIS) [gets $fd] + close $fd + set fd [open kanji.sjis] + kanji inputCode $fd EUC + set str(SJIS) [gets $fd] + close $fd + set fd [open kanji.euc] + kanji inputCode $fd EUC + set str(EUC) [gets $fd] + close $fd + list [kanji code $str(JIS)] [kanji code $str(SJIS)] [kanji code $str(EUC)] + } {EUC EUC EUC} + test kanji4.11 {kanji inputCode} { + catch {unset str} + set fd [open kanji.jis] + kanji inputCode $fd ANY + set str(JIS) [gets $fd] + close $fd + set fd [open kanji.sjis] + kanji inputCode $fd ANY + set str(SJIS) [gets $fd] + close $fd + set fd [open kanji.euc] + kanji inputCode $fd ANY + set str(EUC) [gets $fd] + close $fd + list [kanji code $str(JIS)] [kanji code $str(SJIS)] [kanji code $str(EUC)] + } {JIS SJIS EUC} + + kanji inputCode stdin $default + + + # kanji outputCode + + test kanji5.1 {kanji outputCode: default value} { + catch {kanji outputCode stdout} default + } 0 + test kanji5.2 {kanji outputCode: error message} { + list [catch {kanji outputCode stdin} msg] $msg + } {1 {channel "stdin" wasn't opened for writing}} + test kanji5.3 {kanji outputCode: set outputCode to JIS} { + list [catch {kanji outputCode stdout JIS} msg] $msg [kanji outputCode stdout] + } {0 JIS JIS} + test kanji5.4 {kanji outputCode: set outputCode to SJIS} { + list [catch {kanji outputCode stdout SJIS} msg] $msg [kanji outputCode stdout] + } {0 SJIS SJIS} + test kanji5.5 {kanji outputCode: set outputCode to EUC} { + list [catch {kanji outputCode stdout EUC} msg] $msg [kanji outputCode stdout] + } {0 EUC EUC} + test kanji5.6 {kanji outputCode: set outputCode to ANY} { + list [catch {kanji outputCode stdout ANY} msg] $msg [kanji outputCode stdout] + } {0 ANY ANY} + test kanji5.7 {kanji outputCode: set outputCode to KANJI, makes error} { + kanji outputCode stdout ANY + list [catch {kanji outputCode stdout KANJI} msg] $msg [kanji outputCode stdout] + } {1 {bad kanjiCode "KANJI": should be JIS, SJIS, EUC, or ANY} ANY} + test kanji5.8 {kanji outputCode} { + catch {exec rm -f tmp.jis} + catch {exec rm -f tmp.sjis} + catch {exec rm -f tmp.euc} + set fd [open tmp.jis w] + kanji outputCode $fd JIS + puts $fd $kanji(JIS) + close $fd + set fd [open tmp.sjis w] + kanji outputCode $fd JIS + puts $fd $kanji(SJIS) + close $fd + set fd [open tmp.euc w] + kanji outputCode $fd JIS + puts $fd $kanji(EUC) + close $fd + list [file kanjiCode tmp.jis] [file kanjiCode tmp.sjis] [file kanjiCode tmp.euc] + } {JIS JIS JIS} + test kanji5.9 {kanji outputCode} { + catch {exec rm -f tmp.jis} + catch {exec rm -f tmp.sjis} + catch {exec rm -f tmp.euc} + set fd [open tmp.jis w] + kanji outputCode $fd SJIS + puts $fd $kanji(JIS) + close $fd + set fd [open tmp.sjis w] + kanji outputCode $fd SJIS + puts $fd $kanji(SJIS) + close $fd + set fd [open tmp.euc w] + kanji outputCode $fd SJIS + puts $fd $kanji(EUC) + close $fd + list [file kanjiCode tmp.jis] [file kanjiCode tmp.sjis] [file kanjiCode tmp.euc] + } {SJIS SJIS SJIS} + test kanji5.10 {kanji outputCode} { + catch {exec rm -f tmp.jis} + catch {exec rm -f tmp.sjis} + catch {exec rm -f tmp.euc} + set fd [open tmp.jis w] + kanji outputCode $fd EUC + puts $fd $kanji(JIS) + close $fd + set fd [open tmp.sjis w] + kanji outputCode $fd EUC + puts $fd $kanji(SJIS) + close $fd + set fd [open tmp.euc w] + kanji outputCode $fd EUC + puts $fd $kanji(EUC) + close $fd + list [file kanjiCode tmp.jis] [file kanjiCode tmp.sjis] [file kanjiCode tmp.euc] + } {EUC EUC EUC} + test kanji5.11 {kanji outputCode} { + catch {exec rm -f tmp.jis} + catch {exec rm -f tmp.sjis} + catch {exec rm -f tmp.euc} + set fd [open tmp.jis w] + kanji outputCode $fd ANY + puts $fd $kanji(JIS) + close $fd + set fd [open tmp.sjis w] + kanji outputCode $fd ANY + puts $fd $kanji(SJIS) + close $fd + set fd [open tmp.euc w] + kanji outputCode $fd ANY + puts $fd $kanji(EUC) + close $fd + list [file kanjiCode tmp.jis] [file kanjiCode tmp.sjis] [file kanjiCode tmp.euc] + } {JIS SJIS EUC} + + catch {exec rm -f tmp.jis} + catch {exec rm -f tmp.sjis} + catch {exec rm -f tmp.euc} + kanji outputCode stdout $default + + + # kanji defaultInputCode + + test kanji6.1 {kanji defaultInputCode: default value} { + catch {kanji defaultInputCode} default + } 0 + test kanji6.2 {kanji defaultInputCode: set defaultInputCode to JIS} { + list [catch {kanji defaultInputCode JIS} msg] $msg [kanji defaultInputCode] + } {0 JIS JIS} + test kanji6.3 {kanji defaultInputCode: set defaultInputCode to SJIS} { + list [catch {kanji defaultInputCode SJIS} msg] $msg [kanji defaultInputCode] + } {0 SJIS SJIS} + test kanji6.4 {kanji defaultInputCode: set defaultInputCode to EUC} { + list [catch {kanji defaultInputCode EUC} msg] $msg [kanji defaultInputCode] + } {0 EUC EUC} + test kanji6.5 {kanji defaultInputCode: set defaultInputCode to ANY} { + list [catch {kanji defaultInputCode ANY} msg] $msg [kanji defaultInputCode] + } {0 ANY ANY} + test kanji6.6 {kanji defaultInputCode: set defaultInputCode to KANJI, makes error} { + kanji defaultInputCode ANY + list [catch {kanji defaultInputCode KANJI} msg] $msg [kanji defaultInputCode] + } {1 {bad kanjiCode "KANJI": should be JIS, SJIS, EUC, or ANY} ANY} + test kanji6.7 {kanji defaultInputCode} { + catch {unset code} + kanji defaultInputCode JIS + set fd [open kanji.test] + set code(JIS) [kanji inputCode $fd] + close $fd + kanji defaultInputCode SJIS + set fd [open kanji.test] + set code(SJIS) [kanji inputCode $fd] + close $fd + kanji defaultInputCode EUC + set fd [open kanji.test] + set code(EUC) [kanji inputCode $fd] + close $fd + kanji defaultInputCode ANY + set fd [open kanji.test] + set code(ANY) [kanji inputCode $fd] + close $fd + list $code(JIS) $code(SJIS) $code(EUC) $code(ANY) + } {JIS SJIS EUC ANY} + + kanji defaultInputCode $default + + + # kanji defaultOutputCode + + test kanji7.1 {kanji defaultOutputCode: default value} { + catch {kanji defaultOutputCode} default + } 0 + test kanji7.2 {kanji defaultOutputCode: set defaultOutputCode to JIS} { + list [catch {kanji defaultOutputCode JIS} msg] $msg [kanji defaultOutputCode] + } {0 JIS JIS} + test kanji7.3 {kanji defaultOutputCode: set defaultOutputCode to SJIS} { + list [catch {kanji defaultOutputCode SJIS} msg] $msg [kanji defaultOutputCode] + } {0 SJIS SJIS} + test kanji7.4 {kanji defaultOutputCode: set defaultOutputCode to EUC} { + list [catch {kanji defaultOutputCode EUC} msg] $msg [kanji defaultOutputCode] + } {0 EUC EUC} + test kanji7.5 {kanji defaultOutputCode: set defaultOutputCode to ANY} { + list [catch {kanji defaultOutputCode ANY} msg] $msg [kanji defaultOutputCode] + } {0 ANY ANY} + test kanji7.6 {kanji defaultOutputCode: set defaultOutputCode to KANJI, makes error} { + kanji defaultOutputCode ANY + list [catch {kanji defaultOutputCode KANJI} msg] $msg [kanji defaultOutputCode] + } {1 {bad kanjiCode "KANJI": should be JIS, SJIS, EUC, or ANY} ANY} + test kanji7.7 {kanji defaultOutputCode} { + catch {unset code} + kanji defaultOutputCode JIS + set fd [open kanji.tmp w] + set code(JIS) [kanji outputCode $fd] + close $fd + kanji defaultOutputCode SJIS + set fd [open kanji.tmp w] + set code(SJIS) [kanji outputCode $fd] + close $fd + kanji defaultOutputCode EUC + set fd [open kanji.tmp w] + set code(EUC) [kanji outputCode $fd] + close $fd + kanji defaultOutputCode ANY + set fd [open kanji.tmp w] + set code(ANY) [kanji outputCode $fd] + close $fd + list $code(JIS) $code(SJIS) $code(EUC) $code(ANY) + } {JIS SJIS EUC ANY} + + catch {exec rm -f kanji.tmp} + kanji defaultOutputCode $default + + + # kanji lsearch + + set l [list $kanji(JIS) $kanji(SJIS) $kanji(EUC)] + set default [kanji internalCode] + + test kanji8.1.1 {kanji lsearch (or klsearch): error message} { + list [catch {kanji lsearch} msg] $msg + } {1 {wrong # args: should be "kanji lsearch list pattern"}} + test kanji8.1.2 {kanji lsearch (or klsearch): error message} { + list [catch {klsearch} msg] $msg + } {1 {wrong # args: should be "klsearch list pattern"}} + test kanji8.2.1 {kanji lsearch (or klsearch)} { + kanji lsearch $l $kanji(JIS) + } 0 + test kanji8.2.2 {kanji lsearch (or klsearch)} { + kanji lsearch $l $kanji(SJIS) + } 1 + test kanji8.2.3 {kanji lsearch (or klsearch)} { + kanji lsearch $l $kanji(EUC) + } 2 + test kanji8.3.1 {kanji lsearch (or klsearch)} { + kanji internalCode JIS + kanji lsearch $l ¤¢* + } 0 + test kanji8.3.2 {kanji lsearch (or klsearch)} { + kanji internalCode SJIS + kanji lsearch $l *¤ª + } 1 + test kanji8.3.3 {kanji lsearch (or klsearch)} { + kanji internalCode EUC + kanji lsearch $l *¤¦* + } 2 + + kanji internalCode $default + + + # kanji lsort + + set l [list $kanji(JIS) $kanji(SJIS) $kanji(EUC) $kanji(ANY)] + + test kanji9.1 {kanji lsort (or klsort): error message} { + list [catch {kanji lsort} msg] $msg + } {1 {wrong # args: should be "kanji lsort list"}} + test kanji9.2 {kanji lsort (or klsort): error message} { + list [catch {klsort} msg] $msg + } {1 {wrong # args: should be "klsort list"}} + test kanji9.3 {kanji lsort (or klsort)} { + kanji lsort {¤ó ¤¢¤¤ 1 ¤¢¤¢ a} + } {1 a ¤¢¤¢ ¤¢¤¤ ¤ó} + test kanji9.4 {kanji lsort (or klsort)} { + kanji lsort $l + } [list $kanji(JIS) $kanji(ANY) $kanji(SJIS) $kanji(EUC)] + + + # kanji split + + set default [kanji internalCode] + + test kanji10.1.1 {kanji split (or ksplit): error message} { + list [catch {kanji split} msg] $msg + } {1 {wrong # args: should be "kanji split string ?splitChars?"}} + test kanji10.1.2 {kanji split (or ksplit): error message} { + list [catch {ksplit} msg] $msg + } {1 {wrong # args: should be "ksplit string ?splitChars?"}} + kanji internalCode JIS + test kanji10.2.1 {kanji split (or ksplit)} { + kanji split "¤¢\n ¤¤\t\r ¤¦\n " + } "¤¢ {} ¤¤ {} {} ¤¦ {} {}" + kanji internalCode SJIS + test kanji10.2.2 {kanji split (or ksplit)} { + kanji split "¤¢\n ¤¤\t\r ¤¦\n " + } "¤¢ {} ¤¤ {} {} ¤¦ {} {}" + kanji internalCode EUC + test kanji10.2.3 {kanji split (or ksplit)} { + kanji split "¤¢\n ¤¤\t\r ¤¦\n " + } "¤¢ {} ¤¤ {} {} ¤¦ {} {}" + kanji internalCode JIS + test kanji10.3.1 {kanji split (or ksplit)} { + kanji split "¤¢xyz¤¤z¤¦" xyz + } "¤¢ {} {} ¤¤ ¤¦" + kanji internalCode SJIS + test kanji10.3.2 {kanji split (or ksplit)} { + kanji split "¤¢xyz¤¤z¤¦" xyz + } "¤¢ {} {} ¤¤ ¤¦" + kanji internalCode EUC + test kanji10.3.3 {kanji split (or ksplit)} { + kanji split "¤¢xyz¤¤z¤¦" xyz + } "¤¢ {} {} ¤¤ ¤¦" + test kanji10.4.1 {kanji split (or ksplit)} { + kanji split "a¤¢b¤¤c" a + } "{} ¤¢b¤¤c" + test kanji10.4.2 {kanji split (or ksplit)} { + kanji split "a¤¢b¤¤c" b + } "a¤¢ ¤¤c" + test kanji10.4.3 {kanji split (or ksplit)} { + kanji split "a¤¢b¤¤c" c + } "a¤¢b¤¤ {}" + test kanji10.4.4 {kanji split (or ksplit)} { + kanji split "a¤¢b¤¤c" c + } "a¤¢b¤¤ {}" + test kanji10.4.5 {kanji split (or ksplit)} { + kanji split "a¤¢b¤¤c" ¤¢ + } "a b¤¤c" + test kanji10.4.6 {kanji split (or ksplit)} { + kanji split "a¤¢b¤¤c" ¤¢¤¤ + } "a b c" + + kanji internalCode $default + + + # kanji string + + set default [kanji internalCode] + + test kanji11.1.1 {kanji string (or kstring): error message} { + list [catch {kanji string} msg] $msg + } {1 {wrong # args: should be "kanji string option arg ?arg ...?"}} + test kanji11.1.2 {kanji string (or kstring): error message} { + list [catch {kstring} msg] $msg + } {1 {wrong # args: should be "kstring option arg ?arg ...?"}} + test kanji11.1.3 {kanji string (or kstring): error message} { + list [catch {kanji string op} msg] $msg + } {1 {bad option "op": should be compare, first, index, last, length, match, range, tolower, toupper, trim, trimleft, or trimright}} + test kanji11.1.4 {kanji string (or kstring): error message} { + list [catch {kstring op} msg] $msg + } {1 {bad option "op": should be compare, first, index, last, length, match, range, tolower, toupper, trim, trimleft, or trimright}} + + test kanji11.2.1 {kanji string compare: error message} { + list [catch {kstring compare} msg] $msg + } {1 {wrong # args: should be "kstring compare string1 string2"}} + test kanji11.2.2 {kanji string compare} { + kstring compare ¤¢¤¤¤¦¤¨¤ª ¤¢¤¤¤¦¤¨¤ó + } -1 + test kanji11.2.3 {kanji string compare} { + kstring compare ¤¢¤¤¤¦¤¨¤ó ¤¢¤¤¤¦¤¨¤ª + } 1 + test kanji11.2.4 {kanji string compare} { + kstring compare ¤¢¤¤¤¦¤¨¤ª ¤¢¤¤¤¦¤¨¤ª + } 0 + + if {[kanji internalCode] != "ANY"} { + test kanji11.3.1 {kanji string first: error message} { + list [catch {kstring first} msg] $msg + } {1 {wrong # args: should be "kstring first string1 string2"}} + test kanji11.3.2 {kanji string first} { + kstring first ¤¦ a¤¢b¤¤c¤¦d¤¨e¤ªf + } 5 + test kanji11.3.3 {kanji string first} { + kstring first c a¤¢b¤¤c¤¦d¤¨e¤ªf + } 4 + test kanji11.3.4 {kanji string first} { + kstring first ¤¤c¤¦ a¤¢b¤¤c¤¦d¤¨e¤ªf + } 3 + } + + if {[kanji internalCode] != "ANY"} { + test kanji11.4.1 {kanji string index: error message} { + list [catch {kstring index} msg] $msg + } {1 {wrong # args: should be "kstring index string charIndex"}} + test kanji11.4.2 {kanji string index: error message} { + list [catch {kstring index abc XXX} msg] $msg + } {1 {expected integer but got "XXX"}} + test kanji11.4.3 {kanji string index} { + kstring index ¤¢¤¤¤¦¤¨¤ª 0 + } "¤¢" + test kanji11.4.4 {kanji string index} { + kstring index ¤¢¤¤¤¦¤¨¤ª 4 + } "¤ª" + test kanji11.4.5 {kanji string index} { + kstring index ¤¢¤¤¤¦¤¨¤ª 5 + } {} + test kanji11.4.6 {kanji string index} { + kstring index ¤¢¤¤¤¦¤¨¤ª -1 + } {} + } + + if {[kanji internalCode] != "ANY"} { + test kanji11.5.1 {kanji string last: error message} { + list [catch {kstring last} msg] $msg + } {1 {wrong # args: should be "kstring last string1 string2"}} + test kanji11.5.2 {kanji string last} { + kstring last ¤¢ ¤¢¤¢¤¢¤¢¤¢ + } 4 + test kanji11.5.3 {kanji string last} { + kstring last ¤¢¤¢ ¤¢¤¢¤¢¤¢¤¢ + } 3 + test kanji11.5.4 {kanji string last} { + kstring last ¤¢¤¢¤¢¤¢¤¢ ¤¢¤¢¤¢¤¢¤¢ + } 0 + test kanji11.5.5 {kanji string last} { + kstring last ¤¢¤¢¤¢¤¢¤¢¤¢ ¤¢¤¢¤¢¤¢¤¢ + } -1 + } + + if {[kanji internalCode] != "ANY"} { + test kanji11.6.1 {kanji string length: error message} { + list [catch {kstring length} msg] $msg + } {1 {wrong # args: should be "kstring length string"}} + test kanji11.6.2 {kanji string length} { + kstring length ¤¢¤¤¤¦¤¨¤ª + } 5 + test kanji11.6.3 {kanji string length} { + kstring length a¤¢b¤¤c¤¦d + } 7 + } + + if {[kanji internalCode] != "ANY"} { + test kanji11.7.1 {kanji string match: error message} { + list [catch {kstring match} msg] $msg + } {1 {wrong # args: should be "kstring match pattern string"}} + test kanji11.7.2 {kanji string match} { + kstring match ¤¢¤¤¤¦¤¨¤ª ¤¢¤¤¤¦¤¨¤ª + } 1 + test kanji11.7.3 {kanji string match} { + kstring match ¤¢¤¤¤¦¤¨¤ª ¤¢¤¤¤¦¤¨¤ó + } 0 + test kanji11.7.4 {kanji string match} { + kstring match ¤¢*¤ª ¤¢¤¤¤¦¤¨¤ª + } 1 + test kanji11.7.5 {kanji string match} { + kstring match ¤¢**¤ª ¤¢¤¤¤¦¤¨¤ª + } 1 + test kanji11.7.6 {kanji string match} { + kstring match ¤¢* ¤¢¤¤¤¦¤¨¤ª + } 1 + test kanji11.7.7 {kanji string match} { + kstring match *¤ª ¤¢¤¤¤¦¤¨¤ª + } 1 + test kanji11.7.8 {kanji string match} { + kstring match ¤¢???¤ª ¤¢¤¤¤¦¤¨¤ª + } 1 + test kanji11.7.9 {kanji string match} { + kstring match ¤¢??¤ª ¤¢¤¤¤¦¤¨¤ª + } 0 + test kanji11.7.10 {kanji string match} { + kstring match ¤¢????¤ª ¤¢¤¤¤¦¤¨¤ª + } 0 + test kanji11.7.11 {kanji string match} { + kstring match ¤¢????¤ª ¤¢¤¤¤¦¤¨¤ª + } 0 + test kanji11.7.12 {kanji string match} { + kstring match "\[¤¢¤¤¤¦\]\[¤¢¤¤¤¦\]\[¤¢¤¤¤¦\]¤¨¤ª" ¤¢¤¤¤¦¤¨¤ª + } 1 + test kanji11.7.13 {kanji string match} { + kstring match "\[¤¢-¤¦\]\[¤¢-¤¦\]\[¤¢-¤¦\]¤¨¤ª" ¤¢¤¤¤¦¤¨¤ª + } 1 + test kanji11.7.14 {kanji string match} { + kstring match "¤¢\[¤¤-¤¨\]*¤ª" ¤¢¤¤¤¦¤¨¤ª + } 1 + } + + if {[kanji internalCode] != "ANY"} { + test kanji11.8.1 {kanji string range: error message} { + list [catch {kstring range} msg] $msg + } {1 {wrong # args: should be "kstring range string first last"}} + test kanji11.8.2 {kanji string range: error message} { + list [catch {kstring range abc abc 1} msg] $msg + } {1 {expected integer but got "abc"}} + test kanji11.8.3 {kanji string range: error message} { + list [catch {kstring range abc 1 eof} msg] $msg + } {1 {expected integer or "end" but got "eof"}} + test kanji11.8.4 {kanji string range} { + kstring range ¤¢¤¤¤¦¤¨¤ª 1 3 + } "¤¤¤¦¤¨" + test kanji11.8.5 {kanji string range} { + kstring range ¤¢¤¤¤¦¤¨¤ª 2 1000 + } "¤¦¤¨¤ª" + test kanji11.8.6 {kanji string range} { + kstring range ¤¢¤¤¤¦¤¨¤ª 4 end + } "¤ª" + test kanji11.8.7 {kanji string range} { + kstring range ¤¢¤¤¤¦¤¨¤ª 4 3 + } {} + test kanji11.8.8 {kanji string range} { + kstring range ¤¢¤¤¤¦¤¨¤ª -1 2 + } "¤¢¤¤¤¦" + test kanji11.8.9 {kanji string range} { + kstring range ¤¢¤¤¤¦¤¨¤ª -3 -2 + } {} + test kanji11.8.10 {kanji string range} { + kstring range ¤¢¤¤¤¦¤¨¤ª 1000 1010 + } {} + test kanji11.8.11 {kanji string range} { + kstring range ¤¢¤¤¤¦¤¨¤ª -100 end + } "¤¢¤¤¤¦¤¨¤ª" + } + + test kanji11.9.1 {kanji string trim: error message} { + list [catch {kstring trim} msg] $msg + } {1 {wrong # args: should be "kstring trim string ?chars?"}} + test kanji11.9.2 {kanji string trim} { + kstring trim " £°£±£² " + } "£°£±£²" + test kanji11.9.3 {kanji string trim} { + kstring trim "\t\n£°£±£²\t\n\r\n" + } "£°£±£²" + test kanji11.9.4 {kanji string trim} { + kstring trim " £° £± £² " + } "£° £± £²" + test kanji11.9.5 {kanji string trim} { + kstring trim "XXYYZZ0£°£±£² ¤¢XXYYZZ" XYZ¤¢ + } "0£°£±£² " + + test kanji11.9.1 {kanji string trimleft: error message} { + list [catch {kstring trimleft} msg] $msg + } {1 {wrong # args: should be "kstring trimleft string ?chars?"}} + test kanji11.9.2 {kanji string trimleft} { + kstring trimleft " £°£±£² " + } "£°£±£² " + + test kanji11.10.1 {kanji string trimright: error message} { + list [catch {kstring trimright} msg] $msg + } {1 {wrong # args: should be "kstring trimright string ?chars?"}} + test kanji11.10.2 {kanji string trimright} { + kstring trimright " £°£±£² " + } " £°£±£²" + + test kanji11.11.1 {kanji string tolower: error message} { + list [catch {kstring tolower} msg] $msg + } {1 {wrong # args: should be "kstring tolower string"}} + test kanji11.11.2 {kanji string tolower} { + kstring tolower "ABCDeF" + } "abcdef" + test kanji11.11.2 {kanji string tolower} { + kstring tolower "ABC ¤¢¤¤¤¦ XyZ" + } "abc ¤¢¤¤¤¦ xyz" + + test kanji11.12.1 {kanji string toupper: error message} { + list [catch {kstring toupper} msg] $msg + } {1 {wrong # args: should be "kstring toupper string"}} + test kanji11.12.2 {kanji string toupper} { + kstring toupper "abcDef" + } "ABCDEF" + test kanji11.12.2 {kanji string toupper} { + kstring toupper "abc ¤¢¤¤¤¦ xYZ" + } "ABC ¤¢¤¤¤¦ XYZ" + + + # kanji conversion + + test kanji12.1 {kanji conversion: error message} { + list [catch {kanji conversion} msg] $msg + } {1 {wrong # args: should be "kanji conversion fromCode toCode string"}} + test kanji12.2 {kanji conversion: error message} { + list [catch {kanji conversion KANJI ANY abc} msg] $msg + } {1 {bad kanjiCode "KANJI": should be JIS, SJIS, EUC, or ANY}} + test kanji12.3 {kanji conversion: error message} { + list [catch {kanji conversion ANY KANJI abc} msg] $msg + } {1 {bad kanjiCode "KANJI": should be JIS, SJIS, EUC, or ANY}} + test kanji12.4 {kanji conversion JIS} { + kanji code [kanji conversion JIS JIS $kanji(JIS)] + } JIS + test kanji12.5 {kanji conversion JIS} { + kanji code [kanji conversion JIS SJIS $kanji(JIS)] + } SJIS + test kanji12.6 {kanji conversion JIS} { + kanji code [kanji conversion JIS EUC $kanji(JIS)] + } EUC + test kanji12.7 {kanji conversion SJIS} { + kanji code [kanji conversion SJIS JIS $kanji(SJIS)] + } JIS + test kanji12.8 {kanji conversion SJIS} { + kanji code [kanji conversion SJIS SJIS $kanji(SJIS)] + } SJIS + test kanji12.9 {kanji conversion SJIS} { + kanji code [kanji conversion SJIS EUC $kanji(SJIS)] + } EUC + test kanji12.10 {kanji conversion EUC} { + kanji code [kanji conversion EUC JIS $kanji(EUC)] + } JIS + test kanji12.11 {kanji conversion EUC} { + kanji code [kanji conversion EUC SJIS $kanji(EUC)] + } SJIS + test kanji12.12 {kanji conversion EUC} { + kanji code [kanji conversion EUC EUC $kanji(EUC)] + } EUC + + # + + test kanji13.1 {kanji error conditions} { + list [catch {kanji} msg] $msg + } {1 {wrong # args: should be "kanji option arg ?arg ...?"}} + test kanji13.2 {kanji error conditions} { + list [catch {kanji op} msg] $msg + } {1 {bad option "op": should be code, conversion, defalutInputCode, defaultOutputCode, internalCode, inputCode, lsearch, lsort, outputCode, split, or string}} + + # + + if {[info commands kanjitest] == {}} { + puts "This application hasn't been compiled with the \"kanjitest\" command." + } else { + test kanji14.1 {} { + kanjitest start $kanji(JIS) + } 1 + test kanji14.2 {} { + kanjitest start $kanji(JIS) JIS + } 1 + test kanji14.3 {} { + kanjitest start "a$kanji(JIS)" JIS + } 0 + test kanji14.4 {} { + kanjitest start $kanji(SJIS) + } 1 + test kanji14.5 {} { + kanjitest start $kanji(SJIS) SJIS + } 1 + test kanji14.6 {} { + kanjitest start "a$kanji(SJIS)" SJIS + } 0 + test kanji14.7 {} { + kanjitest start $kanji(EUC) + } 1 + test kanji14.8 {} { + kanjitest start $kanji(EUC) EUC + } 1 + test kanji14.9 {} { + kanjitest start "a$kanji(EUC)" EUC + } 0 + test kanji14.10 {} { + kanjitest end $kanji(JIS) + } 1 + test kanji14.11 {} { + kanjitest end $kanji(JIS) JIS + } 1 + test kanji14.12 {} { + kanjitest end "$kanji(JIS)z" JIS + } 0 + test kanji14.13 {} { + kanjitest end $kanji(SJIS) + } 1 + test kanji14.14 {} { + kanjitest end $kanji(SJIS) SJIS + } 1 + test kanji14.15 {} { + kanjitest end "$kanji(SJIS)z" SJIS + } 0 + test kanji14.16 {} { + kanjitest end $kanji(EUC) + } 1 + test kanji14.17 {} { + kanjitest end $kanji(EUC) EUC + } 1 + test kanji14.18 {} { + kanjitest end "$kanji(EUC)z" EUC + } 0 + } + + # kanji variable names + + set default [kanji internalCode] + kanji internalCode [file kanjiCode kanji.test] + + test kanji15.1 {kanji variable names} { + set ÊÑ¿ô abc + expr {$ÊÑ¿ô == "abc"} + } 1 + test kanji15.2 {kanji variable names} { + set ÊÑ¿ô abc + expr {${ÊÑ¿ô} == "abc"} + } 1 + test kanji15.3 {kanji variable names} { + set ÇÛÎó(£°) abc + expr {$ÇÛÎó(£°) == "abc"} + } 1 + + kanji internalCode $default + + # + + if {$lang != ""} then {set env(LANG) $lang} + unset lang + + exec rm kanji.any diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tcl7.6/tests/socket.test ./tests/socket.test *** ../tcl7.6/tests/socket.test Thu Oct 3 01:49:11 1996 --- ./tests/socket.test Fri Oct 18 13:14:15 1996 *************** *** 755,761 **** set l [fconfigure $s] close $s llength $l ! } 10 test socket-7.4 {testing socket specific options} { set s [socket -server accept 2828] proc accept {s a p} { --- 755,761 ---- set l [fconfigure $s] close $s llength $l ! } [jp&orig 14 10] test socket-7.4 {testing socket specific options} { set s [socket -server accept 2828] proc accept {s a p} { diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tcl7.6/unix/Makefile.in ./unix/Makefile.in *** ../tcl7.6/unix/Makefile.in Thu Oct 17 01:24:33 1996 --- ./unix/Makefile.in Fri Oct 18 13:14:15 1996 *************** *** 113,118 **** --- 113,126 ---- MEM_DEBUG_FLAGS = #MEM_DEBUG_FLAGS = -DTCL_MEM_DEBUG + + # To disable kanji handling, reverse the comment characters on the following + # lines. + KANJI_FLAGS = -DKANJI + # KANJI_FLAGS = + KANJI_SRCS = $(GENERIC_DIR)/tclKanjiUtil.c + KANJI_OBJS = tclKanjiUtil.o + # Some versions of make, like SGI's, use the following variable to # determine which shell to use for executing commands: SHELL = /bin/sh *************** *** 184,190 **** CC_SWITCHES = ${CFLAGS} ${TCL_SHLIB_CFLAGS} -I${GENERIC_DIR} -I${SRC_DIR} \ ${AC_FLAGS} ${MATH_FLAGS} ${GENERIC_FLAGS} ${PROTO_FLAGS} ${MEM_DEBUG_FLAGS} \ ! ${ENV_FLAGS} -DTCL_SHLIB_EXT=\"${SHLIB_SUFFIX}\" LIBS = @DL_LIBS@ @LIBS@ $(MATH_LIBS) -lc --- 192,198 ---- CC_SWITCHES = ${CFLAGS} ${TCL_SHLIB_CFLAGS} -I${GENERIC_DIR} -I${SRC_DIR} \ ${AC_FLAGS} ${MATH_FLAGS} ${GENERIC_FLAGS} ${PROTO_FLAGS} ${MEM_DEBUG_FLAGS} \ ! ${ENV_FLAGS} ${KANJI_FLAGS} -DTCL_SHLIB_EXT=\"${SHLIB_SUFFIX}\" LIBS = @DL_LIBS@ @LIBS@ $(MATH_LIBS) -lc *************** *** 206,212 **** tclParse.o tclPkg.o tclPosixStr.o tclPreserve.o tclProc.o \ tclUtil.o tclVar.o ! OBJS = ${GENERIC_OBJS} ${UNIX_OBJS} ${COMPAT_OBJS} @DL_OBJS@ GENERIC_HDRS = \ $(GENERIC_DIR)/tclRegexp.h \ --- 214,220 ---- tclParse.o tclPkg.o tclPosixStr.o tclPreserve.o tclProc.o \ tclUtil.o tclVar.o ! OBJS = ${GENERIC_OBJS} ${KANJI_OBJS} ${UNIX_OBJS} ${COMPAT_OBJS} @DL_OBJS@ GENERIC_HDRS = \ $(GENERIC_DIR)/tclRegexp.h \ *************** *** 282,288 **** # compile on the current machine, and they will cause problems for # things like "make depend". ! SRCS = $(GENERIC_SRCS) $(UNIX_SRCS) all: ${TCL_LIB_FILE} tclsh --- 290,296 ---- # compile on the current machine, and they will cause problems for # things like "make depend". ! SRCS = $(GENERIC_SRCS) $(KANJI_SRCS) $(UNIX_SRCS) all: ${TCL_LIB_FILE} tclsh *************** *** 610,615 **** --- 618,626 ---- tclTest.o: $(GENERIC_DIR)/tclTest.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclTest.c + + tclKanjiUtil.o: $(GENERIC_DIR)/tclKanjiUtil.c + $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclKanjiUtil.c tclUnixChan.o: $(UNIX_DIR)/tclUnixChan.c $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixChan.c diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tcl7.6/unix/configure ./unix/configure *** ../tcl7.6/unix/configure Thu Oct 17 01:24:34 1996 --- ./unix/configure Fri Oct 18 13:22:28 1996 *************** *** 406,412 **** # SCCS: @(#) configure.in 1.120 96/10/08 08:32:30 ! TCL_VERSION=7.6 TCL_MAJOR_VERSION=7 TCL_MINOR_VERSION=6 VERSION=${TCL_VERSION} --- 406,412 ---- # SCCS: @(#) configure.in 1.120 96/10/08 08:32:30 ! TCL_VERSION=7.6jp TCL_MAJOR_VERSION=7 TCL_MINOR_VERSION=6 VERSION=${TCL_VERSION} diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tcl7.6/unix/configure.in ./unix/configure.in *** ../tcl7.6/unix/configure.in Thu Oct 17 01:24:34 1996 --- ./unix/configure.in Fri Oct 18 13:18:56 1996 *************** *** 4,10 **** AC_INIT(../generic/tcl.h) # SCCS: @(#) configure.in 1.120 96/10/08 08:32:30 ! TCL_VERSION=7.6 TCL_MAJOR_VERSION=7 TCL_MINOR_VERSION=6 VERSION=${TCL_VERSION} --- 4,10 ---- AC_INIT(../generic/tcl.h) # SCCS: @(#) configure.in 1.120 96/10/08 08:32:30 ! TCL_VERSION=7.6jp TCL_MAJOR_VERSION=7 TCL_MINOR_VERSION=6 VERSION=${TCL_VERSION} diff -r -c -P -x CVS -I \$Id: .* Exp \$ ../tcl7.6/win/makefile.vc ./win/makefile.vc *** ../tcl7.6/win/makefile.vc Sun Oct 13 08:43:54 1996 --- ./win/makefile.vc Sun Nov 24 14:47:48 1996 *************** *** 56,63 **** TCL_INCLUDES = -I$(WINDIR) -I$(GENERICDIR) TCL_DEFINES = -D__WIN32__ -DUSE_TCLALLOC=0 $(DEBUGDEFINES) -Dtry=__try \ ! -Dexcept=__except TCLSHOBJS = \ $(TMPDIR)\tclAppInit.obj --- 56,69 ---- TCL_INCLUDES = -I$(WINDIR) -I$(GENERICDIR) + # To disable kanji handling, reverse the comment characters on the following + # lines. + KANJI_FLAGS = -DKANJI + # KANJI_FLAGS = + KANJI_OBJS = $(TMPDIR)\tclKanjiUtil.obj + TCL_DEFINES = -D__WIN32__ -DUSE_TCLALLOC=0 $(DEBUGDEFINES) -Dtry=__try \ ! -Dexcept=__except $(KANJI_FLAGS) TCLSHOBJS = \ $(TMPDIR)\tclAppInit.obj *************** *** 115,121 **** $(TMPDIR)\tclWinNotify.obj \ $(TMPDIR)\tclWinPipe.obj \ $(TMPDIR)\tclWinSock.obj \ ! $(TMPDIR)\tclWinTime.obj TCLLIB = tcl76.lib TCLDLL = tcl76.dll --- 121,128 ---- $(TMPDIR)\tclWinNotify.obj \ $(TMPDIR)\tclWinPipe.obj \ $(TMPDIR)\tclWinSock.obj \ ! $(TMPDIR)\tclWinTime.obj \ ! $(KANJI_OBJS) TCLLIB = tcl76.lib TCLDLL = tcl76.dll